Skip to content

Instantly share code, notes, and snippets.

@adamwespiser
Created December 10, 2020 09:48
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save adamwespiser/fde177b00551f28a8175e0d5e316561e to your computer and use it in GitHub Desktop.
Save adamwespiser/fde177b00551f28a8175e0d5e316561e to your computer and use it in GitHub Desktop.
{- stack --resolver lts-16.8 --install-ghc exec ghci --package "protolude text binary" -}
{-# LANGUAGE DeriveGeneric, DuplicateRecordFields, ExistentialQuantification, FlexibleContexts, RankNTypes, ScopedTypeVariables, StandaloneDeriving #-}
{- ghcid -c "stack X.hs" -}
module Existenial where
import Data.Text
import Data.Binary
import GHC.Generics
-- Here is my datatype, Token
-- IRL this is a continutation token, passed around between front and backend
-- it **would be nice** if the field "one" is polymorphic, but it must be constrained by the `Binary` class constraint, so we can encode the data type
-- Another way to solve this is with a smart constructor, but I want to use existential types, as an exercise...
--
data Token a =
forall a. (Binary a, Generic a) => Token {one :: a, two :: Text }
-- However, we will get an error deriving a type class for a generic datatype, so we use standalone deriving
deriving instance Eq a => Eq (Token a)
deriving instance Generic (a) => Generic (Token a)
-- Ultimately, this is the instance we need
instance Binary a => Binary (Token a) where
get = do
(oneGet :: a) <- get
twoGet <- get
pure $ Token oneGet twoGet
put (Token a b) = put a <> put b
-- It looks like this is a known issue in ghc...
-- https://gitlab.haskell.org/ghc/ghc/-/issues/10514
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment