Consider this an addendum to @chi's answer to provide additional explanation of the singleton approach...
I would suggest reading the Hasochism paper if you haven't already done so. In particular, in section 3.1 of that paper, they deal with exactly this problem, and use it as the motivating example for when implicit singleton parameters (the SingI of @chi's answer, and the NATTY type class in the Hasochism paper) are necessary, rather than merely convenient.
As it applies to your code, the main issue is that pure needs a run-time representation of the length of the vector that it's supposed to be generating, and the type-level variable n doesn't fit the bill. The solution is to introduce a new GADT, a "singleton" that provides runtime values that correspond directly to the promoted types Next and Zero:
data Natty (n :: Nat) where
ZeroTy :: Natty Zero
NextTy :: Natty n -> Natty (Next n)
I tried to use roughly the same naming convention as the paper: Natty is the same, and ZeroTy and NextTy correspond to the paper's Zy and Sy.
By itself, this explicit singleton is useful. For example, see the definition of vchop in the paper. Also, we can easily write a variant of pure that takes the explicit singleton to do its job:
vcopies :: Natty n -> a -> Vector n a
vcopies ZeroTy _ = Empty
vcopies (NextTy n) x = Construct x (vcopies n x)
We can't yet use this to define pure, though, because pure's signature is determined by the Applicative type class, and we have no way to squeeze the explicit singleton Natty n in there.
The solution is to introduce implicit singletons, which allow us to retrieve an explicit singleton whenever needed through the natty function in the context of the following type class:
class NATTY n where
natty :: Natty n
instance NATTY Zero where
natty = ZeroTy
instance NATTY n => NATTY (Next n) where
natty = NextTy natty
Now, provided we're in a NATTY n context, we can call vcopies natty to supply vcopies with its explicit natty parameter, which allows us to write:
instance NATTY n => Applicative (Vector n) where
(<*>) = vapp
pure = vcopies natty
using the definitions of vcopies and natty above, and the definition of vapp below:
vapp :: Vector n (a -> b) -> Vector n a -> Vector n b
vapp Empty Empty = Empty
vapp (Construct f c) (Construct x d) = Construct (f x) (vapp c d)
Note one oddity. We needed to introduce this vapp helper function for an obscure reason. The following instance without NATTY matches your case-based definition and type-checks fine:
instance Applicative (Vector n) where
Empty <*> Empty = Empty
Construct f c <*> Construct x d = Construct (f x) (c <*> d)
pure = error "Argh! No NATTY!"
If we add the NATTY constraint to define pure:
instance NATTY n => Applicative (Vector n) where
Empty <*> Empty = Empty
Construct f c <*> Construct x d = Construct (f x) (c <*> d)
pure = vcopies natty
the definition of (<*>) doesn't type check any more. The problem is that the NATTY n constraint on the left-hand side of the second (<*>) case doesn't automatically imply a NATTY n1 constraint on the right-hand side (where Next n ~ n1), so GHC doesn't want to allow us to call (<*>) on the right-hand side. In this case, because the constraint isn't actually needed after it's used for the first time, a helper function without a NATTY constraint, namely vapp, works around the problem.
@chi uses case matching on natty and the helper function withSingI as an alternative workaround. The equivalent code here would use a helper function that turns an explicit singleton into an implicit NATTY context:
withNATTY :: Natty n -> (NATTY n => a) -> a
withNATTY ZeroTy a = a
withNATTY (NextTy n) a = withNATTY n a
allowing us to write:
instance NATTY n => Applicative (Vector n) where
Empty <*> Empty = Empty
Construct f c <*> Construct x d = case (natty :: Natty n) of
NextTy n -> withNATTY n $ Construct (f x) (c <*> d)
pure x = case (natty :: Natty n) of
ZeroTy -> Empty
NextTy n -> Construct x (withNATTY n $ pure x)
This would need both ScopedTypeVariables and RankNTypes.
Anyway, sticking with the helper functions, the complete program looks like this:
{-# LANGUAGE DataKinds, GADTs, KindSignatures #-}
module Vector where
data Nat = Next Nat | Zero
data Vector :: Nat -> * -> * where
Construct :: t -> Vector n t -> Vector ('Next n) t
Empty :: Vector 'Zero t
data Natty (n :: Nat) where
ZeroTy :: Natty Zero
NextTy :: Natty n -> Natty (Next n)
class NATTY n where
natty :: Natty n
instance NATTY Zero where
natty = ZeroTy
instance NATTY n => NATTY (Next n) where
natty = NextTy natty
instance Functor (Vector n) where
fmap f a =
case a of
Construct x b -> Construct (f x) (fmap f b)
Empty -> Empty
instance NATTY n => Applicative (Vector n) where
(<*>) = vapp
pure = vcopies natty
vapp :: Vector n (a -> b) -> Vector n a -> Vector n b
vapp Empty Empty = Empty
vapp (Construct f c) (Construct x d) = Construct (f x) (vapp c d)
vcopies :: Natty n -> a -> Vector n a
vcopies ZeroTy _ = Empty
vcopies (NextTy n) x = Construct x (vcopies n x)
The correspondence with the singletons library is that:
$(singletons [d|
data Nat = Next Nat | Zero
|])
automatically generates the singletons (with constructors SZero and SNat instead of ZeroTy and NatTy; and with type SNat instead of Natty) and the implicit singleton class (called SingI instead of NATTY and using the function sing instead of natty), giving the complete program:
{-# LANGUAGE DataKinds, GADTs, KindSignatures, TemplateHaskell, TypeFamilies #-}
module Vector where
import Data.Singletons
import Data.Singletons.TH
$(singletons [d|
data Nat = Next Nat | Zero
|])
data Vector :: Nat -> * -> * where
Construct :: t -> Vector n t -> Vector ('Next n) t
Empty :: Vector 'Zero t
instance Functor (Vector n) where
fmap f a =
case a of
Construct x b -> Construct (f x) (fmap f b)
Empty -> Empty
instance SingI n => Applicative (Vector n) where
(<*>) = vapp
pure = vcopies sing
vapp :: Vector n (a -> b) -> Vector n a -> Vector n b
vapp Empty Empty = Empty
vapp (Construct f c) (Construct x d) = Construct (f x) (vapp c d)
vcopies :: SNat n -> a -> Vector n a
vcopies SZero _ = Empty
vcopies (SNext n) x = Construct x (vcopies n x)
For more on what the singletons library does and how it's built, I'd suggest reading Introduction to Singletons.
