Lets say I've got the following:
data T a
f :: a -> (exists t. T t)
g :: T b -> c
h :: a -> c
h = g . f
As I know, the type signature for f is not valid Haskell. I can instead do this though:
{-# LANGUAGE GADTs #-}
data T a
data ExistsTA where
ExistsTA :: T a -> ExistsTA
f :: a -> ExistsTA
g :: T b -> c
h :: a -> c
h x = case (f x) of ExistsTA x' -> g x'
Which compiles fine. I was wondering, is there a library that generalises the creation of the ExistsTA data type (perhaps takes T as a parameter), or do I have to roll my own everytime I want to do this (which is not a big deal, just don't want to reinvent the wheel if I don't need too).
In particular, for my application, I would also like wrappers in this form:
data C where
C1 :: C
...
data D (a :: C) where
D1 a :: D
...
data T (d :: D) a
f :: T (D1 C1) a -> exists c. T (D1 c) a
I dunno whether this is in a library anywhere, but I like to use the following general-purpose existential:
data Ex f = forall a. Ex (f a)
With PolyKinds Ex can existentially wrap up the parameter of any type f :: k -> *. How general-purpose is this? We can manipulate f until it's the right shape, and we can build in whatever extra information we need, with a little library of type combinators. Working with general-purpose types like this is a powerful way to program, but often it's simpler just to roll your own.
Suppose we want to existentially quantify both halves of a two-parameter type p. One can use the following GADT to uncurry p, turning it from a two-parameter type k1 -> k2 -> * into a one-parameter type (k1, k2) -> *.
data Uncurry p ij where
Uncurry :: { getUncurry :: p i j } -> Uncurry p '(i, j)
Now Uncurry p can be existentially wrapped.
type ExP p = Ex (Uncurry p)
Suppose I want to pair up my existentially-wrapped type with some evidence such as a singleton, so that one can recover the existentially quantified index. I'll use the index-respecting product to pair up two functors f and g:
newtype (f :*: g) i = f i :*: g i
If, say, f is a GADT, pattern-matching on the f-half of the pair will tell you about g's index. Now, f :*: g has the right kind to be existentially wrapped.
type ExPair f g = Ex (f :*: g)
In practice you might write ExPair Sing f to pair up f with a singleton.
Suppose I need the aforementioned evidence in constraint form. I can replace Sing from above with the following type which reifies an instance dictionary for c a as a (visible) runtime value:
data Dict1 c a where
Dict1 :: c a => Dict1 c a
(or you could use the constraints package: newtype Dict1 c a = Dict1 { getDict1 :: Dict (c a) }.) Now I just need to set the left-hand part of my pair to be Dict1 c:
type ExDictPair c f = ExPair (Dict1 c) f
So you might write ExDictPair SingI f to package up an implicit singleton.
Suppose the thing I need to existentially quantify is at a higher kind, eg * -> *. (I might want to talk about "some instance of Monad containing an Int".) Ex is poly-kinded, but it only existentially quantifies the right-most parameter of its argument. So we need the * -> * part of the type to be the last argument of our datatype. I can write a type combinator for that too:
newtype RApp a f = RApp { getRApp :: f a }
type SomeMonadAppliedToInt = ExDictPair Monad (RApp Int)
Related
I need to write the Functor instances for the Flip datatype:
data K a b = K a
newtype Flip f a b = Flip (f b a) deriving (Eq, Show)
instance Functor (Flip K a) where
fmap=undefined
The solution I was given in class is:
instance Functor (Flip K a) where
fmap f (Flip (K b)) = Flip (K (f b))
I really don't understand what's going on here and I'm beginning to doubt my whole understanding of data types and functors. What I do understand is this (please correct me if any of this is wrong):
K is a data type that turns 2 parameters into a structure K a ( that only keeps the first parameter)
Flip is a datatype that turns 3 arguments into a structure with one
Because in fmap :: (a-> b) -> f a -> f b, f a has kind *, to write the Functor instance of Flip, we write it on the last type in Flip. Aka f and a are "constants" in a way, and we write the functor for the type b. I would write something like:
instance Functor (Flip f a) where
fmap f (Flip x y z) = fmap Flip x y (f z)
I know that that is completely wrong but I'm not sure why.
Also, why would we bring K into the Functor instance of Flip? Can someone explain thoroughly the process of coming up with this solution and why it is correct?
K is a data type that turns 2 parameters into a structure K a ( that only keeps the first parameter)
This isn't quite right. K a b is a data type formed using two parameters, but it's not really right to say that it "turns them into" anything. Instead, it's simply just stating to the world that there now exists a new type: K a b. "So what?" you might ask. Well, the second half of the data type defines how to make new values of this type. That part says, "You can make a new value of type K a b with this function I'll call K which has type a -> K a b." It's really important to recognize that there is a distinction between the type K and the constructor K.
So, it's not that K "only keeps the first parameter"—it's that the constructor K (which is a function) happens to not take any arguments of type b.
Flip is a datatype that turns 3 arguments into a structure with one
Just as above, this is not quite right. The Flip declaration states that there can be values of type Flip f a b, and the only way to make them is by using the constructor Flip that has type f b a -> Flip f a b.
In case you're wondering how I'm coming up with the type signatures for the constructors K and Flip, it's not actually mysterious, and you can double check by typing :t K or :t Flip into GHCi. These types are assigned based entirely on the right hand side of the data type declaration. Also, note that the type name and constructor don't have to be the same. For instance, consider this data type:
data Foo a = Bar Int a | Foo String | Baz a a
This declares a type Foo a with three constructors:
Bar :: Int -> a -> Foo a
Foo :: String -> Foo a
Baz :: a -> a -> Foo a
Basically, each of the types after the constructor name are the arguments, in order, to the constructor.
Because in fmap :: (a-> b) -> f a -> f b, f a has kind *, to write the Functor instance of Flip, we write it on the last type in Flip. Aka f and a are "constants" in a way, and we write the functor for the type b.
This is basically right! You could also say that f has kind * -> *. Since Flip has kind (* -> *) -> * -> * -> *, you need to provide it two type arguments (the first of kind * -> * and the second of kind *) to get it to the right kind. Those first two arguments become fixed ("constants" in a way) in the instance.
I would write something like: ... I know that that is completely wrong but I'm not sure why.
The reason your instance is completely wrong is that you've mixed up the type with the constructor. It doesn't make sense to put (Flip x y z) in the pattern position where you did because the constructor Flip only takes one argument—remember, it's type is Flip :: f b a -> Flip f a b! So you'd want to write something like:
instance Functor (Flip f a) where
fmap f (Flip fxa) = ...
Now, what do you fill in for the ...? You have a value fxa :: f x a, and you have a function f :: x -> y, and you need to produce a value of type f y a. Honestly, I don't know how to do that. After all, what is a value of typ f x a? We don't know what f is?!
Also, why would we bring K into the Functor instance of Flip? Can someone explain thoroughly the process of coming up with this solution and why it is correct?
We saw just above that we can't write the Functor instance for an arbitrary f, but what we can do is write it for a particular f. It turns out that K is just such a particular f that works. Let's try to make it work:
instance Functor (Flip K a) where
fmap f (Flip kxa) = ...
When f was arbitrary, we got stuck here, but now we know that kxa :: K x a. Remember that the only way to make a value of type K x a is using the constructor K. Therefore, this value kxa must have been made using that constructor, so we can break it apart as in: kxa ⩳ K x' where x' :: x. Let's go ahead and put that into our pattern:
fmap f (Flip (K x')) = ...
Now we can make progress! We need to produce a value of type Flip K a y. Hmm. The only way to produce a value of type Flip is using the Flip constructor, so let's start with that:
fmap f (Flip (K x')) = Flip ...
The Flip constructor at type Flip K a y takes a value of type K y a. The only way to produce one of those is with the K constructor, so let's add that:
fmap f (Flip (K x')) = Flip (K ...)
The K constructor at type K y a takes a value of type y, so we need to provide a value of type y here. We have a value x' :: x and a function f :: x -> y. Plugging the first into the second gives us the value we need:
fmap f (Flip (K x')) = Flip (K (f x'))
Just rename x' to b, and you have exactly the code your teacher provided.
DDub wrote in their answer:
You have a value fxa :: f x a, and you have a function f :: x -> y, and you need to produce a value of type f y a. Honestly, I don't know how to do that. After all, what is a value of type f x a? We don't know what f is?!
And I agree, but I woulld like to add a bit. Your teacher's idea as to how to deal with this is pretty cool (things like this K come in quite handy when you are trying to write down some counterexample, like here), and yet, I reckon we can make this code way broader. I use Data.Bifunctor.
So, what are Bifunctors? They are just what their name says: a * -> * -> * type (which we call bifunctors as well sometimes, yet they are not the same thing) which allows mapping over its both arguments (snippet from the source):
class Bifunctor p where
-- | Map over both arguments at the same time.
--
-- #'bimap' f g ≡ 'first' f '.' 'second' g#
bimap :: (a -> b) -> (c -> d) -> p a c -> p b d
bimap f g = first f . second g
{-# INLINE bimap #-}
-- | Map covariantly over the first argument.
--
-- #'first' f ≡ 'bimap' f 'id'#
first :: (a -> b) -> p a c -> p b c
first f = bimap f id
{-# INLINE first #-}
-- | Map covariantly over the second argument.
--
-- #'second' ≡ 'bimap' 'id'#
second :: (b -> c) -> p a b -> p a c
second = bimap id
{-# INLINE second #-}
So, here is how I would go about that:
instance Bifunctor f => Functor (Flip f a) where
fmap x2y (Flip fxa) = Flip (first x2y fxa)
Speaking of your teacher's code, it's a very nice idea, yet a more narrow one as K is a Bifunctor:
instance Bifunctor K where
bimap f _g (K a) = K (f a)
A lawful one:
bimap id id (K a) = K (id a) = id (K a)
As it says in the link above, having bimap only written down, that's the only law we need to worry about.
We just need to use sane and helpful naming, and suddenly it all becomes simple and clear (as opposed to torturous and contorted):
data K b a = MkK b -- the type (K b a) "is" just (b)
newtype Flip f a b = MkFlip (f b a) -- the type (Flip f a b) "is" (f b a)
deriving (Eq, Show)
instance Functor (Flip K a) where
-- fmap :: (b -> c) -> Flip K a b -> Flip K a c
fmap g (MkFlip (MkK b)) = MkFlip (MkK (g b))
-- MkK b :: K b a
-- MkFlip (_ :: K b a) :: Flip K a b
There's not even one question arising in our minds now looking at this, not one doubt we aren't able to immediately resolve.
Using same names for types and for data constructors while teaching, as well as using f both for "f"unction and "f"unctor, is pure abuse of the students.
Only when you've become fed up with all the Mks and don't feel they are helpful to you in any way, you can safely and easily throw them away, as experts usually do.
For instance, for Either, there are two arguments L and R.
What would be several ways of constructing both of the single-parameter type constructors from Either: Either L and (pseudo code) Either _ R?
One way, I suppose, is to declare a type alias:
type EitherL L = Either L R -- for some fixed R
But are there ways to do this inline without needing to construct type aliases?
Things don't always translate directly. In particular, you have to decide what you want to be first-class and what can be second-class.
-- You can do this, but it must always
-- be fully applied.
type FlipF f a b = f b a
-- This is more exciting, as it can
-- be partially applied.
newtype Flip f a b = Flip {unFlip :: f b a}
Now
Either a b = FlipF Either b a
Either a b ~= Flip Either b a
Currying you have multiple options too.
type CurryF f a b = f '(a, b)
newtype Curry f a b = Curry {unCurry :: f '(a, b)}
Uncurrying is a bit trickier.
type family UncurryF f ab where
UncurryF f '(a, b) = f a b
data Uncurry1 f ab where
Uncurry1 :: f a b -> f '(a, b)
newtype Uncurry2 f ab = Uncurry2
{reCurry2 :: f (Fst ab) (Snd ab)}
type family Fst ab where
Fst '(a, _) = a
type family Snd ab where
Snd '(_, b) = b
Which uncurry you need will be somewhat application dependent.
In Haskell, there are many examples of higher kinded polymorphism when dealing with ad hoc polymorphism, such as Monad and Functor. However, I cannot think of any examples of this for parametric polymorphism.
Is this possible, and if so, can I have an example of one which is useful?
If you still allow typeclass constraints, then the answer is, sure! E.g. I'd still call something like
normalise :: (Foldable f, Functor f, Fractional n) => f n -> f n
normalise v = fmap (/sum v) V
parametric polymorphism. But I suppose that's not what you have in mind.
Another thing that's obviously possible is to just contrain types to have a particular form _ _, like
hmap :: (f a -> f b) -> [f a] -> [f b]
hmap = map
This isn't exactly remarkable, but it could possibly be useful in some applications as a subtle hint to the type checker. In fact, this is one way you can solve the phantom argument problem: instead of
class LengthyList l where minimumLength :: l a -> Int
instance LengthyList [] where minimumLength _ = 0
instance LengthyList NonEmpty where minimumLength _ = 1
you might make the signature
minimumLength :: p (l a) -> Int
aka
minimumLength :: proxy (l a) -> Int
Thereby you still pass in the type-information of l, but guarantee that the implementation cannot try to evaluate the argument at runtime.
The standard way to do this is however
minimumLength :: Tagged (l a) Int
or
minimumLength :: Proxy (l a) -> Int
Generally though, there's nothing you could do with f a that couldn't also be done with fa, so essentially you could rewrite the type of any such higher-order parametric function to a first-order parametrically polymorphic one.
You totally can do this. A type synonym pigworker is fond of:
type f ~> g = forall a . f a -> g a
This, for reasons I don't actually know, represents a natural transformation (whatever exactly that is) between functors f and g. But a function can take an argument of type f ~> g and apply it to as many types f a as it likes. Using non-regular types (specifically, higher-order nested data types, as Ralf Hinze, for example, explored in Numerical Representations as Higher-Order Nested Datatypes), it could be applied to an unbounded number of different types.
A contrived example:
{-# LANGUAGE RankNTypes, TypeOperators #-}
type f ~> g = forall a . f a -> g a
data Two g a = Two (g a) (g a)
data Foo f a = This (f a)
| That (Foo (Two f) a)
hello :: (f ~> g) -> Foo f a -> Foo g a
hello t (This fa) = This (t fa)
hello t (That buh) =
That (hello (\(Two x y) -> Two (t x) (t y)) buh)
hello is polymorphic in the types f and g, each of which has kind * -> *. † I believe that converting this to use only types of kind * could require non-trivial refactoring.
†In fact, if you enable PolyKinds, f and g will each have a polykinded type k -> *.
One example I'm quite fond of is the foldr operator for lists indexed by their length: it is parametrically polymorphic over a predicate p of kind Nat -> * and guarantees that if you apply it to a list of length m then you get back a proof of p m.
This corresponds to this type:
foldr :: forall a (p :: Nat -> *).
(forall n. a -> p n -> p ('Succ n)) ->
p 'Zero ->
forall n. Vec a n -> p n
This extra precision makes it possible to implement e.g. append using foldr rather than having to proceed by pattern-matching.
append :: forall a m n. Vec a m -> Vec a n -> Vec a (m :+: n)
I've uploaded a complete gist with all the right language extensions turned on and the code corresponding to these types in case you want to peek.
Lets say I have the following data type:
data D a b = D (a,b) (b,a)
And I want to define the following function on it:
apply f (D x y) = D (f x) (f y)
What is the type signature of apply?
Here are some examples of f which are okay:
f :: a -> a -- OK
f :: (a, b) -> (b, a) -- OK
f :: (a, b) -> ((a, c), (b, c)) -- OK
In all of the above cases, we end up with a valid type D.
But this is not okay:
f :: (a, b) -> (a, a)
Because when we send such a function through apply we end up having to attempt to construct D (a,a) (b,b) which is not valid unless a = b.
I can't seem to work out a type signature to express all this? Also, in general, is there a way to get GHC to tell me what these signatures should be?
Typed Holes Edit:
In an attempt to find the type using typed holes, I tried the following:
x = apply _ (D (1::Int,'a') ('b',2::Int))
And got:
Found hole ‘_’ with type: (Int, Int) -> (b, b)
Where: ‘b’ is a rigid type variable bound by
the inferred type of x :: D b b
Which seems to me to be nonsense as f :: (Int, Int) -> (b, b) is clearly not going to work here.
Multiple types fit apply, but the inferred ((t, t) -> (b, b)) -> D t t -> D b b is the most sensible and usable one. The alternatives are going to be higher-rank, so let's enable that language extension:
{-# LANGUAGE RankNTypes #-}
First, we can make apply id work:
apply :: (forall a. a -> a) -> D a b -> D a b
apply f (D x y) = D (f x) (f y)
However, now id is the only function with which apply works (all total functions of type forall a. a -> a are equal to id).
Here's another type:
apply :: (forall a. a -> (c, c)) -> D a b -> D c c
apply f (D x y) = D (f x) (f y)
But this too comes at a price. Now the f-s can only be constant functions that ignore the previous fields of D. So apply (const (0, 0)) works, but we have no way to inspect the argument of f.
In contrast, the inferred type is pretty useful. We can express transformations with it that look at the actual data contained in D.
At this point, we might ask: why does GHC infer what it infers? After all, some functions work with the alternative types, but don't work with the default type. Could it be better to sometimes infer higher-ranked types? Well, such types are often extremely useful, but inferring them is unfeasible.
Type inference for rank-2 types is rather complicated, and not very practical either, because it's not possible to infer most general types. With rank-1 inference, we can infer a type that is more general than all other valid types for the same expression. There's no such guarantee with rank-2 types. And inference for rank-3 and above types is just undecidable.
For these reasons, GHC sticks to rank-1 inference, so it never infers types with forall-s inside function arguments.
Taking things to extremes of generality, we want a type that looks like
apply :: tf -> D a b -> D c d
where tf represents the type of f. In order to apply f to (a,b) and get (c,d), we need
tf ~ (a,b) -> (c,d)
In order to apply f to (b,a) to get (d,c), we need
tf ~ (b,a) -> (d,c)
If we turn on TypeFamilies (or GADTs) we get the magic constraint we need to express that:
{-# LANGUAGE TypeFamilies #-}
apply :: (((a,b) -> (c,d)) ~ tf,
((b,a) -> (d,c)) ~ tf) =>
tf -> D a b -> D c d
I suspect this is one of the most general types available. Unfortunately, it's pretty wild; working through whether a particular application will pass the type checker is not always so easy. Note also that for reasons I don't personally understand, you can't reliably define specializations using
apply' :: ...
apply' = apply
Instead, you sometimes must use
apply' f = apply f
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.