type-map-0.1.0.0: Type-indexed maps

Safe HaskellNone
LanguageHaskell2010

Data.TypeMap.Internal.Unsafe

Synopsis

Documentation

type family Index (a :: k) (d :: [(k, *)]) where ... Source #

Index of type key a in association list d.

Equations

Index a ('(a, _) ': _) = 0 
Index a (_ ': d) = 1 + Index a d 

type family Lookup (a :: k) (d :: [(k, *)]) where ... Source #

Type associated with a in d. If the key a occurs multiple times, the first one is used.

Equations

Lookup a ('(a, b) ': _) = b 
Lookup a (_ ': d) = Lookup a d 

type family Snoc (d :: [k]) (a :: k) where ... Source #

Append a type to a list.

Equations

Snoc '[] a = '[a] 
Snoc (x ': d) a = x ': Snoc d a 

type family Last (d :: [k]) where ... Source #

Last element of a list.

Equations

Last (x ': '[]) = x 
Last (_ ': d) = Last d 

type family Init (d :: [k]) where ... Source #

All elements except the last one.

Equations

Init (_ ': '[]) = '[] 
Init (x ': d) = x ': Init d 

unsafeIndex :: forall a d f m. (KnownNat (Index a d), Coercible (f Any) (m d)) => (forall c. f c -> Int -> c) -> m d -> Lookup a d Source #

Helper to define index functions.

unsafeCons :: forall a d b f m. (Coercible (f Any) (m d), Coercible (f Any) (m ('(a, b) ': d))) => (forall c. c -> f c -> f c) -> b -> m d -> m ('(a, b) ': d) Source #

Helper to define cons functions.

unsafeSnoc :: forall a d b f m. (Last d ~ '(a, b), Coercible (f Any) (m (Init d)), Coercible (f Any) (m d)) => (forall c. f c -> c -> f c) -> m (Init d) -> b -> m d Source #

Helper to define snoc functions.