Copyright | (C) 2013 Richard Eisenberg |
---|---|
License | BSD-style (see LICENSE) |
Maintainer | Richard Eisenberg (eir@cis.upenn.edu) |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
This module contains everything you need to derive your own singletons via Template Haskell.
TURN ON -XScopedTypeVariables
IN YOUR MODULE IF YOU WANT THIS TO WORK.
- singletons :: Quasi q => q [Dec] -> q [Dec]
- singletonsOnly :: Quasi q => q [Dec] -> q [Dec]
- genSingletons :: Quasi q => [Name] -> q [Dec]
- promote :: Quasi q => q [Dec] -> q [Dec]
- promoteOnly :: Quasi q => q [Dec] -> q [Dec]
- promoteEqInstances :: Quasi q => [Name] -> q [Dec]
- promoteEqInstance :: Quasi q => Name -> q [Dec]
- singEqInstances :: Quasi q => [Name] -> q [Dec]
- singEqInstance :: Quasi q => Name -> q [Dec]
- singEqInstancesOnly :: Quasi q => [Name] -> q [Dec]
- singEqInstanceOnly :: Quasi q => Name -> q [Dec]
- singDecideInstances :: Quasi q => [Name] -> q [Dec]
- singDecideInstance :: Quasi q => Name -> q [Dec]
- cases :: Quasi q => Name -> q Exp -> q Exp -> q Exp
- data family Sing a
- class SingI a where
- class (kparam ~ KProxy) => SingKind kparam where
- type KindOf a = (KProxy :: KProxy k)
- type Demote a = DemoteRep (KProxy :: KProxy k)
- type family a == b :: Bool
- type (:==) a b = a == b
- type family If cond tru fls :: k
- sIf :: Sing a -> Sing b -> Sing c -> Sing (If a b c)
- type (:&&) a b = a && b
- class (kparam ~ KProxy) => SEq kparam where
- data Any
- class (kparam ~ KProxy) => SDecide kparam where
- data a :~: b where
- data Void
- type Refuted a = a -> Void
- data Decision a
- data KProxy t = KProxy
- data SomeSing kproxy where
Primary Template Haskell generation functions
singletons :: Quasi q => q [Dec] -> q [Dec] Source
Make promoted and singleton versions of all declarations given, retaining the original declarations. See http://www.cis.upenn.edu/~eir/packages/singletons/README.html for further explanation.
singletonsOnly :: Quasi q => q [Dec] -> q [Dec] Source
Make promoted and singleton versions of all declarations given, discarding the original declarations.
genSingletons :: Quasi q => [Name] -> q [Dec] Source
Generate singleton definitions from a type that is already defined. For example, the singletons package itself uses
$(genSingletons [''Bool, ''Maybe, ''Either, ''[]])
to generate singletons for Prelude types.
promote :: Quasi q => q [Dec] -> q [Dec] Source
Promote every declaration given to the type level, retaining the originals.
promoteOnly :: Quasi q => q [Dec] -> q [Dec] Source
Promote each declaration, discarding the originals.
Functions to generate equality instances
promoteEqInstances :: Quasi q => [Name] -> q [Dec] Source
Produce instances for '(:==)' (type-level equality) from the given types
promoteEqInstance :: Quasi q => Name -> q [Dec] Source
Produce an instance for '(:==)' (type-level equality) from the given type
singEqInstances :: Quasi q => [Name] -> q [Dec] Source
Create instances of SEq
and type-level '(:==)' for each type in the list
singEqInstance :: Quasi q => Name -> q [Dec] Source
Create instance of SEq
and type-level '(:==)' for the given type
singEqInstancesOnly :: Quasi q => [Name] -> q [Dec] Source
Create instances of SEq
(only -- no instance for '(:==)', which SEq
generally
relies on) for each type in the list
singEqInstanceOnly :: Quasi q => Name -> q [Dec] Source
Create instances of SEq
(only -- no instance for '(:==)', which SEq
generally
relies on) for the given type
singDecideInstances :: Quasi q => [Name] -> q [Dec] Source
Create instances of SDecide
for each type in the list.
Note that, due to a bug in GHC 7.6.3 (and lower) optimizing instances
for SDecide can make GHC hang. You may want to put
{-# OPTIONS_GHC -O0 #-}
in your file.
singDecideInstance :: Quasi q => Name -> q [Dec] Source
Create instance of SDecide
for the given type.
Note that, due to a bug in GHC 7.6.3 (and lower) optimizing instances
for SDecide can make GHC hang. You may want to put
{-# OPTIONS_GHC -O0 #-}
in your file.
Utility function
:: Quasi q | |
=> Name | The head of the type of the scrutinee. (Like |
-> q Exp | The scrutinee, in a Template Haskell quote |
-> q Exp | The body, in a Template Haskell quote |
-> q Exp |
The function cases
generates a case expression where each right-hand side
is identical. This may be useful if the type-checker requires knowledge of which
constructor is used to satisfy equality or type-class constraints, but where
each constructor is treated the same.
Basic singleton definitions
The singleton kind-indexed data family.
TestCoercion * (Sing *) | |
SDecide k (KProxy k) => TestEquality k (Sing k) | |
data Sing Bool where | |
data Sing Ordering where | |
data Sing * where | |
data Sing Nat where | |
data Sing Symbol where
| |
data Sing () where | |
data Sing [a0] where | |
data Sing (Maybe a0) where | |
data Sing (Either a0 b0) where | |
data Sing ((,) a0 b0) where | |
data Sing ((,,) a0 b0 c0) where | |
data Sing ((,,,) a0 b0 c0 d0) where | |
data Sing ((,,,,) a0 b0 c0 d0 e0) where | |
data Sing ((,,,,,) a0 b0 c0 d0 e0 f0) where | |
data Sing ((,,,,,,) a0 b0 c0 d0 e0 f0 g0) where |
A SingI
constraint is essentially an implicitly-passed singleton.
If you need to satisfy this constraint with an explicit singleton, please
see withSingI
.
Produce the singleton explicitly. You will likely need the ScopedTypeVariables
extension to use this method the way you want.
SingI Bool False | |
SingI Bool True | |
SingI Ordering LT | |
SingI Ordering EQ | |
SingI Ordering GT | |
Typeable * a => SingI * a | |
KnownNat n => SingI Nat n | |
KnownSymbol n => SingI Symbol n | |
SingI () () | |
SingI [k] ([] k) | |
SingI (Maybe k) (Nothing k) | |
SingI a0 n0 => SingI (Maybe a) (Just a n) | |
(SingI a0 n0, SingI [a0] n1) => SingI [a] ((:) a n n) | |
SingI b0 n0 => SingI (Either k b) (Right k b n) | |
SingI a0 n0 => SingI (Either a k) (Left a k n) | |
(SingI a0 n0, SingI b0 n1) => SingI ((,) a b) ((,) a b n n) | |
(SingI a0 n0, SingI b0 n1, SingI c0 n2) => SingI ((,,) a b c) ((,,) a b c n n n) | |
(SingI a0 n0, SingI b0 n1, SingI c0 n2, SingI d0 n3) => SingI ((,,,) a b c d) ((,,,) a b c d n n n n) | |
(SingI a0 n0, SingI b0 n1, SingI c0 n2, SingI d0 n3, SingI e0 n4) => SingI ((,,,,) a b c d e) ((,,,,) a b c d e n n n n n) | |
(SingI a0 n0, SingI b0 n1, SingI c0 n2, SingI d0 n3, SingI e0 n4, SingI f0 n5) => SingI ((,,,,,) a b c d e f) ((,,,,,) a b c d e f n n n n n n) | |
(SingI a0 n0, SingI b0 n1, SingI c0 n2, SingI d0 n3, SingI e0 n4, SingI f0 n5, SingI g0 n6) => SingI ((,,,,,,) a b c d e f g) ((,,,,,,) a b c d e f g n n n n n n n) |
class (kparam ~ KProxy) => SingKind kparam where Source
The SingKind
class is essentially a kind class. It classifies all kinds
for which singletons are defined. The class supports converting between a singleton
type and the base (unrefined) type which it is built from.
type DemoteRep kparam :: * Source
Get a base type from a proxy for the promoted kind. For example,
DemoteRep ('KProxy :: KProxy Bool)
will be the type Bool
.
fromSing :: Sing (a :: k) -> DemoteRep kparam Source
Convert a singleton to its unrefined version.
toSing :: DemoteRep kparam -> SomeSing kparam Source
Convert an unrefined type to an existentially-quantified singleton type.
type KindOf a = (KProxy :: KProxy k) Source
Convenient synonym to refer to the kind of a type variable:
type KindOf (a :: k) = ('KProxy :: KProxy k)
type Demote a = DemoteRep (KProxy :: KProxy k) Source
Convenient abbreviation for DemoteRep
:
type Demote (a :: k) = DemoteRep ('KProxy :: KProxy k)
Auxiliary definitions
These definitions might be mentioned in code generated by Template Haskell, so they must be in scope.
A type family to compute Boolean equality. Instances are provided
only for open kinds, such as *
and function kinds. Instances are
also provided for datatypes exported from base. A poly-kinded instance
is not provided, as a recursive definition for algebraic kinds is
generally more useful.
type (==) Bool a b = EqBool a b | |
type (==) Ordering a b = EqOrdering a b | |
type (==) * a b = EqStar a b | |
type (==) Nat a b = EqNat a b | |
type (==) Symbol a b = EqSymbol a b | |
type (==) () a b = EqUnit a b | |
type (==) [k] a b = EqList k a b | |
type (==) (Maybe k) a b = EqMaybe k a b | |
type (==) (k -> k1) a b = EqArrow k k1 a b | |
type (==) (Either k k1) a b = EqEither k k1 a b | |
type (==) ((,) k k1) a b = Eq2 k k1 a b | |
type (==) ((,,) k k1 k2) a b = Eq3 k k1 k2 a b | |
type (==) ((,,,) k k1 k2 k3) a b = Eq4 k k1 k2 k3 a b | |
type (==) ((,,,,) k k1 k2 k3 k4) a b = Eq5 k k1 k2 k3 k4 a b | |
type (==) ((,,,,,) k k1 k2 k3 k4 k5) a b = Eq6 k k1 k2 k3 k4 k5 a b | |
type (==) ((,,,,,,) k k1 k2 k3 k4 k5 k6) a b = Eq7 k k1 k2 k3 k4 k5 k6 a b | |
type (==) ((,,,,,,,) k k1 k2 k3 k4 k5 k6 k7) a b = Eq8 k k1 k2 k3 k4 k5 k6 k7 a b | |
type (==) ((,,,,,,,,) k k1 k2 k3 k4 k5 k6 k7 k8) a b = Eq9 k k1 k2 k3 k4 k5 k6 k7 k8 a b | |
type (==) ((,,,,,,,,,) k k1 k2 k3 k4 k5 k6 k7 k8 k9) a b = Eq10 k k1 k2 k3 k4 k5 k6 k7 k8 k9 a b | |
type (==) ((,,,,,,,,,,) k k1 k2 k3 k4 k5 k6 k7 k8 k9 k10) a b = Eq11 k k1 k2 k3 k4 k5 k6 k7 k8 k9 k10 a b | |
type (==) ((,,,,,,,,,,,) k k1 k2 k3 k4 k5 k6 k7 k8 k9 k10 k11) a b = Eq12 k k1 k2 k3 k4 k5 k6 k7 k8 k9 k10 k11 a b | |
type (==) ((,,,,,,,,,,,,) k k1 k2 k3 k4 k5 k6 k7 k8 k9 k10 k11 k12) a b = Eq13 k k1 k2 k3 k4 k5 k6 k7 k8 k9 k10 k11 k12 a b | |
type (==) ((,,,,,,,,,,,,,) k k1 k2 k3 k4 k5 k6 k7 k8 k9 k10 k11 k12 k13) a b = Eq14 k k1 k2 k3 k4 k5 k6 k7 k8 k9 k10 k11 k12 k13 a b | |
type (==) ((,,,,,,,,,,,,,,) k k1 k2 k3 k4 k5 k6 k7 k8 k9 k10 k11 k12 k13 k14) a b = Eq15 k k1 k2 k3 k4 k5 k6 k7 k8 k9 k10 k11 k12 k13 k14 a b |
type (:==) a b = a == b Source
A re-export of the type-level (==)
that conforms to the singletons naming
convention.
class (kparam ~ KProxy) => SEq kparam where Source
The singleton analogue of Eq
. Unlike the definition for Eq
, it is required
that instances define a body for '(%:==)'. You may also supply a body for '(%:/=)'.
(%:==) :: forall a b. Sing a -> Sing b -> Sing (a :== b) Source
Boolean equality on singletons
(%:/=) :: forall a b. Sing a -> Sing b -> Sing (a :/= b) Source
Boolean disequality on singletons
SEq Bool (KProxy Bool) | |
SEq Ordering (KProxy Ordering) | |
SEq * (KProxy *) | |
SEq Nat (KProxy Nat) | |
SEq Symbol (KProxy Symbol) | |
SEq () (KProxy ()) | |
SEq a0 (KProxy a0) => SEq [a] (KProxy [a]) | |
SEq a0 (KProxy a0) => SEq (Maybe a) (KProxy (Maybe a)) | |
(SEq a0 (KProxy a0), SEq b0 (KProxy b0)) => SEq (Either a b) (KProxy (Either a b)) | |
(SEq a0 (KProxy a0), SEq b0 (KProxy b0)) => SEq ((,) a b) (KProxy ((,) a b)) | |
(SEq a0 (KProxy a0), SEq b0 (KProxy b0), SEq c0 (KProxy c0)) => SEq ((,,) a b c) (KProxy ((,,) a b c)) | |
(SEq a0 (KProxy a0), SEq b0 (KProxy b0), SEq c0 (KProxy c0), SEq d0 (KProxy d0)) => SEq ((,,,) a b c d) (KProxy ((,,,) a b c d)) | |
(SEq a0 (KProxy a0), SEq b0 (KProxy b0), SEq c0 (KProxy c0), SEq d0 (KProxy d0), SEq e0 (KProxy e0)) => SEq ((,,,,) a b c d e) (KProxy ((,,,,) a b c d e)) | |
(SEq a0 (KProxy a0), SEq b0 (KProxy b0), SEq c0 (KProxy c0), SEq d0 (KProxy d0), SEq e0 (KProxy e0), SEq f0 (KProxy f0)) => SEq ((,,,,,) a b c d e f) (KProxy ((,,,,,) a b c d e f)) | |
(SEq a0 (KProxy a0), SEq b0 (KProxy b0), SEq c0 (KProxy c0), SEq d0 (KProxy d0), SEq e0 (KProxy e0), SEq f0 (KProxy f0), SEq g0 (KProxy g0)) => SEq ((,,,,,,) a b c d e f g) (KProxy ((,,,,,,) a b c d e f g)) |
data Any
The type constructor Any
is type to which you can unsafely coerce any
lifted type, and back.
- It is lifted, and hence represented by a pointer
- It does not claim to be a data type, and that's important for the code generator, because the code gen may enter a data value but never enters a function value.
It's also used to instantiate un-constrained type variables after type
checking. For example, length
has type
length :: forall a. [a] -> Int
and the list datacon for the empty list has type
[] :: forall a. [a]
In order to compose these two terms as length []
a type
application is required, but there is no constraint on the
choice. In this situation GHC uses Any
:
length (Any *) ([] (Any *))
Note that Any
is kind polymorphic, and takes a kind k
as its
first argument. The kind of Any
is thus forall k. k -> k
.
class (kparam ~ KProxy) => SDecide kparam where Source
Members of the SDecide
"kind" class support decidable equality. Instances
of this class are generated alongside singleton definitions for datatypes that
derive an Eq
instance.
(%~) :: forall a b. Sing a -> Sing b -> Decision (a :~: b) Source
Compute a proof or disproof of equality, given two singletons.
data a :~: b where
Propositional equality. If a :~: b
is inhabited by some terminating
value, then the type a
is the same as the type b
. To use this equality
in practice, pattern-match on the a :~: b
to get out the Refl
constructor;
in the body of the pattern-match, the compiler knows that a ~ b
.
Since: 4.7.0.0
A logically uninhabited data type.
A Decision
about a type a
is either a proof of existence or a proof that a
cannot exist.
data KProxy t
A concrete, promotable proxy type, for use at the kind level There are no instances for this because it is intended at the kind level only
data SomeSing kproxy where Source
An existentially-quantified singleton. This type is useful when you want a singleton type, but there is no way of knowing, at compile-time, what the type index will be. To make use of this type, you will generally have to use a pattern-match:
foo :: Bool -> ... foo b = case toSing b of SomeSing sb -> {- fancy dependently-typed code with sb -}
An example like the one above may be easier to write using withSomeSing
.