singletons
A framework for generating singleton types
http://www.github.com/goldfirere/singletons
| Version on this page: | 2.6 |
| LTS Haskell 24.18: | 3.0.4 |
| Stackage Nightly 2025-11-04: | 3.0.4 |
| Latest on Hackage: | 3.0.4 |
singletons-2.6@sha256:e8e9cea442e37f565fab8604fe54f78c776421e54ed67ac6b4c454e11991db0b,7167Module documentation for 2.6
- Data
- Data.Singletons
- Data.Singletons.CustomStar
- Data.Singletons.Decide
- Data.Singletons.Prelude
- Data.Singletons.Prelude.Applicative
- Data.Singletons.Prelude.Base
- Data.Singletons.Prelude.Bool
- Data.Singletons.Prelude.Const
- Data.Singletons.Prelude.Either
- Data.Singletons.Prelude.Enum
- Data.Singletons.Prelude.Eq
- Data.Singletons.Prelude.Foldable
- Data.Singletons.Prelude.Function
- Data.Singletons.Prelude.Functor
- Data.Singletons.Prelude.Identity
- Data.Singletons.Prelude.IsString
- Data.Singletons.Prelude.List
- Data.Singletons.Prelude.Maybe
- Data.Singletons.Prelude.Monad
- Data.Singletons.Prelude.Monoid
- Data.Singletons.Prelude.Num
- Data.Singletons.Prelude.Ord
- Data.Singletons.Prelude.Semigroup
- Data.Singletons.Prelude.Show
- Data.Singletons.Prelude.Traversable
- Data.Singletons.Prelude.Tuple
- Data.Singletons.Prelude.Void
- Data.Singletons.ShowSing
- Data.Singletons.Sigma
- Data.Singletons.SuppressUnusedWarnings
- Data.Singletons.TH
- Data.Singletons.TypeError
- Data.Singletons.TypeLits
- Data.Singletons.TypeRepTYPE
- Data.Singletons
singletons 2.6
This is the README file for the singletons library. This file contains all the documentation for the definitions and functions in the library.
The singletons library was written by Richard Eisenberg, [email protected], and with significant contributions by Jan Stolarek, [email protected]. There are two papers that describe the library. Original one, Dependently typed programming with singletons, is available here and will be referenced in this documentation as the “singletons paper”. A follow-up paper, Promoting Functions to Type Families in Haskell, is available here and will be referenced in this documentation as the “promotion paper”.
Ryan Scott, [email protected], is an active maintainer.
Purpose of the singletons library
The library contains a definition of singleton types, which allow programmers to use dependently typed techniques to enforce rich constraints among the types in their programs. See the singletons paper for a more thorough introduction.
The package also allows promotion of term-level functions to type-level
equivalents. Accordingly, it exports a Prelude of promoted and singletonized
functions, mirroring functions and datatypes found in Prelude, Data.Bool,
Data.Maybe, Data.Either, Data.Tuple and Data.List. See the promotion
paper for a more thorough introduction.
This blog series, authored by Justin Le, offers a tutorial for this library that assumes no knowledge of dependent types.
Compatibility
The singletons library requires GHC 8.8.1 or greater. Any code that uses the singleton generation primitives needs to enable a long list of GHC extensions. This list includes, but is not necessarily limited to, the following:
DataKindsDefaultSignaturesEmptyCaseExistentialQuantificationFlexibleContextsFlexibleInstancesGADTsInstanceSigsKindSignaturesNoStarIsTypePolyKindsRankNTypesScopedTypeVariablesTemplateHaskellTypeApplicationsTypeFamiliesTypeOperatorsUndecidableInstances
In particular, NoStarIsType is needed to use the * type family from the
PNum class because with StarIsType enabled, GHC thinks * is a synonym
for Type.
You may also want
-Wno-redundant-constraints
as the code that singletons generates uses redundant constraints, and there
seems to be no way, without a large library redesign, to avoid this.
Modules for singleton types
Data.Singletons exports all the basic singletons definitions. Import this
module if you are not using Template Haskell and wish only to define your
own singletons.
Data.Singletons.TH exports all the definitions needed to use the Template
Haskell code to generate new singletons.
Data.Singletons.Prelude re-exports Data.Singletons along with singleton
definitions for various Prelude types. This module provides a singletonized
equivalent of the real Prelude. Note that not all functions from original
Prelude could be turned into singletons.
Data.Singletons.Prelude.* modules provide singletonized equivalents of
definitions found in the following base library modules: Data.Bool,
Data.Maybe, Data.Either, Data.List, Data.Tuple, Data.Void and
GHC.Base. We also provide singletonized Eq, Ord, Show, Enum, and
Bounded typeclasses.
Data.Singletons.Decide exports type classes for propositional equality.
Data.Singletons.TypeLits exports definitions for working with GHC.TypeLits.
Modules for function promotion
Modules in Data.Promotion namespace provide functionality required for
function promotion. They mostly re-export a subset of definitions from
respective Data.Singletons modules.
Data.Promotion.TH exports all the definitions needed to use the Template
Haskell code to generate promoted definitions.
Data.Promotion.Prelude and Data.Promotion.Prelude.* modules re-export all
promoted definitions from respective Data.Singletons.Prelude
modules. Data.Promotion.Prelude.List adds a significant amount of functions
that couldn’t be singletonized but can be promoted. Some functions still don’t
promote - these are documented in the source code of the module. There is also
Data.Promotion.Prelude.Bounded module that provides promoted PBounded
typeclass.
Functions to generate singletons
The top-level functions used to generate singletons are documented in the
Data.Singletons.TH module. The most common case is just calling singletons,
which I’ll describe here:
singletons :: Q [Dec] -> Q [Dec]
Generates singletons from the definitions given. Because singleton generation requires promotion, this also promotes all of the definitions given to the type level.
Usage example:
$(singletons [d|
data Nat = Zero | Succ Nat
pred :: Nat -> Nat
pred Zero = Zero
pred (Succ n) = n
|])
Definitions used to support singletons
Please refer to the singletons paper for a more in-depth explanation of these definitions. Many of the definitions were developed in tandem with Iavor Diatchki.
type family Sing :: k -> Type
The type family of singleton types. A new instance of this type family is generated for every new singleton type.
class SingI (a :: k) where
sing :: Sing a
A class used to pass singleton values implicitly. The sing method produces
an explicit singleton value.
data SomeSing k where
SomeSing :: Sing (a :: k) -> SomeSing k
The SomeSing type wraps up an existentially-quantified singleton. Note that
the type parameter a does not appear in the SomeSing type. Thus, this type
can be used when you have a singleton, but you don’t know at compile time what
it will be. SomeSing Thing is isomorphic to Thing.
class SingKind k where
type Demote k :: *
fromSing :: Sing (a :: k) -> Demote k
toSing :: Demote k -> SomeSing k
This class is used to convert a singleton value back to a value in the
original, unrefined ADT. The fromSing method converts, say, a
singleton Nat back to an ordinary Nat. The toSing method produces
an existentially-quantified singleton, wrapped up in a SomeSing.
The Demote associated
kind-indexed type family maps the kind Nat back to the type Nat.
data SingInstance (a :: k) where
SingInstance :: SingI a => SingInstance a
singInstance :: Sing a -> SingInstance a
Sometimes you have an explicit singleton (a Sing) where you need an implicit
one (a dictionary for SingI). The SingInstance type simply wraps a SingI
dictionary, and the singInstance function produces this dictionary from an
explicit singleton. The singInstance function runs in constant time, using
a little magic.
Equality classes
There are two different notions of equality applicable to singletons: Boolean equality and propositional equality.
-
Boolean equality is implemented in the type family
(:==)(which is actually a synonym for the type family(==)fromData.Type.Equality) and the classSEq. See theData.Singletons.Prelude.Eqmodule for more information. -
Propositional equality is implemented through the constraint
(~), the type(:~:), and the classSDecide. See modulesData.Type.EqualityandData.Singletons.Decidefor more information.
Which one do you need? That depends on your application. Boolean equality has the advantage that your program can take action when two types do not equal, while propositional equality has the advantage that GHC can use the equality of types during type inference.
Instances of SEq, SDecide, TestEquality, and TestCoercion are generated
when singletons is called on a datatype that has deriving Eq. You can also
generate these instances directly through functions exported from
Data.Singletons.TH.
Show classes
Promoted and singled versions of the Show class (PShow and SShow,
respectively) are provided in the Data.Singletons.Prelude.Show module. In
addition, there is a ShowSing constraint synonym provided in the
Data.Singletons.ShowSing module:
type ShowSing k = (forall z. Show (Sing (z :: k))
This facilitates the ability to write Show instances for Sing instances.
What distinguishes all of these Shows? Let’s use the False constructor as
an example. If you used the PShow Bool instance, then the output of calling
Show_ on False is "False", much like the value-level Show Bool instance
(similarly for the SShow Bool instance). However, the Show (Sing (z :: Bool))
instance (i.e., ShowSing Bool) is intended for printing the value of the
singleton constructor SFalse, so calling show SFalse yields "SFalse".
Instance of PShow, SShow, and Show (for the singleton type) are generated
when singletons is called on a datatype that has deriving Show. You can also
generate these instances directly through functions exported from
Data.Singletons.TH.
A promoted and singled Show instance is provided for Symbol, but it is only
a crude approximation of the value-level Show instance for String. On the
value level, showing Strings escapes special characters (such as double
quotes), but implementing this requires pattern-matching on character literals,
something which is currently impossible at the type level. As a consequence, the
type-level Show instance for Symbols does not do any character escaping.
Errors
The singletons library provides two different ways to handle errors:
-
The
Errortype family, fromData.Singletons.TypeLits:type family Error (str :: a) :: k where {}This is simply an empty, closed type family, which means that it will fail to reduce regardless of its input. The typical use case is giving it a
Symbolas an argument, so that something akin toError "This is an error message"appears in error messages. -
The
TypeErrortype family, fromData.Singletons.TypeError. This is a drop-in replacement forTypeErrorfromGHC.TypeLitswhich can be used at both the type level and the value level (via thetypeErrorfunction).Unlike
Error,TypeErrorwill result in an actual compile-time error message, which may be more desirable depending on the use case.
Pre-defined singletons
The singletons library defines a number of singleton types and functions by default:
BoolMaybeEitherOrdering()- tuples up to length 7
- lists
These are all available through Data.Singletons.Prelude. Functions that
operate on these singletons are available from modules such as Data.Singletons.Bool
and Data.Singletons.Maybe.
Promoting functions
Function promotion allows to generate type-level equivalents of term-level definitions. Almost all Haskell source constructs are supported – see last section of this README for a full list.
Promoted definitions are usually generated by calling promote function:
$(promote [d|
data Nat = Zero | Succ Nat
pred :: Nat -> Nat
pred Zero = Zero
pred (Succ n) = n
|])
Every promoted function and data constructor definition comes with a set of
so-called “symbols”. These are required to represent partial application at the
type level. Each function gets N+1 symbols, where N is the arity. Symbols
represent application of between 0 to N arguments. When calling any of the
promoted definitions it is important refer to it using their symbol
name. Moreover, there is new function application at the type level represented
by Apply type family. Symbol representing arity X can have X arguments passed
in using normal function application. All other parameters must be passed by
calling Apply.
Users also have access to Data.Promotion.Prelude and its submodules (Base,
Bool, Either, List, Maybe and Tuple). These provide promoted versions
of function found in GHC’s base library.
Note that GHC resolves variable names in Template Haskell quotes. You cannot then use an undefined identifier in a quote, making idioms like this not work:
type family Foo a where ...
$(promote [d| ... foo x ... |])
In this example, foo would be out of scope.
Refer to the promotion paper for more details on function promotion.
Classes and instances
This is best understood by example. Let’s look at a stripped down Ord:
class Eq a => Ord a where
compare :: a -> a -> Ordering
(<) :: a -> a -> Bool
x < y = case x `compare` y of
LT -> True
EQ -> False
GT -> False
This class gets promoted to a “kind class” thus:
class PEq a => POrd a where
type Compare (x :: a) (y :: a) :: Ordering
type (:<) (x :: a) (y :: a) :: Bool
type x :< y = ... -- promoting `case` is yucky.
Note that default method definitions become default associated type family instances. This works out quite nicely.
We also get this singleton class:
class SEq a => SOrd a where
sCompare :: forall (x :: a) (y :: a). Sing x -> Sing y -> Sing (Compare x y)
(%:<) :: forall (x :: a) (y :: a). Sing x -> Sing y -> Sing (x :< y)
default (%:<) :: forall (x :: a) (y :: a).
((x :< y) ~ {- RHS from (:<) above -})
=> Sing x -> Sing y -> Sing (x :< y)
x %:< y = ... -- this is a bit yucky too
Note that a singletonized class needs to use default signatures, because
type-checking the default body requires that the default associated type
family instance was used in the promoted class. The extra equality constraint
on the default signature asserts this fact to the type checker.
Instances work roughly similarly.
instance Ord Bool where
compare False False = EQ
compare False True = LT
compare True False = GT
compare True True = EQ
instance POrd Bool where
type Compare 'False 'False = 'EQ
type Compare 'False 'True = 'LT
type Compare 'True 'False = 'GT
type Compare 'True 'True = 'EQ
instance SOrd Bool where
sCompare :: forall (x :: a) (y :: a). Sing x -> Sing y -> Sing (Compare x y)
sCompare SFalse SFalse = SEQ
sCompare SFalse STrue = SLT
sCompare STrue SFalse = SGT
sCompare STrue STrue = SEQ
The only interesting bit here is the instance signature. It’s not necessary in such a simple scenario, but more complicated functions need to refer to scoped type variables, which the instance signature can bring into scope. The defaults all just work.
On names
The singletons library has to produce new names for the new constructs it generates. Here are some examples showing how this is done:
-
original datatype:
Natpromoted kind:
Natsingleton type:
SNat(which is really a synonym forSing) -
original datatype:
/\promoted kind:
/\singleton type:
%/\ -
original constructor:
Succpromoted type:
'Succ(you can useSuccwhen unambiguous)singleton constructor:
SSuccsymbols:
SuccSym0,SuccSym1 -
original constructor:
:+:promoted type:
':+:singleton constructor:
:%+:symbols:
:+:@#@$,:+:@#@$$,:+:@#@$$$ -
original value:
predpromoted type:
Predsingleton value:
sPredsymbols:
PredSym0,PredSym1 -
original value:
+promoted type:
+singleton value:
%+symbols:
+@#@$,+@#@$$,+@#@$$$ -
original class:
Numpromoted class:
PNumsingleton class:
SNum -
original class:
~>promoted class:
#~>singleton class:
%~>
Special names
There are some special cases, listed below (with asterisks* denoting special treatment):
-
original datatype:
[]promoted kind:
[]singleton type*:
SList -
original constructor:
[]promoted type:
'[]singleton constructor*:
SNilsymbols*:
NilSym0 -
original constructor:
:promoted type:
':singleton constructor*:
SConssymbols:
:@#@$,:@#@$$,:@#@$$$ -
original datatype:
(,)promoted kind:
(,)singleton type*:
STuple2 -
original constructor:
(,)promoted type:
'(,)singleton constructor*:
STuple2symbols*:
Tuple2Sym0,Tuple2Sym1,Tuple2Sym2All tuples (including the 0-tuple, unit) are treated similarly.
-
original value:
___foopromoted type*:
US___foo(”US” stands for “underscore”)singleton value*:
___sfoosymbols*:
US___fooSym0All functions that begin with leading underscores are treated similarly.
Supported Haskell constructs
The following constructs are fully supported:
- variables
- tuples
- constructors
- if statements
- infix expressions and types
_patterns- aliased patterns
- lists (including list comprehensions)
do-notation- sections
- undefined
- error
- deriving
Eq,Ord,Show,Bounded,Enum,Functor,Foldable, andTraversable, as well as thestockandanyclassderiving strategies - class constraints (though these sometimes fail with
let,lambda, andcase) - literals (for
NatandSymbol), including overloaded number literals - unboxed tuples (which are treated as normal tuples)
- records
- pattern guards
- case
- let
- lambda expressions
!and~patterns (silently but successfully ignored during promotion)- class and instance declarations
- scoped type variables
- signatures (e.g.,
(x :: Maybe a)) in expressions and patterns InstanceSigs- higher-kinded type variables (see below)
- finite arithmetic sequences (see below)
- functional dependencies (with limitations – see below)
- type families (with limitations – see below)
Higher-kinded type variables in class/data declarations must be annotated
explicitly. This is due to GHC’s handling of complete
user-specified kind signatures, or CUSKs.
Briefly, singletons has a hard
time conforming to the precise rules that GHC imposes around CUSKs and so
needs a little help around kind inference here. See
this pull request for more
background.
singletons is slightly more conservative with respect to deriving than GHC is.
The stock classes listed above (Eq, Ord, Show, Bounded, Enum, Functor,
Foldable, and Traversable) are the only ones that singletons will derive
without an explicit deriving strategy. To do anything more exotic, one must
explicitly indicate one’s intentions by using the DerivingStrategies extension.
singletons fully supports the anyclass strategy as well as the stock strategy
(at least, for the classes listed above). singletons does not support the
newtype strategy, as there is not an equivalent of coerce at the type level.
singletons has partial support for arithmetic sequences (which desugar to
methods from the Enum class under the hood). Finite sequences (e.g.,
[0..42]) are fully supported. However, infinite sequences (e.g., [0..]),
which desugar to calls to enumFromTo or enumFromThenTo, are not supported,
as these would require using infinite lists at the type level.
The following constructs are supported for promotion but not singleton generation:
-
datatypes with constructors which have contexts. For example, the following datatype does not singletonize:
data T a where MkT :: Show a => a -> T aConstructors like these do not interact well with the current design of the
SingKindclass. But see this bug report, which proposes a redesign forSingKind(in a future version of GHC with certain bugfixes) which could permit constructors with equality constraints. -
overlapping patterns. Note that overlapping patterns are sometimes not obvious. For example, the
filterfunction does not singletonize due to overlapping patterns:filter :: (a -> Bool) -> [a] -> [a] filter _pred [] = [] filter pred (x:xs) | pred x = x : filter pred xs | otherwise = filter pred xsOverlap is caused by
otherwisecatch-all guard, which is always true and thus overlaps withpred xguard.Another non-obvious source of overlapping patterns comes from partial pattern matches in
do-notation. For example:f :: [()] f = do Just () <- [Nothing] return ()This has overlap because the partial pattern match desugars to the following:
f :: [()] f = case [Nothing] of Just () -> return () _ -> fail "Partial pattern match in do notation"Here, it is more evident that the catch-all pattern
_overlaps with the one above it.
The following constructs are not supported:
- datatypes that store arrows,
Nat, orSymbol - literals (limited support)
Why are these out of reach?
As described in the promotion paper, promotion of datatypes that store arrows is currently impossible. So if you have a declaration such as
data Foo = Bar (Bool -> Maybe Bool)
you will quickly run into errors.
Literals are problematic because we rely on GHC’s built-in support, which
currently is limited. Functions that operate on strings will not work because
type level strings are no longer considered lists of characters. Function
working on integer literals can be promoted by rewriting them to use
Nat. Since Nat does not exist at the term level it will only be possible to
use the promoted definition, but not the original, term-level one.
This is the same line of reasoning that forbids the use of Nat or Symbol
in datatype definitions. But, see this bug
report for a workaround.
Support for *
The built-in Haskell promotion mechanism does not yet have a full story around
the kind * (the kind of types that have values). Ideally, promoting some form
of TypeRep would yield *, but the implementation of TypeRep would have to
be updated for this to really work out. In the meantime, users who wish to
experiment with this feature have two options:
-
The module
Data.Singletons.TypeRepTYPEhas all the definitions possible for making*the promoted version ofTypeRep, asTypeRepis currently implemented. The singleton associated withTypeRephas one constructor:type instance Sing @(TYPE rep) = TypeRep(Recall that
type * = TYPE LiftedRep.) Note that any datatypes that storeTypeReps will not generally work as expected; the built-in promotion mechanism will not promoteTypeRepto*. -
The module
Data.Singletons.CustomStarallows the programmer to define a subset of types with which to work. See the Haddock documentation for the functionsingletonStarfor more info.
Known bugs
-
Record updates don’t singletonize
-
Inference dependent on functional dependencies is unpredictably bad. The problem is that a use of an associated type family tied to a class with fundeps doesn’t provoke the fundep to kick in. This is GHC’s problem, in the end.
-
Singled code that contains uses type families is likely to fail due to GHC Trac #12564. Note that singling type family declarations themselves is fine (and often desired, since that produces defunctionalization symbols for them).
-
Singling instances of poly-kinded type classes is likely to fail due to #358. However, one can often work around the issue by using
InstanceSigs. For instance, the following code will not single:class C (f :: k -> Type) where method :: f a instance C [] where method = []Adding a type signature for
methodin theC []is sufficient to work around the issue, though:instance C [] where method :: [a] method = []
Changes
Changelog for singletons project
2.6
-
Require GHC 8.8.
-
Singhas switched from a data family to a type family. This has a number of consequences:-
Names like
SBool,SMaybe, etc. are no longer type synonyms for particular instantiations ofSingbut are instead the names of the singleton data types themselves. In other words, previous versions ofsingletonswould provide this:data instance Sing :: Bool -> Type where SFalse :: Sing False STrue :: Sing True type SBool = (Sing :: Bool -> Type)Whereas with
Sing-as-a-type-family,singletonsnow provides this:data SBool :: Bool -> Type where SFalse :: SBool False STrue :: SBool True type instance Sing @Bool = SBool -
The
Singinstance forTYPE repinData.Singletons.TypeRepTYPEis now directly defined astype instance Sing @(TYPE rep) = TypeRep, without the use of an intermediate newtype as before. -
Due to limitations in the ways that quantified constraints and type families can interact (see this GHC issue), the internals of
ShowSinghas to be tweaked in order to continue to work withSing-as-a-type-family. One notable consequence of this is thatShowinstances for singleton types can no longer be derived—they must be written by hand in order to work around this GHC bug. This is unlikely to affect you unless you define ‘Show’ instances for singleton types by hand. For more information, refer to the Haddocks forShowSing'inData.Singletons.ShowSing. -
GHC does not permit type class instances to mention type families, which means that it is no longer possible to define instances that mention the
Singtype constructor. For this reason, aWrappedSingdata type (which is a newtype aroundSing) was introduced so that one can hang instances off of it.This had one noticeable effect in
singletonsitself: there are no longerTestEquality SingorTestCoercion Singinstances. Instead,singletonsnow generates a separateTestEquality/TestCoercioninstance for every data type that singles a derivedEqinstance. In addition, theData.Singletons.Decidemodule now provides top-leveldecideEquality/decideCoercionfunctions which provide the behavior oftestEquality/testCoercion, but monomorphized toSing. Finally,TestEquality/TestCoercioninstances are provided forWrappedSing.
-
-
GHC’s behavior surrounding kind inference for local definitions has changed in 8.8, and certain code that
singletonsgenerates for local definitions may no longer typecheck as a result. While we have taken measures to mitigate the issue onsingletons’ end, there still exists code that must be patched on the users’ end in order to continue compiling. For instance, here is an example of code that stopped compiling with the switch to GHC 8.8:replicateM_ :: (Applicative m) => Nat -> m a -> m () replicateM_ cnt0 f = loop cnt0 where loop cnt | cnt <= 0 = pure () | otherwise = f *> loop (cnt - 1)This produces errors to the effect of:
• Could not deduce (SNum k1) arising from a use of ‘sFromInteger’ from the context: SApplicative m ... • Could not deduce (SOrd k1) arising from a use of ‘%<=’ from the context: SApplicative m ...The issue is that GHC 8.8 now kind-generalizes
sLoop(whereas it did not previously), explaining why the error message mentions a mysterious kind variablek1that only appeared after kind generalization. The solution is to giveloopan explicit type signature like so:-replicateM_ :: (Applicative m) => Nat -> m a -> m () +replicateM_ :: forall m a. (Applicative m) => Nat -> m a -> m () replicateM_ cnt0 f = loop cnt0 where + loop :: Nat -> m () loop cnt | cnt <= 0 = pure () | otherwise = f *> loop (cnt - 1)This general approach should be sufficient to fix any type inference regressions that were introduced between GHC 8.6 and 8.8. If this isn’t the case, please file an issue.
-
Due to GHC Trac #16133 being fixed,
singletons-generated code now requires explicitly enabling theTypeApplicationsextension. (The generated code was always usingTypeApplicationsunder the hood, but it’s only now that GHC is detecting it.) -
Data.Singletonsnow defines a family ofSingIinstances forTyCon1throughTyCon8:instance (forall a. SingI a => SingI (f a), ...) => SingI (TyCon1 f) instance (forall a b. (SingI a, SingI b) => SingI (f a b), ...) => SingI (TyCon2 f) ...As a result,
singletonsno longer generates instances forSingIinstances for applications ofTyCon{N}to particular type constructors, as they have been superseded by the instances above. -
Changes to
Data.Singletons.Sigma:-
SSigma, the singleton type forSigma, is now defined. -
New functions
fstSigma,sndSigma,FstSigma,SndSigma,currySigma, anduncurrySigmahave been added. AShowinstance forSigmahas also been added. -
projSigma1has been redefined to use continuation-passing style to more closely resemble its cousinprojSigma2. The new type signature ofprojSigma1is:projSigma1 :: (forall (fst :: s). Sing fst -> r) -> Sigma s t -> rThe old type signature of
projSigma1can be found in thefstSigmafunction. -
Σhas been redefined such that it is now a partial application ofSigma, like so:type Σ = SigmaOne benefit of this change is that one no longer needs defunctionalization symbols in order to partially apply
Σ. As a result,ΣSym0,ΣSym1, andΣSym2have been removed.
-
-
In line with corresponding changes in
base-4.13, theFail/sFailmethods of{P,S}Monadhave been removed in favor of new{P,S}MonadFailclasses introduced in theData.Singletons.Prelude.Monad.Failmodule. These classes are also re-exported fromData.Singletons.Prelude. -
Fix a bug where expressions with explicit signatures involving function types would fail to single.
-
The infix names
(.)and(!)are no longer mapped to(:.)and(:!), as GHC 8.8 learned to parse them at the type level. -
The
Enuminstance forSomeSingnow uses more efficient implementations ofenumFromToandenumFromThenTothat no longer require aSingKindconstraint.
2.5.1
ShowSingis now a type class (with a single instance) instead of a type synonym. This was changed because definingShowSingas a type synonym prevents it from working well with recursive types due to an unfortunate GHC bug. For more information, see issue #371.- Add an
IsStringinstance forSomeSing.
2.5
-
The
Data.Promotion.Prelude.*namespace has been removed. Use the corresponding modules in theData.Singletons.Prelude.*namespace instead. -
Fix a regression in which certain infix type families, such as
(++),($),(+), and others, did not have the correct fixities. -
The default implementation of the
(==)type inPEqwas changed from(Data.Type.Equality.==)to a custom type family,DefaultEq. The reason for this change is that(Data.Type.Equality.==)is unable to conclude thata == areduces toTruefor anya. (As a result, the previous version ofsingletonsregressed in terms of type inference for thePEqinstances forNatandSymbol, which used that default.) On the other hand,DefaultEq a adoes reduce toTruefor alla. -
Add
Enum Nat,Show Nat, andShow Symbolinstances toData.Singletons.TypeLits. -
Template Haskell-generated code may require
DataKindsandPolyKindsin scenarios which did not previously require it:singletonsnow explicitly quantifies all kind variables used in explicitforalls.singletonsnow generatesa ~> binstead ofTyFun a b -> Typewhenever possible.
-
Since
th-desugarnow desugars all data types to GADT syntax, Template Haskell-generated code may requireGADTsin situations that didn’t require it before. -
Overhaul the way derived
Showinstances for singleton types works. Before, there was an awkwardShowSingclass (which was essentially a cargo-culted version ofShowspecialized forSing) that one had to create instances for separately. Now that GHC hasQuantifiedConstraints, we can scrap this whole class and turnShowSinginto a simple type synonym:type ShowSing k = forall z. Show (Sing (z :: k))Now, instead of generating a hand-written
ShowSingandShowinstance for each singleton type, we only generate a single (derived!)Showinstance. As a result of this change, you will likely need to enableQuantifiedConstraintsandStandaloneDerivingif you single any derivedShowinstances in your code. -
The kind of the type parameter to
SingIis no longer specified. This only affects you if you were using thesingmethod withTypeApplications. For instance, if you were usingsing @Bool @Truebefore, then you will now need to now usesing @Boolinstead. -
singletonsnow generatesSingIinstances for defunctionalization symbols through Template Haskell. As a result, you may need to enableFlexibleInstancesin more places. -
genDefunSymbolsis now more robust with respect to types that use dependent quantification, such as:type family MyProxy k (a :: k) :: Type where MyProxy k (a :: k) = Proxy aSee the documentation for
genDefunSymbolsfor limitations to this. -
Rename
Data.Singletons.TypeRepStartoData.Singletons.TypeRepTYPE, and generalize theSing :: Type -> Typeinstance toSing :: TYPE rep -> Type, allowing it to work over more open kinds. Also renameSomeTypeRepStartoSomeTypeRepTYPE, and change its definition accordingly. -
Promoting or singling a type synonym or type family declaration now produces defunctionalization symbols for it. (Previously, promoting or singling a type synonym did nothing whatsoever, and promoting or singling a type family produced an error.)
-
singletonsnow produces fixity declarations for defunctionalization symbols when appropriate. -
Add
(%<=?), a singled version of(<=?)fromGHC.TypeNats, as well as defunctionalization symbols for(<=?), toData.Singletons.TypeLits. -
Add
Data.Singletons.Prelude.{Semigroup,Monoid}, which define promoted and singled versions of theSemigroupandMonoidtype classes, as well as various newtype modifiers.Symbolis now has promotedSemigroupandMonoidinstances as well. As a consequence,Data.Singletons.TypeLitsno longer exports(<>)or(%<>), as they are superseded by the corresponding methods fromPSemigroupandSSemigroup. -
Add promoted and singled versions of the
Functor,Foldable,Traversable,Applicative,Alternative,Monad,MonadPlus, andMonadZipclasses. Among other things, this grants the ability to promote or singledo-notation and list comprehensions.Data.Singletons.Prelude.Listnow reexports more generalFoldable/Traversablefunctions wherever possible, just asData.Listdoes.
-
Add
Data.Singletons.Prelude.{Const,Identity}, which define promoted and singled version of theConstandIdentitydata types, respectively. -
Promote and single the
Downnewtype inData.Singletons.Prelude.Ord. -
To match the
baselibrary, the promoted/singled versions ofcomparingandthenCmpare no longer exported fromData.Singletons.Prelude. (They continue to live inData.Singletons.Prelude.Ord.) -
Permit singling of expression and pattern signatures.
-
Permit promotion and singling of
InstanceSigs. -
sErrorandsUndefinednow haveHasCallStackconstraints, like their counterpartserrorandundefined. The promoted and singled counterparts toerrorWithoutStackTracehave also been added in case you do not want this behavior. -
Add
Data.Singletons.TypeError, which provides a drop-in replacement forGHC.TypeLits.TypeErrorwhich can be used at both the value- and type-level.
2.4.1
- Restore the
TyCon1,TyCon2, etc. types. It turns out that the newTyCondoesn’t work with kind-polymorphic tycons.
2.4
-
Require GHC 8.4.
-
Demote Natis nowNatural(fromNumeric.Natural) instead ofInteger. In accordance with this change,Data.Singletons.TypeLitsnow exposesGHC.TypeNats.natVal(which returns aNatural) instead ofGHC.TypeLits.natVal(which returns anInteger). -
The naming conventions for infix identifiers (e.g.,
(&*)) have been overhauled.-
Infix functions (that are not constructors) are no longer prepended with a colon when promoted to type families. For instance, the promoted version of
(&*)is now called(&*)as well, instead of(:&*)as before.There is one exception to this rule: the
(.)function, which is promoted as(:.). The reason is that one cannot write(.)at the type level. -
Singletons for infix functions are now always prepended with
%instead of%:. -
Singletons for infix classes are now always prepended with
%instead of:%. -
Singletons for infix datatypes are now always prepended with a
%.(Before, there was an unspoken requirement that singling an infix datatype required that name to begin with a colon, and the singleton type would begin with
:%. But now that infix datatype names can be things like(+), this requirement became obsolete.)
The upshot is that most infix names can now be promoted using the same name, and singled by simply prepending the name with
%. -
-
The suffix for defunctionalized names of symbolic functions (e.g.,
(+)) has changed. Before, the promoted type name would be suffixed with some number of dollar signs (e.g.,(+$)and(+$$)) to indicate defunctionalization symbols. Now, the promoted type name is first suffixed with@#@and then followed by dollar signs (e.g.,(+@#@$)and(+@#@$$)). Adopting this conventional eliminates naming conflicts that could arise for functions that consisted of solely$symbols. -
The treatment of
undefinedis less magical. Before, all uses ofundefinedwould be promoted toGHC.Exts.Anyand singled toundefined. Now, there is a properUndefinedtype family andsUndefinedsingleton function. -
As a consequence of not promoting
undefinedtoAny, there is no need to have a specialany_function to distinguish the function on lists. The corresponding promoted type, singleton function, and defunctionalization symbols are now namedAny,sAny, andAnySym{0,1,2}. -
Rework the treatment of empty data types:
- Generated
SingKindinstances for empty data types now useEmptyCaseinstead of simplyerroring. - Derived
PEqinstances for empty data types now returnTrueinstead ofFalse. DerivedSEqinstances now returnTrueinstead oferroring. - Derived
SDecideinstances for empty data types now returnProved bottom, wherebottomis a divergent computation, instead oferroring.
- Generated
-
Add
Data.Singletons.Prelude.IsStringandData.Promotion.Prelude.IsStringmodules.IsString.fromStringis now used when promoting or singling string literals when the-XOverloadedStringsextension is enabled (similarly to howNum.fromIntegeris currently used when promoting or singling numeric literals). -
Add
Data.Singletons.Prelude.Void. -
Add promoted and singled versions of
div,mod,divMod,quot,rem, andquotRemtoData.Singletons.TypeLitsthat utilize the efficientDivandModtype families fromGHC.TypeNats. Also addsLog2and defunctionalization symbols forLog2fromGHC.TypeNats. -
Add
(<>)and(%<>), the promoted and singled versions ofAppendSymbolfromGHC.TypeLits. -
Add
(%^), the singleton version ofGHC.TypeLits.^. -
Add
unlinesandunwordstoData.Singletons.Prelude.List. -
Add promoted and singled versions of
Show, includingderivingsupport. -
Add a
ShowSingclass, which facilitates the ability to writeShowinstances forSinginstances. -
Permit derived
Ordinstances for empty datatypes. -
Permit standalone
derivingdeclarations. -
Permit
DeriveAnyClass(through theanyclasskeyword ofDerivingStrategies) -
Add a value-level
(@@), which is a synonym forapplySing. -
Add
Eq,Ord,Num,Enum, andBoundedinstances forSomeSing, which leverage theSEq,SOrd,SNum,SEnum, andSBoundedinstances, respectively, for the underlyingSing. -
Rework the
Sing (a :: *)instance inData.Singletons.TypeRepStarsuch that it now uses type-indexedTypeable. The newSinginstance is now:newtype instance Sing :: Type -> Type where STypeRep :: TypeRep a -> Sing aAccordingly, the
SingKindinstance has also been changed:instance SingKind Type where type Demote Type = SomeTypeRepStar ... data SomeTypeRepStar where SomeTypeRepStar :: forall (a :: *). !(TypeRep a) -> SomeTypeRepStarAside from cleaning up some implementation details, this change assures that
toSingcan only be called onTypeReps whose kind is of kind*. The previous implementation did not enforce this, which could lead to segfaults if used carelessly. -
Instead of
erroring, thetoSingimplementation in theSingKind (k1 ~> k2)instance now works as one would expect (provided the user adheres to some common-senseSingKindlaws, which are now documented). -
Add a
demotefunction, which is a convenient shorthand forfromSing sing. -
Add a
Data.Singletons.Sigmamodule with aSigma(dependent pair) data type. -
Export defunctionalization symbols for
Demote,SameKind,KindOf,(~>),Apply, and(@@)fromData.Singletons`. -
Add an explicitly bidirectional pattern synonym
Sing. Pattern matching onSingbrings aSingI tyconstraint into scope from a singletonSing ty. -
Add an explicitly bidirectional pattern synonym
FromSing. Pattern matching on any demoted (base) type gives us the corresponding singleton. -
Add explicitly bidirectional pattern synonyms
SLambda{2..8}. Pattern matching on any defunctionalized singleton yields a term-level Haskell function on singletons. -
Remove the family of
TyCon1,TyCon2, …, in favor of justTyCon. GHC 8.4’s type system is powerful enough to allow this nice simplification.
2.3
-
Documentation clarifiation in
Data.Singletons.TypeLits, thanks to @ivan-m. -
Demotewas no longer a convenient way of callingDemoteRepand has been removed.DemoteRephas been renamedDemote. -
DemoteRepis now injective. -
Demoting a
Symbolnow givesText. This is motivated by makingDemoteRepinjective. (IfSymboldemoted toString, then there would be a conflict between demoting[Char]andSymbol.) -
Generating singletons also now generates fixity declarations for the singletonized definitions, thanks to @int-index.
-
Though more an implementation detail: singletons no longer uses kind-level proxies anywhere, thanks again to @int-index.
-
Support for promoting higher-kinded type variables, thanks for @int-index.
-
Data.Singletons.TypeLitsnow exports defunctionalization symbols forKnownNatandKnownSymbol. -
Better type inference support around constraints, as tracked in Issue #176.
-
Type synonym definitions are now ignored, as they should be.
-
Showinstances forSNatandSSymbol, thanks to @cumber. -
The
singFunandunSingFunfunctions no longer use proxies, preferringTypeApplications.
2.2
-
With
TypeInType, we no longer kindKProxy. @int-index has very helpfully removed the use ofKProxyfromsingletons. -
Drop support for GHC 7.x.
-
Remove
bugInGHC. That function was intended to work around GHC’s difficulty in detecting exhaustiveness of GADT pattern matches. GHC 8 comes with a much better exhaustiveness checker, and so this function is no longer necessary.
2.1
-
Require
th-desugar>= 1.6 -
Work with GHC 8. GHC 8 gives the opportunity to simplify some pieces of singletons, but these opportunities are not yet fully realized. For example, injective type families means that we no longer need
Singto be a data family; it could be a type family. This might drastically simplify the way functions are singletonized. But not yet! -
singletonsnow outputs a few more type/kind annotations to help GHC do type inference. There may be a few more programs accepted than before. (This is the fix for #136.)
2.0.1
- Lots more functions in
Data.Singletons.Prelude.List:filter,find,elemIndex,elemIndices,findIndex,findIndices,intersect,intersectBy,takeWhile,dropWhile,dropWhileEnd,span,break,take,drop,splitAt,group,maximum,minimum,insert,sort,groupBy,lookup,partition,sum,product,length,replicate,transpose,(!!),nub,nubBy,unionBy,union,genericLength
2.0.0.2
- Fix fixity of
*.
2.0.0.1
- Make haddock work.
2.0
-
Instance promotion now works properly – it was quite buggy in 1.0.
-
Classes and instances can now be singletonized.
-
Limited support for functional dependencies.
-
We now have promoted and singletonized versions of
Enum, as well asBounded. -
Deriving
Enumis also now supported. -
Ditto for
Num, which includes an instance forNat, naturally. -
Promoting a literal number now uses overloaded literals at the type level, using a type-level
FromIntegerin the type-levelNumclass. -
Better support for dealing with constraints. Some previously-unsingletonizable functions that have constrained parameters now work.
-
No more orphan
Quasiinstances! -
Support for functions of arity 8 (instead of the old limit, 7).
-
Full support for fixity declarations.
-
A raft of bugfixes.
-
Drop support for GHC 7.8. You must have GHC 7.10.2.
1.1.2.1
Fix bug #116, thus allowing locally-declared symbols to be used in GHC 7.10.
1.1.2
- No more GHC 7.8.2 support – you must have GHC 7.8.3.
1.1.1
Update testsuite to work with th-desugar-1.5.2. No functional changes.
1.1
This is a maintenance release to support building (but not testing, due to
GHC bug #10058) with 7.10. This release also targets th-desugar-1.5. Some
types changed (using th-desugar’s new DsMonad instead of Quasi), but
clients generally won’t need to make any changes, unless they, too, generalize
over Quasi.
1.0
This is a complete rewrite of the package.
-
A much wider array of surface syntax is now accepted for promotion and singletonization, including
let,case, partially-applied functions, and anonymous functions,where, sections, among others. -
Classes and instances can be promoted (but not singletonized).
-
Derivation of promoted instances for
OrdandBounded.
This release can be seen as a “technology preview”. More features are coming soon.
This version drops GHC 7.6 support.
0.10.0
Template Haskell names are now more hygienic. In other words, singletons
won’t try to gobble up something happened to be named Sing in your project.
(Note that the Template Haskell names are not completely hygienic; names
generated during singleton generation can still cause conflicts.)
If a function to be promoted or singletonized is missing a type signature, that is now an error, not a warning.
Added a new external module Data.Singletons.TypeLits, which contain the singletons for GHC.TypeLits. Some convenience functions are also provided.
The extension EmptyCase is no longer needed. This caused pain when trying
to support both GHC 7.6.3 and 7.8.
0.9.3
Fix export list of Data.Singletons.TH, again again.
Add SEq instances for Nat and Symbol.
0.9.2
Fix export list of Data.Singletons.TH, again.
0.9.1
Fix export list of Data.Singletons.TH.
0.9.0
Make compatible with GHC HEAD, but HEAD reports core lint errors sometimes.
Change module structure significantly. If you want to derive your own
singletons, you should import Data.Singletons.TH. The module
Data.Singletons now exports functions only for the use of singletons.
New modules Data.Singletons.Bool, ...Maybe, ...Either, and ...List
are just like their equivalents from Data., except for List, which is
quite lacking in features.
For singleton equality, use Data.Singletons.Eq.
For propositional singleton equality, use Data.Singletons.Decide.
New module Data.Singletons.Prelude is meant to mirror the Haskell Prelude,
but with singleton definitions.
Streamline representation of singletons, resulting in exponential speedup at execution. (This has not been rigorously measured, but the data structures are now exponentially smaller.)
Add internal support for TypeLits, because the TypeLits module no longer exports singleton definitions.
Add support for existential singletons, through the toSing method of
SingKind.
Remove the SingE class, bundling its functionality into SingKind.
Thus, the SingRep synonym has also been removed.
Name change: KindIs becomes KProxy.
Add support for singletonizing calls to error.
Add support for singletonizing empty data definitions.
0.8.6
Make compatible with GHC HEAD, but HEAD reports core lint errors sometimes.
0.8.5
Bug fix to make singletons compatible with GHC 7.6.1.
Added git info to cabal file.
0.8.4
Update to work with latest version of GHC (7.7.20130114).
Now use branched type family instances to allow for promotion of functions with overlapping patterns.
Permit promotion of functions with constraints by omitting constraints.
0.8.3
Update to work with latest version of GHC (7.7.20121031).
Removed use of Any to simulate kind classes; now using KindOf and OfKind from GHC.TypeLits.
Made compatible with GHC.TypeLits.
0.8.2
Added this changelog
Update to work with latest version of GHC (7.6.1). (There was a change to Template Haskell).
Moved library into Data.Singletons.
0.8.1
Update to work with latest version of GHC. (There was a change to Template Haskell).
Updated dependencies in cabal to include the newer version of TH.
0.8
Initial public release