Copyright | (c) Taku Terao 2017 |
---|---|
License | BSD3 |
Maintainer | autotaker@gmail.com |
Stability | experimental |
Portability | GHC |
Safe Haskell | None |
Language | Haskell2010 |
Type-safe, polymorphic dictionary.
- type family DictValue v :: Constraint where ...
- type family Assoc n (k :: Symbol)
- data Dict n
- data Key (k :: Symbol)
- lookup :: (KnownSymbol k, DictValue v, Assoc n k ~ v) => Key k -> Dict n -> Maybe v
- insert :: (KnownSymbol k, DictValue v, Assoc n k ~ v) => Key k -> v -> Dict n -> Dict n
- access :: forall n k v. (KnownSymbol k, DictValue v, Assoc n k ~ v) => Key k -> Lens' (Dict n) (Maybe v)
- access' :: forall n k v. (KnownSymbol k, DictValue v, Assoc n k ~ v) => Key k -> v -> Lens' (Dict n) v
- empty :: Dict n
Documentation
type family DictValue v :: Constraint where ... Source #
type family Assoc n (k :: Symbol) Source #
Assoc
n k defines the type of value associated with key k.
Parameter n defines the namespace for dictionary fields. For example:
data Log type instance Assoc Log "argments" = [String] type instance Assoc Log "count" = Int
Then Dict
Log is a dictionary type with (at least) two fields "arguments" and "count".
One can access the fields by using insert
and lookup
.
>>>
insert #count 0 (empty :: Dict Log)
{"count": 0}>>>
lookup #count (insert #count 0 (empty :: Dict Log))
Just 0
Or by using lenses:
>>>
import Lens.Micro
>>>
(empty :: Dict Log) & (access #count ?~ 1) . (access #arguments ?~ ["a","b","c"])
{"arguments": ["a","b","c"], "count": 1}
A polymorphic, type-safe dictinary type where the parameter n
represents the namespace of dictionary fields.
data Key (k :: Symbol) Source #
The type of keys. With the OverloadedLabels extenstion, #foo is the key for field "foo"
lookup :: (KnownSymbol k, DictValue v, Assoc n k ~ v) => Key k -> Dict n -> Maybe v Source #
Return the value associated with the key.
insert :: (KnownSymbol k, DictValue v, Assoc n k ~ v) => Key k -> v -> Dict n -> Dict n Source #
Insert the value at the specified key of the dictionary
access :: forall n k v. (KnownSymbol k, DictValue v, Assoc n k ~ v) => Key k -> Lens' (Dict n) (Maybe v) Source #
Give the lens accessing to the value associated with the key.