Safe Haskell | None |
---|---|
Language | Haskell2010 |
A version of TMap
parametrized by an interpretation f
. This
sort of parametrization may be familiar to users of vinyl
records.
is a more efficient replacement for TypeRepMap
fDMap
(where TypeRep
fDMap
is from the dependent-map
package).
Here is an example of using Maybe
as an interpretation, with a
comparison to TMap
:
TMap
TypeRepMap
Maybe
-------------- ------------------- Int -> 5 Int -> Just 5 Bool -> True Bool -> Nothing Char -> 'x' Char -> Just 'x'
In fact, a TMap
is defined as TypeRepMap
Identity
.
Since TypeRep
is poly-kinded, the interpretation can use
any kind for the keys. For instance, we can use the Symbol
kind to use TypeRepMap
as an extensible record:
newtype Field name = F (FType name)
type family FType (name :: Symbol) :: Type
type instance FType "radius" = Double
type instance FType "border-color" = RGB
type instance FType "border-width" = Double
TypeRepMap
Field
--------------------------------------
"radius" -> F 5.7
"border-color" -> F (rgb 148 0 211)
"border-width" -> F 0.5
Synopsis
- data TypeRepMap (f :: k -> Type)
- empty :: TypeRepMap f
- one :: forall a f. Typeable a => f a -> TypeRepMap f
- insert :: forall a f. Typeable a => f a -> TypeRepMap f -> TypeRepMap f
- delete :: forall a (f :: KindOf a -> Type). Typeable a => TypeRepMap f -> TypeRepMap f
- adjust :: forall a f. Typeable a => (f a -> f a) -> TypeRepMap f -> TypeRepMap f
- hoist :: (forall x. f x -> g x) -> TypeRepMap f -> TypeRepMap g
- hoistA :: Applicative t => (forall x. f x -> t (g x)) -> TypeRepMap f -> t (TypeRepMap g)
- hoistWithKey :: forall f g. (forall x. Typeable x => f x -> g x) -> TypeRepMap f -> TypeRepMap g
- unionWith :: (forall x. f x -> f x -> f x) -> TypeRepMap f -> TypeRepMap f -> TypeRepMap f
- union :: TypeRepMap f -> TypeRepMap f -> TypeRepMap f
- lookup :: forall a f. Typeable a => TypeRepMap f -> Maybe (f a)
- member :: forall a (f :: KindOf a -> Type). Typeable a => TypeRepMap f -> Bool
- size :: TypeRepMap f -> Int
- keys :: TypeRepMap f -> [SomeTypeRep]
- data WrapTypeable f where
- WrapTypeable :: Typeable a => f a -> WrapTypeable f
Map type
data TypeRepMap (f :: k -> Type) Source #
TypeRepMap
is a heterogeneous data structure similar in its essence to
Map
with types as keys, where each value has the type of its key. In
addition to that, each value is wrapped in an interpretation f
.
Here is an example of using Maybe
as an interpretation, with a
comparison to Map
:
Map
String
(Maybe
String
)TypeRepMap
Maybe
--------------------------- --------------------- "Int" -> Just "5"Int
-> Just 5 "Bool" -> Just "True"Bool
-> JustTrue
"Char" -> NothingChar
-> Nothing
The runtime representation of TypeRepMap
is an array, not a tree. This makes
lookup
significantly more efficient.
Instances
Construction
empty :: TypeRepMap f Source #
one :: forall a f. Typeable a => f a -> TypeRepMap f Source #
Modification
insert :: forall a f. Typeable a => f a -> TypeRepMap f -> TypeRepMap f Source #
Insert a value into a TypeRepMap
.
size (insert v tm) >= size tm
member @a (insert (x :: f a) tm) == True
delete :: forall a (f :: KindOf a -> Type). Typeable a => TypeRepMap f -> TypeRepMap f Source #
Delete a value from a TypeRepMap
.
size (delete @a tm) <= size tm
member @a (delete @a tm) == False
>>>
tm = delete @Bool $ insert (Just True) $ one (Just 'a')
>>>
size tm
1>>>
member @Bool tm
False>>>
member @Char tm
True
adjust :: forall a f. Typeable a => (f a -> f a) -> TypeRepMap f -> TypeRepMap f Source #
Update a value at a specific key with the result of the provided function. When the key is not a member of the map, the original map is returned.
>>>
trmap = fromList @(TypeRepMap Identity) [WrapTypeable $ Identity "a"]
>>>
lookup @String $ adjust (fmap (++ "ww")) trmap
Just (Identity "aww")
hoist :: (forall x. f x -> g x) -> TypeRepMap f -> TypeRepMap g Source #
Map over the elements of a TypeRepMap
.
>>>
tm = insert (Identity True) $ one (Identity 'a')
>>>
lookup @Bool tm
Just (Identity True)>>>
lookup @Char tm
Just (Identity 'a')>>>
tm2 = hoist ((:[]) . runIdentity) tm
>>>
lookup @Bool tm2
Just [True]>>>
lookup @Char tm2
Just "a"
hoistA :: Applicative t => (forall x. f x -> t (g x)) -> TypeRepMap f -> t (TypeRepMap g) Source #
hoistWithKey :: forall f g. (forall x. Typeable x => f x -> g x) -> TypeRepMap f -> TypeRepMap g Source #
unionWith :: (forall x. f x -> f x -> f x) -> TypeRepMap f -> TypeRepMap f -> TypeRepMap f Source #
The union of two TypeRepMap
s using a combining function.
union :: TypeRepMap f -> TypeRepMap f -> TypeRepMap f Source #
The (left-biased) union of two TypeRepMap
s. It prefers the first map when
duplicate keys are encountered, i.e.
.union
== unionWith
const
Query
lookup :: forall a f. Typeable a => TypeRepMap f -> Maybe (f a) Source #
Lookup a value of the given type in a TypeRepMap
.
>>>
x = lookup $ insert (Identity (11 :: Int)) empty
>>>
x :: Maybe (Identity Int)
Just (Identity 11)>>>
x :: Maybe (Identity ())
Nothing
member :: forall a (f :: KindOf a -> Type). Typeable a => TypeRepMap f -> Bool Source #
Check if a value of the given type is present in a TypeRepMap
.
>>>
member @Char $ one (Identity 'a')
True>>>
member @Bool $ one (Identity 'a')
False
size :: TypeRepMap f -> Int Source #
Get the amount of elements in a TypeRepMap
.
keys :: TypeRepMap f -> [SomeTypeRep] Source #
Return the list of SomeTypeRep
from the keys.
IsList
data WrapTypeable f where Source #
Existential wrapper around Typeable
indexed by f
type parameter.
Useful for TypeRepMap
structure creation form list of WrapTypeable
s.
WrapTypeable :: Typeable a => f a -> WrapTypeable f |
Instances
Show (WrapTypeable f) Source # | |
Defined in Data.TypeRepMap.Internal showsPrec :: Int -> WrapTypeable f -> ShowS # show :: WrapTypeable f -> String # showList :: [WrapTypeable f] -> ShowS # |