Safe Haskell | None |
---|---|
Language | Haskell98 |
Everything you need to construct an enumeration for an algebraic type. Just define each constructor using pure for nullary constructors and unary and funcurry for positive arity constructors, then combine the constructors with consts. Example:
instance Enumerable a => Enumerable [a] where enumerate = consts [unary (funcurry (:)), pure []]
There's also a handy Template Haskell function for automatic derivation.
- class Typeable a => Enumerable a where
- type Constructor = Enumerate
- nullary :: a -> Constructor a
- unary :: Enumerable a => (a -> b) -> Constructor b
- funcurry :: (a -> b -> c) -> FreePair a b -> c
- consts :: [Constructor a] -> Enumerate a
- shared :: Enumerable a => Enumerate a
- optimal :: Enumerable a => Enumerate a
- newtype FreePair a b = Free {
- free :: (a, b)
- deriveEnumerable :: Name -> Q [Dec]
- deriveEnumerable' :: ConstructorDeriv -> Q [Dec]
- type ConstructorDeriv = (Name, [(Name, ExpQ)])
- dAll :: Name -> ConstructorDeriv
- dExcluding :: Name -> ConstructorDeriv -> ConstructorDeriv
- dExcept :: Name -> ExpQ -> ConstructorDeriv -> ConstructorDeriv
Documentation
class Typeable a => Enumerable a where Source
A class of functionally enumerable types
Building instances
type Constructor = Enumerate Source
nullary :: a -> Constructor a Source
For nullary constructors such as True
and []
.
unary :: Enumerable a => (a -> b) -> Constructor b Source
For any non-nullary constructor. Apply funcurry
until the type of
the result is unary (i.e. n-1 times where n is the number of fields
of the constructor).
funcurry :: (a -> b -> c) -> FreePair a b -> c Source
Uncurry a function (typically a constructor) to a function on free pairs.
consts :: [Constructor a] -> Enumerate a Source
Produces the enumeration of a type given the enumerators for each of its
constructors. The result of unary
should typically not be used
directly in an instance even if it only has one constructor. So you
should apply consts even in that case.
Accessing the enumerator of an instance
shared :: Enumerable a => Enumerate a Source
Version of enumerate
that ensures that the enumeration is shared
between all accesses. Should always be used when
combining enumerations.
optimal :: Enumerable a => Enumerate a Source
An optimal version of enumerate. Used by all
library functions that access enumerated values (but not
by combining functions). Library functions should ensure that
optimal
is not reevaluated.
Free pairs
A free pair constructor. The cost of constructing a free pair is equal to the sum of the costs of its components.
(Show a, Show b) => Show (FreePair a b) Source | |
(Enumerable a, Enumerable b) => Enumerable (FreePair a b) Source |
Deriving instances with template Haskell
deriveEnumerable :: Name -> Q [Dec] Source
Derive an instance of Enumberable with Template Haskell. To derive
an instance for Enumerable A
, just put this as a top level declaration
in your module (with the TemplateHaskell extension enabled):
deriveEnumerable ''A
deriveEnumerable' :: ConstructorDeriv -> Q [Dec] Source
Derive an instance of Enumberable with Template Haskell, with rules for some specific constructors
type ConstructorDeriv = (Name, [(Name, ExpQ)]) Source
dAll :: Name -> ConstructorDeriv Source
dExcluding :: Name -> ConstructorDeriv -> ConstructorDeriv Source
dExcept :: Name -> ExpQ -> ConstructorDeriv -> ConstructorDeriv Source