Copyright |
2009-2015 Edward Kmett
2012 Elliott Hird 2004 Oleg Kiselyov and Chung-chieh Shan |
---|---|
License | BSD3 |
Maintainer | Edward Kmett <ekmett@gmail.com> |
Stability | experimental |
Portability | non-portable |
Safe Haskell | Trustworthy |
Language | Haskell98 |
Reifies arbitrary terms at the type level. Based on the Functional Pearl: Implicit Configurations paper by Oleg Kiselyov and Chung-chieh Shan.
http://okmij.org/ftp/Haskell/tr-15-04.pdf
The approach from the paper was modified to work with Data.Proxy and to cheat by using knowledge of GHC's internal representations by Edward Kmett and Elliott Hird.
Usage comes down to two combinators,
reify
and
reflect
.
>>>
reify 6 (\p -> reflect p + reflect p)
12
The argument passed along by reify is just a
data
, so all of the information needed to reconstruct your value
has been moved to the type level. This enables it to be used when
constructing instances (see
Proxy
t =
Proxy
examples/Monoid.hs
).
In addition, a simpler API is offered for working with singleton values such as a system configuration, etc.
Synopsis
-
class
Reifies
s a | s -> a
where
- reflect :: proxy s -> a
- reify :: forall a r. a -> ( forall (s :: *). Reifies s a => Proxy s -> r) -> r
- reifyNat :: forall r. Integer -> ( forall (n :: Nat ). KnownNat n => Proxy n -> r) -> r
- reifySymbol :: forall r. String -> ( forall (n :: Symbol ). KnownSymbol n => Proxy n -> r) -> r
- reifyTypeable :: Typeable a => a -> ( forall (s :: *). ( Typeable s, Reifies s a) => Proxy s -> r) -> r
-
class
Given
a
where
- given :: a
- give :: forall a r. a -> ( Given a => r) -> r
- int :: Int -> TypeQ
- nat :: Int -> TypeQ
- data Z
- data D (n :: *)
- data SD (n :: *)
- data PD (n :: *)
-
data
ReifiedMonoid
a =
ReifiedMonoid
{
- reifiedMappend :: a -> a -> a
- reifiedMempty :: a
- newtype ReflectedMonoid a s = ReflectedMonoid a
- reifyMonoid :: (a -> a -> a) -> a -> ( forall (s :: *). Reifies s ( ReifiedMonoid a) => t -> ReflectedMonoid a s) -> t -> a
- foldMapBy :: Foldable t => (r -> r -> r) -> r -> (a -> r) -> t a -> r
- foldBy :: Foldable t => (a -> a -> a) -> a -> t a -> a
-
data
ReifiedApplicative
f =
ReifiedApplicative
{
- reifiedPure :: forall a. a -> f a
- reifiedAp :: forall a b. f (a -> b) -> f a -> f b
- newtype ReflectedApplicative f s a = ReflectedApplicative (f a)
- reifyApplicative :: ( forall x. x -> f x) -> ( forall x y. f (x -> y) -> f x -> f y) -> ( forall (s :: *). Reifies s ( ReifiedApplicative f) => t -> ReflectedApplicative f s a) -> t -> f a
- traverseBy :: Traversable t => ( forall x. x -> f x) -> ( forall x y. f (x -> y) -> f x -> f y) -> (a -> f b) -> t a -> f (t b)
- sequenceBy :: Traversable t => ( forall x. x -> f x) -> ( forall x y. f (x -> y) -> f x -> f y) -> t (f a) -> f (t a)
Reflection
class Reifies s a | s -> a where Source #
reflect :: proxy s -> a Source #
Recover a value inside a
reify
context, given a proxy for its
reified type.
Instances
KnownNat n => Reifies (n :: Nat ) Integer Source # | |
Defined in Data.Reflection |
|
KnownSymbol n => Reifies (n :: Symbol ) String Source # | |
Defined in Data.Reflection |
|
Reifies Z Int Source # | |
Reifies n Int => Reifies ( PD n :: Type ) Int Source # | |
Reifies n Int => Reifies ( SD n :: Type ) Int Source # | |
Reifies n Int => Reifies ( D n :: Type ) Int Source # | |
reify :: forall a r. a -> ( forall (s :: *). Reifies s a => Proxy s -> r) -> r Source #
Reify a value at the type level, to be recovered with
reflect
.
reifySymbol :: forall r. String -> ( forall (n :: Symbol ). KnownSymbol n => Proxy n -> r) -> r Source #
This upgraded version of
reify
can be used to generate a
KnownSymbol
suitable for use with other APIs.
Available only on GHC 7.8+
>>>
reifySymbol "hello" symbolVal
"hello"
>>>
reifySymbol "hello" reflect
"hello"
reifyTypeable :: Typeable a => a -> ( forall (s :: *). ( Typeable s, Reifies s a) => Proxy s -> r) -> r Source #
Given
Template Haskell reflection
This can be used to generate a template haskell splice for a type level version of a given
int
.
This does not use GHC TypeLits, instead it generates a numeric type by hand similar to the ones used in the "Functional Pearl: Implicit Configurations" paper by Oleg Kiselyov and Chung-Chieh Shan.
instance Num (Q Exp)
provided in this package allows writing
$(3)
instead of
$(int 3)
. Sometimes the two will produce the same
representation (if compiled without the
-DUSE_TYPE_LITS
preprocessor
directive).
This is a restricted version of
int
that can only generate natural numbers. Attempting to generate
a negative number results in a compile time error. Also the resulting sequence will consist entirely of
Z, D, and SD constructors representing the number in zeroless binary.
Useful compile time naturals
0
2 n
2 n + 1
2 n - 1
Reified Monoids
data ReifiedMonoid a Source #
ReifiedMonoid | |
|
newtype ReflectedMonoid a s Source #
Instances
Reifies s ( ReifiedMonoid a) => Semigroup ( ReflectedMonoid a s) Source # | |
Defined in Data.Reflection (<>) :: ReflectedMonoid a s -> ReflectedMonoid a s -> ReflectedMonoid a s Source # sconcat :: NonEmpty ( ReflectedMonoid a s) -> ReflectedMonoid a s Source # stimes :: Integral b => b -> ReflectedMonoid a s -> ReflectedMonoid a s Source # |
|
Reifies s ( ReifiedMonoid a) => Monoid ( ReflectedMonoid a s) Source # | |
Defined in Data.Reflection mempty :: ReflectedMonoid a s Source # mappend :: ReflectedMonoid a s -> ReflectedMonoid a s -> ReflectedMonoid a s Source # mconcat :: [ ReflectedMonoid a s] -> ReflectedMonoid a s Source # |
reifyMonoid :: (a -> a -> a) -> a -> ( forall (s :: *). Reifies s ( ReifiedMonoid a) => t -> ReflectedMonoid a s) -> t -> a Source #
Reified Applicatives
data ReifiedApplicative f Source #
ReifiedApplicative | |
|
newtype ReflectedApplicative f s a Source #
ReflectedApplicative (f a) |
Instances
Reifies s ( ReifiedApplicative f) => Functor ( ReflectedApplicative f s) Source # | |
Defined in Data.Reflection fmap :: (a -> b) -> ReflectedApplicative f s a -> ReflectedApplicative f s b Source # (<$) :: a -> ReflectedApplicative f s b -> ReflectedApplicative f s a Source # |
|
Reifies s ( ReifiedApplicative f) => Applicative ( ReflectedApplicative f s) Source # | |
Defined in Data.Reflection pure :: a -> ReflectedApplicative f s a Source # (<*>) :: ReflectedApplicative f s (a -> b) -> ReflectedApplicative f s a -> ReflectedApplicative f s b Source # liftA2 :: (a -> b -> c) -> ReflectedApplicative f s a -> ReflectedApplicative f s b -> ReflectedApplicative f s c Source # (*>) :: ReflectedApplicative f s a -> ReflectedApplicative f s b -> ReflectedApplicative f s b Source # (<*) :: ReflectedApplicative f s a -> ReflectedApplicative f s b -> ReflectedApplicative f s a Source # |
reifyApplicative :: ( forall x. x -> f x) -> ( forall x y. f (x -> y) -> f x -> f y) -> ( forall (s :: *). Reifies s ( ReifiedApplicative f) => t -> ReflectedApplicative f s a) -> t -> f a Source #
traverseBy :: Traversable t => ( forall x. x -> f x) -> ( forall x y. f (x -> y) -> f x -> f y) -> (a -> f b) -> t a -> f (t b) Source #
Traverse a container using its
Traversable
instance using
explicitly provided
Applicative
operations. This is like
traverse
where the
Applicative
instance can be manually specified.
sequenceBy :: Traversable t => ( forall x. x -> f x) -> ( forall x y. f (x -> y) -> f x -> f y) -> t (f a) -> f (t a) Source #
Sequence a container using its
Traversable
instance using
explicitly provided
Applicative
operations. This is like
sequence
where the
Applicative
instance can be manually specified.