bookkeeper-0.1.1.0

Safe HaskellNone
LanguageHaskell2010

Bookkeeper.Internal

Contents

Synopsis

Documentation

type Book a = Book' (AsMap a) Source #

newtype Book' a Source #

The internal representation of a Book.

Constructors

Book 

Fields

emptyBook :: Book '[] Source #

A book with no records. You'll usually want to use this to construct books.

type (:=>) a b = a :-> b Source #

An alias for :-> because otherwise you'll have to tick your constructors.

data Key a Source #

Key is simply a proxy. You will usually not need to generate it directly, as it is generated by the OverlodadedLabels magic.

Constructors

Key 

Instances

(~) Symbol s s' => IsLabel s (Key s') Source # 

Methods

fromLabel :: Proxy# Symbol s -> Key s' #

Eq (Key a) Source # 

Methods

(==) :: Key a -> Key a -> Bool #

(/=) :: Key a -> Key a -> Bool #

Read (Key a) Source # 
Show (Key a) Source # 

Methods

showsPrec :: Int -> Key a -> ShowS #

show :: Key a -> String #

showList :: [Key a] -> ShowS #

Generic (Key a) Source # 

Associated Types

type Rep (Key a) :: * -> * #

Methods

from :: Key a -> Rep (Key a) x #

to :: Rep (Key a) x -> Key a #

type Rep (Key a) Source # 
type Rep (Key a) = D1 (MetaData "Key" "Bookkeeper.Internal" "bookkeeper-0.1.1.0-ICAKLsZPqBcAB7K0G53i1T" False) (C1 (MetaCons "Key" PrefixI False) U1)

get :: forall field book val. (Submap '[field :=> val] book, Contains book field val) => Key field -> Book' book -> val Source #

Get a value by key, if it exists.

>>> get #age julian
28

If the key does not exist, throws a type error >>> get #moneyFrom julian ... ... • The provided Book does not contain the field "moneyFrom" ... Book type: ... '["age" ':-> Int, "name" ':-> String] ... • In the expression: get #moneyFrom julian ...

(?:) :: forall field book val. (Submap '[field :=> val] book, Contains book field val) => Book' book -> Key field -> val infixl 3 Source #

Flipped and infix version of get.

>>> julian ?: #name
"Julian K. Arni"

set :: forall field val old mid1 mid2 new. (Unionable '[field :=> ChooseFirst val] mid1, Mappable ChooseFirst old mid1, Mappable ChooseFirst new mid2, mid1 ~ MapThere ChooseFirst old, mid2 ~ Union '[field :=> ChooseFirst val] mid1, new ~ MapBack ChooseFirst mid2) => Key field -> val -> Book' old -> Book' new Source #

Sets or updates a field to a value.

>>> let julian' = set #likesDoctest True julian
>>> get #likesDoctest julian'
True

(=:) :: forall field val old mid1 mid2 new. (Unionable '[field :=> ChooseFirst val] mid1, Mappable ChooseFirst old mid1, Mappable ChooseFirst new mid2, mid1 ~ MapThere ChooseFirst old, mid2 ~ Union '[field :=> ChooseFirst val] mid1, new ~ MapBack ChooseFirst mid2) => Key field -> val -> Book' old -> Book' new infix 3 Source #

Infix version of set

>>> let julian' = julian & #age =: 29
>>> get #age julian'
29

modify :: forall field val val' old mid1 mid2 new. (Unionable '[field :=> ChooseFirst val'] mid1, Mappable ChooseFirst old mid1, Mappable ChooseFirst new mid2, (Submap '[field :=> val] old, Contains old field val), mid1 ~ MapThere ChooseFirst old, mid2 ~ Union '[field :=> ChooseFirst val'] mid1, new ~ MapBack ChooseFirst mid2, AsMap new ~ new) => Key field -> (val -> val') -> Book' old -> Book new Source #

Apply a function to a field.

>>> let julian' = julian & modify #name (fmap toUpper)
>>> get #name julian'
"JULIAN K. ARNI"

If the key does not exist, throws a type error >>> modify #height (_ -> 132) julian ... ... • The provided Book does not contain the field "height" ... Book type: ... '["age" ':-> Int, "name" ':-> String] ... • In the expression: modify #height ( _ -> 132) julian ...

(%:) :: forall field val val' old mid1 mid2 new. (Unionable '[field :=> ChooseFirst val'] mid1, Mappable ChooseFirst old mid1, Mappable ChooseFirst new mid2, (Submap '[field :=> val] old, Contains old field val), mid1 ~ MapThere ChooseFirst old, mid2 ~ Union '[field :=> ChooseFirst val'] mid1, new ~ MapBack ChooseFirst mid2, AsMap new ~ new) => Key field -> (val -> val') -> Book' old -> Book new infixr 3 Source #

Infix version of modify.

>>> let julian' = julian & #name %: fmap toUpper
>>> get #name julian'
"JULIAN K. ARNI"

delete :: forall field old. Submap (AsMap (old :\ field)) old => Key field -> Book' old -> Book (old :\ field) Source #

Delete a field from a Book, if it exists. If it does not, returns the Book unmodified.

>>> get #name $ delete #name julian
...
...  • The provided Book does not contain the field "name"
...    Book type:
...    '["age" ':-> Int]
...  • In the expression: get #name
...

