I'm trying to use All from generics-sop to constrain a list of types. Everything works as expected with simple classes like All Typeable xs, but I'd like to be able to do something like the following:
class (Typeable a) => TestClass (a :: k)
instance (Typeable a) => TestClass a
foo :: (All Typeable xs) => NP f xs -> z
foo = undefined
bar :: (All TestClass xs) => NP f xs -> z
bar = foo
This gives the error
Could not deduce: Generics.SOP.Constraint.AllF Typeable xs
arising from a use of ‘foo’
from the context: All TestClass xs
The generics-sop documentation states that
"All Eq '[ Int, Bool, Char ]
is equivalent to the constraint
(Eq Int, Eq Bool, Eq Char)
But in this case it doesn't seem to be, since
foo2 :: (Typeable a, Typeable b) => NP f '[a,b] -> z
foo2 = undefined
bar2 :: (TestClass a, TestClass b) => NP f '[a,b] -> z
bar2 = foo2
compiles fine.
My questions
1) Is this the expected behaviour?
2) If so, is there any workaround?
My use case for this is that I want to pass around a type level list of types constrained by a bunch of different classes under a single class name (like class (Typeable a, Eq a, Show a) => MyClass a) but also be able to call less specialised functions that only require some subset of those classes.
Searching for answers turned up superclasses aren't considered, but I don't think that is the issue here - I think it is something to do with the way the All constraint is put together in generics-sop. It is as if the compiler is simply comparing the two All constraints, rather than expanding them both and then type checking.
All f xs is actually equivalent to (AllF f xs, SListI xs). AllF is a type family:
type family AllF (c :: k -> Constraint) (xs :: [k]) :: Constraint where
AllF _ '[] = ()
AllF c (x:xs) = (c x, All c xs)
You see that it cannot reduce unless xs is in WHNF, so it gets stuck in your case. You can use mapAll:
import Generics.SOP.Dict
mapAll :: forall c d xs.
(forall a. Dict c a -> Dict d a) ->
Dict (All c) xs -> Dict (All d) xs
-- ::ish forall f g xs. (forall a. f a -> g a) -> All f xs -> All g xs
-- stores a constraint in a manipulatable way
data Dict (f :: k -> Constraint) (a :: k) where
Dict :: f a => Dict f a
bar :: forall xs f z. (All TestClass xs) => NP f xs -> z
bar = case mapAll #TestClass #Typeable #xs (\Dict -> Dict) Dict of
Dict -> foo
-- TestClass a -> Typeable a pretty trivially:
-- match Dict to reveal TestClass a
-- put the Typeable part of the TestClass instance into another Dict
-- We already know All TestClass xs; place that into a Dict
-- mapAll magic makes a Dict (All Typeable) xs
-- match on it to reveal
-- foo's constraint is satisfied
Related
Usually I reckon type-families are similarly expressive as compared with typeclasses/instances -- the difference is awkwardness/ergonomics of the code. In this case I have code working with type-families to raise a constraint, but the equivalent typeclass code won't compile. (* Could not deduce (Eq a) ... when (Eq a) is exactly the constraint I'm supplying.) Is this a case typeclasses just can't express, or am I doing something wrong?
data Set a = NilSet | ConsSet a (Set a) deriving (Eq, Show, Read)
-- fmap over a Set, squishing out duplicates
fmapSet :: (Eq a, Eq b ) => (a -> b) -> Set a -> Set b
fmapSet f NilSet = NilSet
fmapSet f (ConsSet x xs) = uqCons (f x) (fmapSet f xs)
uqCons fx fxs | sElem fx fxs = fxs
| otherwise = ConsSet fx fxs
sElem fx NilSet = False
sElem fx (ConsSet fy fys) = fx == fy || sElem fx fys
I want to call that fmap via a Functor-like class, with a constraint that the data-structure is well-formed. Either of these approaches with type-families work (based on this answer, but preferring a standalone family).
{-# LANGUAGE ConstraintKinds, TypeFamilies #-}
import Data.Kind (Type, Constraint)
type family WFTF (f :: * -> *) a :: Constraint
type instance WFTF Set a = Eq a
class WFTFFunctor f where
wftFfmap :: (WFTF f a, WFTF f b) => (a -> b) -> f a -> f b
instance WFTFFunctor Set where
wftFfmap = fmapSet
type family WFTF2 c_a :: Constraint
type instance WFTF2 (Set a) = Eq a
class WFTF2Functor f where
wftF2fmap :: (WFTF2 (f a), WFTF2 (f b)) => (a -> b) -> f a -> f b
instance WFTF2Functor Set where
wftF2fmap = fmapSet
The equivalent (I think) typeclass at least compiles providing I don't give an implementation for the method:
class WFT c_a where
instance Eq a => WFT (Set a)
class WFTFunctor f where
wftfmap :: (WFT (f a), WFT (f b)) => (a -> b) -> f a -> f b
instance WFTFunctor Set where wftfmap f xss = undefined -- s/b fmapSet f xss
Inferred :t (\ f (xss :: Set a) -> wftfmap f xss) :: (Eq a, Eq b) => (a -> b) -> Set a -> Set b -- which is exactly the type of fmapSet. But if I put that call to fmapSet f xss in place of undefined, rejected:
* Could not deduce (Eq a) arising from a use of `fmapSet'
from the context: (WFT (Set a), WFT (Set b))
bound by the type signature for:
wftfmap :: forall a b.
(WFT (Set a), WFT (Set b)) =>
(a -> b) -> Set a -> Set b
at ...
Possible fix:
add (Eq a) to the context of
the type signature for:
wftfmap :: forall a b.
(WFT (Set a), WFT (Set b)) =>
(a -> b) -> Set a -> Set b
WFT (Set a) implies raises Wanted (Eq a), so I shouldn't need to add it. (And if I do via InstanceSignatures, rejected because it's not as general as the inferred constraint.) [In response to #dfeuer's answer/my comment] True that there's nothing in the instance decl to Satisfy (Eq a), but fmapSet's sig also Wants (Eq a) so (why) doesn't that ensure the constraint gets satisfied at the call site?
I've tried decorating everything with ScopedTypeVariables/PatternSignatures to make the constraints more explicit. I've tried switching on ImpredicativeTypes (GHC 8.10.2). I sometimes get different rejection messages, but nothing that compiles.
If I take away the WFT (Set a) and (Eq a) from fmapSet's signature, I get a similar rejection * Could not deduce (Eq b) .... Yes I know that rejection message is a FAQ. In the q's I've looked through, the constraint is indeed unsatisfiable. But then in this case
a) why does the version with implementation undefined typecheck;
b) isn't the constraint wanted from WFT (Set a) getting satisfied
by fmapSet having the (Eq a)?)
Addit: To explain a bit more about what I'm expecting in terms of Wanted/Satisfied constraints:
There's no signature given for uqCons, nor for sElem, which it calls. In sElem there's a call to (==), that raises Wanted (Eq b) in sElem's sig, which gets passed as a Wanted in the sig for uqCons, which gets passed as a Wanted in the sig for fmapSet, which does have a sig given including (Eq b).
Similarly the Set instance for method wftfmap raises Wanted (Eq a, Eq b); I expect it can use that to Satisfy the Wanted arising from the call to fmapSet.
There's a huge difference between superclass constraints and instance constraints. A superclass constraint is something required to form any instance of the class, and is available whenever the subclass constraint is in force. An instance constraint is required to form a specific instance, and is not automatically available when the class constraint is in force. This difference is pretty deeply wired into the system, and is reflected in the Core representations. In Core:
A class is a type of records of class methods and superclasses.
An instance is a value of a class type or a function from its instance constraints to such a value.
Once a "dictionary function" is called to produce an instance dictionary, you only have the dictionary, not the arguments that were used to create it.
[re #Ben's comment to #dfeuer's answer] not something you have on the inside to implement wftfmap.
OK I can have the right sig on the inside:
-- class/instance WFT, funcs fmapSet, uqCons, sElem as before
{-# LANGUAGE InstanceSigs, QuantifiedConstraints #-}
class WFTQFunctor f where
wftQfmap :: (WFT (f a), WFT (f b)) => (a -> b) -> f a -> f b
instance (forall b. (WFT (Set b) => Eq b)) => WFTQFunctor Set where
wftQfmap :: (Eq a, Eq b) => (a -> b) -> (Set a) -> (Set b) -- yay
wftQfmap f xss = fmapSet f xss
Compiles with a warning that I can suppress with -XMonoLocalBinds:
* The constraint `WFT (Set b)' matches
instance Eq a => WFT (Set a)
This makes type inference for inner bindings fragile;
either use MonoLocalBinds, or simplify it using the instance
* In the instance declaration for `WFTQFunctor Set'
I appreciate that QuantifiedConstraint is a fib. I might have instance {-# OVERLAPPING #-} WFT (Set (b -> c)) for which Eq does not hold; but I don't; and/or at least if I use a Set element for which Eq holds, I'll get away with it(?)
But no:
*> wftQfmap toUpper mySet -- mySet :: Set Char
<interactive>:2:1: error:
* Could not deduce (Eq b) arising from a use of `wftQfmap'
from the context: WFT (Set b)
bound by a quantified context at <interactive>:2:1-22
Possible fix: add (Eq b) to the context of a quantified context
* In the expression: wftQfmap toUpper mySet
In an equation for `it': it = wftQfmap toUpper mySet
So why does that instance WFTQFunctor Set compile? And can it ever do anything useful?
OK I have something working. It's ugly and clunky, and not scalable, but answers the q as put:
class WFT c_a where
isWF :: c_a -> Bool -- is c_a well-formed?
mkWF :: c_a -> c_a -- edit c_a to make it well-formed
mkWF = id
instance Eq a => WFT (Set a) -- instance types same as q
isWF NilSet = True
isWF (ConsSet x xs) = not (sElem x xs) && isWF xs -- sElem decl'd in the q
mkWF = fmapSet id -- fmapSet also
class WFTFunctor f where -- class as decl'd in the q
wftfmap :: (WFT (f a), WFT (f b)) => (a -> b) -> f a -> f b
instance WFTFunctor Set where wftfmap f xss = mkWF $ fmap f xss
instance Functor Set where -- conventional/unconstrained fmap
fmap f NilSet = NilSet
fmap f (ConsSet x xs) = ConsSet (f x) (fmap f xs)
If I'm using fmap, generalise:
class Functor f => WFTFunctor f where
wftfmap :: (WFT (f a), WFT (f b)) => (a -> b) -> f a -> f b
wftfmap f xss = mkWF $ fmap f xss
This is not far off H2010 compliant. (Needs FlexibleConstraints.) So I can get the Eq constraint effective 'inside' the WFTFunctor instance; it needs a method call from WFT to pull it through.
I could have heaps of other methods in class WFT, but I say "not scalable" because you couldn't in general 'edit' an ill-formed structure to well-formed. Hmm since it's a Functor: could unload to a List then load back to the structure.
I want to define a function that takes an arbitrarily sized HList of values behind some type constructor, e.g. Maybe:
foo :: HList '[t a, t b, t c, ...] -> Bar
-- For example:
foo :: HList '[Maybe a, Maybe b, Maybe c, ...] -> Bar
Is there some way to do that in Haskell? Thanks!
You could add a constraint using a custom type class, requiring the types to involve the same f type constructor.
import Data.HList.HList
class HSame (t :: [Type]) where
instance HSame '[] where
instance HSame '[f x] where
instance HSame (f u : xs) => HSame (f t ': f u ': xs) where
foo :: HSame xs => HList xs -> Bool
foo _ = True
Alternatively, define a Map f xs type family and define
foo :: HList (Map f xs) -> Bool
foo _ = True
but this won't work well with type inference, since there's no easy way for the compiler to infer f and xs.
The NP type from sop-core is an n-ary product of kind (k -> Type) -> [k] -> Type parameterized by a type-level list [k] and a type constructor (k -> Type) which wraps each term-level component:
Prelude> :set -XDataKinds
Prelude> import Data.SOP.NP
Prelude Data.SOP.NP> :t Just True :* Nothing :* Nil
Just True :* Nothing :* Nil :: NP Maybe '[Bool, x]
I searched Hackage and couldn't find anything like the following but it seems to be fairly simple and useful. Is there a library that contains sort of data type?
data HList c where
(:-) :: c a => a -> HList c
Nil :: HList c
All the HLists I found could have any type, and weren't constrained.
If there isn't I'll upload my own.
I'm not sure this data type is useful...
If you really want a to be existentially qualified, I think you should use regular lists. The more interesting data type here would be Exists, although I'm certain there are variants of it all over package Hackage already:
data Exists c where
Exists :: c a => a -> Exists c
Then, your HList c is isomorphic to [Exists c] and you can still use all of the usual list based functions.
On the other hand, if you don't necessarily want a in the (:-) :: c a => a -> HList c to be existentially qualified (having it as such sort of defies the point of the HList), you should instead define the following:
data HList (as :: [*]) where
(:-) :: a -> HList as -> HList (a ': as)
Nil :: HList '[]
Then, if you want to require that all entries of the HList satisfy c, you can make a type class to witness the injection from HList as into [Exists c] whose instance resolution only works if all the types in the HList satisfy the constraint:
class ForallC as c where
asList :: HList as -> [Exists c]
instance ForallC '[] c where
asList Nil = []
instance (c a, ForallC as c) => ForallC (a ': as) c where
asList (x :- xs) = Exists x : asList xs
The generics-sop package offers this out of the box.
A heterogeneous list can be defined in generics-sop by using
data NP :: (k -> *) -> [k] -> * where
Nil :: NP f '[]
(:*) :: f x -> NP f xs -> NP f (x ': xs)
and instantiating it to the identity type constructor I (from generics-sop) or Identity (from Data.Functor.Identity).
The library then offers the constraint All such that e.g.
All Show xs => NP I xs
is the type of a heterogeneous list where all contained types are in the Show class. Conceptually, All is a type family that computes the constraint for every element in a type-level list:
type family All (f :: k -> Constraint) (xs :: [k]) :: Constraint where
All c '[] = ()
All c (x ': xs) = (c x, All c xs)
(Only that in the actual definition, All is additionally wrapped in a type class so that it can be partially applied.)
The library furthermore offers all sorts of functions that traverse and transform NPs given a common constraint.
What you really want is
data HKList :: (k -> *) -> [k] -> * where
Nil :: HKList f '[]
(:*) :: f x -> HKList f xs -> HKList f (x ': xs)
Which you can use either as an ordinary heterogeneous list
type HList = HKList Identity
Or with extra information of some constant type e attached to each value (or other interesting functors)
HKList ((,) e)
Or with extra information captured in a dictionary
data Has c a where
Has :: c a => a -> Has c a
type ConstrainedList c = HKList (Has c)
Or keep lists of only captured constraints
data Dict1 :: (k -> Constraint) -> k -> * where
Dict1 :: c k => Dict1 c k
Which you can use to define the idea of all of a list of types satisfying a constraint
class All c xs where
dicts :: HKList (Dict1 c) xs
instance All c '[] where
dicts = Nil
instance (All c xs, c x) => All c (x ': xs) where
dicts = Dict1 :* dicts
Or anything else you can do with a kind k -> *
You can freely convert between working with All c xs => HList xs and HKList (Has c) xs
zipHKList :: (forall k. f k -> g k -> h k) -> HKList f xs -> HKList g xs -> HKList h xs
zipHKList _ Nil Nil = Nil
zipHKList f (x :* xs) (y :* ys) = f x y :* zipHKList f xs ys
allToHas :: All c xs => HKList Identity xs -> HKList (Has c) xs
allToHas xs = zipHKList f dicts xs
where
f :: Dict1 c k -> Identity k -> Has c k
f Dict1 (Identity x) = Has x
hasToAll :: HKList (Has c) xs -> Dict (All c xs)
hasToAll Nil = Dict
hasToAll (Has x :* xs) =
case hasToAll xs of
Dict -> Dict
full code
I've written this a few times before for various projects, but I didn't know it was in a library anywhere until Kosmikus pointed out that it's in generics-sop.
I'm trying to create a typed expression parser in Haskell, which works great so far, but I'm currently struggling to implement higher order functions. I've boiled the problem down to a simple example:
{-# LANGUAGE TypeFamilies,GADTs,FlexibleContexts,RankNTypes #-}
-- A function has an argument type and a result type
class Fun f where
type FunArg f
type FunRes f
-- Expressions are either constants of function applications
data Expr a where
Const :: a -> Expr a
App :: Fun f => f -> FunArg f -> Expr (FunRes f)
-- A very simple function
data Plus = Plus
-- Which takes two integer expressions and returns an integer expression
instance Fun Plus where
type FunArg Plus = (Expr Int,Expr Int)
type FunRes Plus = Int
-- A more complicated function which lifts a function to lists (like in haskell)
data Map f r = Map f
-- For this we need the concept of lifting function arguments:
class Liftable a where
type LiftRes a
-- A singleton argument is lifted by changing the expression type from a to [a]
instance Liftable (Expr a) where
type LiftRes (Expr a) = Expr [a]
-- Two function arguments are lifted by lifting each argument
instance (Liftable a,Liftable b) => Liftable (a,b) where
type LiftRes (a,b) = (LiftRes a,LiftRes b)
-- Now we can declare a function instance for Map
instance (Fun f,Liftable (FunArg f),r ~ LiftRes (FunArg f)) => Fun (Map f r) where
type FunArg (Map f r) = r
type FunRes (Map f r) = [FunRes f]
-- Now a parser for functions:
parseFun :: [String] -> (forall f. Fun f => f -> a) -> a
-- The parser for the plus function is easy:
parseFun ["plus"] f = f Plus
-- But the parser for map is not possible:
parseFun ("map":sym) f
= parseFun sym (\fun -> f (Map fun))
The problem seems to be that there is no way to convince the type checker that every LiftRes is itself Liftable, because recursive class declarations are forbidden.
My question is: How do I make this work? Are there other examples of typed expression parsers from which I could take hints?
EDIT: It seems that this discussion about type family constraints seems to be very related. However, I fail to make their solution work in my case, maybe someone can help with that?
The easiest way to make your example work is to remove the Liftable (FunArg f) constraint from the instance declaration. But I think your example is just so condensed that it doesn't show why you actually need it.
So the next best thing is to add a Liftable (FunArg f) superclass constraint to the Fun class:
class Liftable (FunArg f) => Fun f where
...
If this is not feasible (i.e., if not all your functions have liftable argument types), then you cannot expect to write a parseFun of the given type.
A more general remark: I think what you're trying to do here is very strange, and perhaps too much at once. Parsing from unstructured strings into a context-free datatype is already difficult enough. Why not do that first, and write a separate function that transforms the "untyped", but structured representation of your language into a typed one.
EDIT (as a reaction to the comments, revised): As pointed out in the discussion on type family constraints that you also linked in your question, you can bypass the superclass cycle restriction by using ConstraintKinds. Here is a way to make your reduced example work. Perhaps this will scale to the full solution?
{-# LANGUAGE RankNTypes, ScopedTypeVariables, TypeFamilies, FlexibleContexts, GADTs #-}
import Data.Constraint -- from the constraints package
import Data.Proxy -- from the tagged package
-- A function has an argument type and a result type
class Liftable (FunArg f) => Fun f where
type FunArg f
type FunRes f
-- Expr, Plus, and instance Fun Plus as before
class Liftable a where
type LiftRes a
get :: p a -> Dict (Liftable (LiftRes a))
-- acquire "superclass" dictionary by calling this method and
-- then pattern matching on the result
instance Liftable (Expr a) where
type LiftRes (Expr a) = Expr [a]
get _ = Dict
instance (Liftable a, Liftable b) => Liftable (a, b) where
type LiftRes (a, b) = (LiftRes a, LiftRes b)
get (_ :: p (a, b)) =
case get (Proxy :: Proxy a) of -- extra code required
Dict -> case get (Proxy :: Proxy b) of -- extra code required
Dict -> Dict
data Map f r = Map f
instance (Fun f, Liftable r, r ~ LiftRes (FunArg f)) => Fun (Map f r) where
type FunArg (Map f r) = r
type FunRes (Map f r) = [FunRes f]
parseFun :: forall a. [String] -> (forall f. Fun f => f -> a) -> a
parseFun ["plus"] f = f Plus
parseFun ("map" : sym) f = parseFun sym
(\ (fun :: g) -> case get (Proxy :: Proxy (FunArg g)) of -- extra code required
Dict -> f (Map fun))
We're used to having universally quantified types for polymorphic functions. Existentially quantified types are used much less often. How can we express existentially quantified types using universal type quantifiers?
It turns out that existential types are just a special case of Σ-types (sigma types). What are they?
Sigma types
Just as Π-types (pi types) generalise our ordinary function types, allowing the resulting type to depend on the value of its argument, Σ-types generalise pairs, allowing the type of second component to depend on the value of the first one.
In a made-up Haskell-like syntax, Σ-type would look like this:
data Sigma (a :: *) (b :: a -> *)
= SigmaIntro
{ fst :: a
, snd :: b fst
}
-- special case is a non-dependent pair
type Pair a b = Sigma a (\_ -> b)
Assuming * :: * (i.e. the inconsistent Set : Set), we can define exists a. a as:
Sigma * (\a -> a)
The first component is a type and the second one is a value of that type. Some examples:
foo, bar :: Sigma * (\a -> a)
foo = SigmaIntro Int 4
bar = SigmaIntro Char 'a'
exists a. a is fairly useless - we have no idea what type is inside, so the only operations that can work with it are type-agnostic functions such as id or const. Let's extend it to exists a. F a or even exists a. Show a => F a. Given F :: * -> *, the first case is:
Sigma * F -- or Sigma * (\a -> F a)
The second one is a bit trickier. We cannot just take a Show a type class instance and put it somewhere inside. However, if we are given a Show a dictionary (of type ShowDictionary a), we can pack it with the actual value:
Sigma * (\a -> (ShowDictionary a, F a))
-- inside is a pair of "F a" and "Show a" dictionary
This is a bit inconvenient to work with and assumes that we have a Show dictionary around, but it works. Packing the dictionary along is actually what GHC does when compiling existential types, so we could define a shortcut to have it more convenient, but that's another story. As we will learn soon enough, the encoding doesn't actually suffer from this problem.
Digression: thanks to constraint kinds, it's possible to reify the type class into concrete data type. First, we need some language pragmas and one import:
{-# LANGUAGE ConstraintKinds, GADTs, KindSignatures #-}
import GHC.Exts -- for Constraint
GADTs already give us the option to pack a type class along with the constructor, for example:
data BST a where
Nil :: BST a
Node :: Ord a => a -> BST a -> BST a -> BST a
However, we can go one step further:
data Dict :: Constraint -> * where
D :: ctx => Dict ctx
It works much like the BST example above: pattern matching on D :: Dict ctx gives us access to the whole context ctx:
show' :: Dict (Show a) -> a -> String
show' D = show
(.+) :: Dict (Num a) -> a -> a -> a
(.+) D = (+)
We also get quite natural generalisation for existential types that quantify over more type variables, such as exists a b. F a b.
Sigma * (\a -> Sigma * (\b -> F a b))
-- or we could use Sigma just once
Sigma (*, *) (\(a, b) -> F a b)
-- though this looks a bit strange
The encoding
Now, the question is: can we encode Σ-types with just Π-types? If yes, then the existential type encoding is just a special case. In all glory, I present you the actual encoding:
newtype SigmaEncoded (a :: *) (b :: a -> *)
= SigmaEncoded (forall r. ((x :: a) -> b x -> r) -> r)
There are some interesting parallels. Since dependent pairs represent existential quantification and from classical logic we know that:
(∃x)R(x) ⇔ ¬(∀x)¬R(x) ⇔ (∀x)(R(x) → ⊥) → ⊥
forall r. r is almost ⊥, so with a bit of rewriting we get:
(∀x)(R(x) → r) → r
And finally, representing universal quantification as a dependent function:
forall r. ((x :: a) -> R x -> r) -> r
Also, let's take a look at the type of Church-encoded pairs. We get a very similar looking type:
Pair a b ~ forall r. (a -> b -> r) -> r
We just have to express the fact that b may depend on the value of a, which we can do by using dependent function. And again, we get the same type.
The corresponding encoding/decoding functions are:
encode :: Sigma a b -> SigmaEncoded a b
encode (SigmaIntro a b) = SigmaEncoded (\f -> f a b)
decode :: SigmaEncoded a b -> Sigma a b
decode (SigmaEncoded f) = f SigmaIntro
-- recall that SigmaIntro is a constructor
The special case actually simplifies things enough that it becomes expressible in Haskell, let's take a look:
newtype ExistsEncoded (F :: * -> *)
= ExistsEncoded (forall r. ((x :: *) -> (ShowDictionary x, F x) -> r) -> r)
-- simplify a bit
= ExistsEncoded (forall r. (forall x. (ShowDictionary x, F x) -> r) -> r)
-- curry (ShowDictionary x, F x) -> r
= ExistsEncoded (forall r. (forall x. ShowDictionary x -> F x -> r) -> r)
-- and use the actual type class
= ExistsEncoded (forall r. (forall x. Show x => F x -> r) -> r)
Note that we can view f :: (x :: *) -> x -> x as f :: forall x. x -> x. That is, a function with extra * argument behaves as a polymorphic function.
And some examples:
showEx :: ExistsEncoded [] -> String
showEx (ExistsEncoded f) = f show
someList :: ExistsEncoded []
someList = ExistsEncoded $ \f -> f [1]
showEx someList == "[1]"
Notice that someList is actually constructed via encode, but we dropped the a argument. That's because Haskell will infer what x in the forall x. part you actually mean.
From Π to Σ?
Strangely enough (although out of the scope of this question), you can encode Π-types via Σ-types and regular function types:
newtype PiEncoded (a :: *) (b :: a -> *)
= PiEncoded (forall r. Sigma a (\x -> b x -> r) -> r)
-- \x -> is lambda introduction, b x -> r is a function type
-- a bit confusing, I know
encode :: ((x :: a) -> b x) -> PiEncoded a b
encode f = PiEncoded $ \sigma -> case sigma of
SigmaIntro a bToR -> bToR (f a)
decode :: PiEncoded a b -> (x :: a) -> b x
decode (PiEncoded f) x = f (SigmaIntro x (\b -> b))
I found an anwer in Proofs and Types by Jean-Yves Girard, Yves Lafont and Paul Taylor.
Imagine we have some one-argument type t :: * -> * and construct an existential type that holds t a for some a: exists a. t a. What can we do with such a type? In order to compute something out of it we need a function that can accept t a for arbitrary a, that means a function of type forall a. t a -> b. Knowing this, we can encode an existential type simply as a function that takes functions of type forall a. t a -> b, supplies the existential value to them and returns the result b:
{-# LANGUAGE RankNTypes #-}
newtype Exists t = Exists (forall b. (forall a. t a -> b) -> b)
Creating an existential value is now easy:
exists :: t a -> Exists t
exists x = Exists (\f -> f x)
And if we want to unpack the existential value, we just apply its content to a function that produces the result:
unexists :: (forall a. t a -> b) -> Exists t -> b
unexists f (Exists e) = e f
However, purely existential types are of very little use. We cannot do anything reasonable with a value we know nothing about. More often we need an existential type with a type class constraint. The procedure is just the same, we just add a type class constraint for a. For example:
newtype ExistsShow t = ExistsShow (forall b. (forall a. Show a => t a -> b) -> b)
existsShow :: Show a => t a -> ExistsShow t
existsShow x = ExistsShow (\f -> f x)
unexistsShow :: (forall a. Show a => t a -> b) -> ExistsShow t -> b
unexistsShow f (ExistsShow e) = e f
Note: Using existential quantification in functional programs is often considered a code-smell. It can indicate that we haven't liberated ourselves from OO thinking.