| Copyright | (c) 2017-2022 Kowainik |
|---|---|
| License | MPL-2.0 |
| Maintainer | Kowainik <xrom.xkov@gmail.com> |
| Stability | Stable |
| Portability | Portable |
| Safe Haskell | None |
| Language | Haskell2010 |
Data.TypeRepMap
Description
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:
TMapTypeRepMapMaybe-------------- ------------------- 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
- alter :: forall a f. Typeable a => (Maybe (f a) -> Maybe (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 f. (forall x. Typeable x => f x -> f x -> f x) -> TypeRepMap f -> TypeRepMap f -> TypeRepMap f
- union :: TypeRepMap f -> TypeRepMap f -> TypeRepMap f
- intersectionWith :: forall f. (forall x. Typeable x => f x -> f x -> f x) -> TypeRepMap f -> TypeRepMap f -> TypeRepMap f
- intersection :: 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]
- keysWith :: (forall (a :: ArgKindOf f). TypeRep a -> r) -> TypeRepMap f -> [r]
- toListWith :: forall f r. (forall (a :: ArgKindOf f). Typeable a => f a -> r) -> TypeRepMap f -> [r]
- 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:
MapString(MaybeString)TypeRepMapMaybe--------------------------- --------------------- "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.
TypeRepMap optimizes for fast reads rather than inserts, as a trade-off inserts are O(n).
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.
TypeRepMap optimizes for fast reads rather than modifications, as a trade-off deletes are
O(n), with an O(log(n)) optimization for when the element is already missing.
size (delete @a tm) <= size tm
member @a (delete @a tm) == False
>>>tm = delete @Bool $ insert (Just True) $ one (Just 'a')>>>size tm1>>>member @Bool tmFalse>>>member @Char tmTrue
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")) trmapJust (Identity "aww")
alter :: forall a f. Typeable a => (Maybe (f a) -> Maybe (f a)) -> TypeRepMap f -> TypeRepMap f Source #
Updates a value at a specific key, whether or not it exists. This can be used to insert, delete, or update a value of a given type in the map.
>>>func = (\case Nothing -> Just (Identity "new"); Just (Identity s) -> Just (Identity (reverse s)))>>>lookup @String $ alter func emptyJust (Identity "new")>>>trmap = fromList @(TypeRepMap Identity) [WrapTypeable $ Identity "helllo"]>>>lookup @String $ alter func trmap>>>Just (Identity "olleh")
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 tmJust (Identity True)>>>lookup @Char tmJust (Identity 'a')>>>tm2 = hoist ((:[]) . runIdentity) tm>>>lookup @Bool tm2Just [True]>>>lookup @Char tm2Just "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 f. (forall x. Typeable x => f x -> f x -> f x) -> TypeRepMap f -> TypeRepMap f -> TypeRepMap f Source #
The union of two TypeRepMaps using a combining function for conflicting entries. O(n + m)
union :: TypeRepMap f -> TypeRepMap f -> TypeRepMap f Source #
The (left-biased) union of two TypeRepMaps in O(n + m). It prefers the first map when
duplicate keys are encountered, i.e. .union == unionWith const
intersectionWith :: forall f. (forall x. Typeable x => f x -> f x -> f x) -> TypeRepMap f -> TypeRepMap f -> TypeRepMap f Source #
The intersection of two TypeRepMaps using a combining function
O(n + m)
intersection :: TypeRepMap f -> TypeRepMap f -> TypeRepMap f Source #
The intersection of two TypeRepMaps.
It keeps all values from the first map whose keys are present in the second.
O(n + m)
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.
keysWith :: (forall (a :: ArgKindOf f). TypeRep a -> r) -> TypeRepMap f -> [r] Source #
Return the list of keys by wrapping them with a user-provided function.
toListWith :: forall f r. (forall (a :: ArgKindOf f). Typeable a => f a -> r) -> TypeRepMap f -> [r] Source #
Return the list of key-value pairs by wrapping them with a user-provided function.
IsList
data WrapTypeable f where Source #
Existential wrapper around Typeable indexed by f type parameter.
Useful for TypeRepMap structure creation form list of WrapTypeables.
Constructors
| WrapTypeable :: Typeable a => f a -> WrapTypeable f |
Instances
| Show (WrapTypeable f) Source # | |
Defined in Data.TypeRepMap.Internal Methods showsPrec :: Int -> WrapTypeable f -> ShowS # show :: WrapTypeable f -> String # showList :: [WrapTypeable f] -> ShowS # | |