Mapping

type family MapThere (f :: Type -> Type) (map :: [Mapping Symbol Type]) where ... Source #

In order to be able to establish how maps are to combined, we need to a little song and dance.

Equations

MapThere f '[] = '[] 
MapThere f ((k :=> a) ': as) = (k :=> f a) ': MapThere f as 

type family MapBack f (map :: [Mapping Symbol Type]) where ... Source #

Equations

MapBack f '[] = '[] 
MapBack f ((k :=> f a) ': as) = (k :=> a) ': MapBack f as 

class (MapThere f a ~ b, MapBack f b ~ a) => Mappable f a b | f a -> b, f b -> a where Source #

Minimal complete definition

mapThere, mapBack

Methods

mapThere :: proxy f -> Map a -> Map b Source #

mapBack :: proxy f -> Map b -> Map a Source #

Instances

Mappable f ([] (Mapping Symbol Type)) ([] (Mapping Symbol Type)) Source # 
(Coercible Type a (f a), Coercible Type (f a) a, Mappable f as fas) => Mappable f ((:) (Mapping Symbol Type) ((:=>) Symbol Type k a) as) ((:) (Mapping Symbol Type) ((:=>) Symbol Type k (f a)) fas) Source # 

Methods

mapThere :: proxy f -> Map ((Mapping Symbol Type ': (Symbol :=> Type) k a) as) -> Map ((Mapping Symbol Type ': (Symbol :=> Type) k (f a)) fas) Source #

mapBack :: proxy f -> Map ((Mapping Symbol Type ': (Symbol :=> Type) k (f a)) fas) -> Map ((Mapping Symbol Type ': (Symbol :=> Type) k a) as) Source #

class MapMap f map where Source #

Minimal complete definition

mapMap

Associated Types

type MapMapT f map :: [Mapping Symbol Type] Source #

Methods

mapMap :: f -> Map map -> Map (MapMapT f map) Source #

Instances

MapMap f ([] (Mapping Symbol *)) Source # 

Associated Types

type MapMapT f ([] (Mapping Symbol *) :: [Mapping Symbol *]) :: [Mapping Symbol Type] Source #

Methods

mapMap :: f -> Map [Mapping Symbol *] -> Map (MapMapT f [Mapping Symbol *]) Source #

newtype ChooseFirst a Source #

Warning: This should not be used

Constructors

ChooseFirst

Warning: This should not be used

Fields

Instances

Eq a => Eq (ChooseFirst a) Source # 
Read a => Read (ChooseFirst a) Source # 
Show a => Show (ChooseFirst a) Source # 
Generic (ChooseFirst a) Source # 

Associated Types

type Rep (ChooseFirst a) :: * -> * #

Methods

from :: ChooseFirst a -> Rep (ChooseFirst a) x #

to :: Rep (ChooseFirst a) x -> ChooseFirst a #

Combinable (ChooseFirst a) (ChooseFirst b) Source # 
type Rep (ChooseFirst a) Source # 
type Rep (ChooseFirst a) = D1 (MetaData "ChooseFirst" "Bookkeeper.Internal" "bookkeeper-0.1.1.0-ICAKLsZPqBcAB7K0G53i1T" True) (C1 (MetaCons "ChooseFirst" PrefixI True) (S1 (MetaSel (Just Symbol "getChooseFirst") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a)))
type Combine * (ChooseFirst a) (ChooseFirst b) Source # 
>>> import Data.Function ((&))
>>> import Data.Char (toUpper)
>>> type Person = Book '[ "name" :=> String , "age" :=> Int ]
>>> let julian :: Person = emptyBook & #age =: 28 & #name =: "Julian K. Arni"