bookkeeper-0.2.5: Anonymous records and overloaded labels

Safe HaskellNone
LanguageHaskell2010

Bookkeeper.Internal

Contents

Synopsis

Documentation

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

newtype Book' (a :: [Mapping Symbol Type]) Source #

The internal representation of a Book.

Constructors

Book 

Fields

Instances

(Eq val, Eq (Book' xs)) => Eq (Book' ((:) (Mapping Symbol *) ((:=>) Symbol * field val) xs)) Source # 

Methods

(==) :: Book' ((Mapping Symbol * ': (Symbol :=> *) field val) xs) -> Book' ((Mapping Symbol * ': (Symbol :=> *) field val) xs) -> Bool #

(/=) :: Book' ((Mapping Symbol * ': (Symbol :=> *) field val) xs) -> Book' ((Mapping Symbol * ': (Symbol :=> *) field val) xs) -> Bool #

Eq (Book' ([] (Mapping Symbol Type))) Source # 
ShowHelper (Book' a) => Show (Book' a) Source # 

Methods

showsPrec :: Int -> Book' a -> ShowS #

show :: Book' a -> String #

showList :: [Book' a] -> ShowS #

Monoid (Book' ([] (Mapping Symbol Type))) Source # 
(Default (Book' xs), Default v) => Default (Book' ((:) (Mapping Symbol *) ((:=>) Symbol * k v) xs)) Source # 

Methods

def :: Book' ((Mapping Symbol * ': (Symbol :=> *) k v) xs) #

Default (Book' ([] (Mapping Symbol Type))) Source # 
(ShowHelper (Book' xs), KnownSymbol k, Show v) => ShowHelper (Book' ((:) (Mapping Symbol *) ((:=>) Symbol * k v) xs)) Source # 

Methods

showHelper :: Book' ((Mapping Symbol * ': (Symbol :=> *) k v) xs) -> [(String, String)] Source #

ShowHelper (Book' ([] (Mapping Symbol Type))) Source # 

class ShowHelper a where Source #

Minimal complete definition

showHelper

Methods

showHelper :: a -> [(String, String)] Source #

Instances

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 :: Symbol) 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 :: 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.2.5-7Bfa1Oe73gjGQk0shmMf9V" False) (C1 * (MetaCons "Key" PrefixI False) (U1 *))

Getters

type Gettable field book val = (Submap '[field :=> val] book, Contains book field val) Source #

Gettable field val book is the constraint needed to get a value of type val from the field field in the book of type Book book.

get :: forall field book val. Gettable field book 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. Gettable field book val => Book' book -> Key field -> val infixl 3 Source #

Flipped and infix version of get.

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

Setters

type Settable field val old new = (Submap (AsMap (old :\ field)) old, Unionable '[field :=> val] (AsMap (old :\ field)), new ~ AsMap ((field :=> val) ': AsMap (old :\ field))) Source #

'Settable field val old new' is a constraint needed to set the the field field to a value of type val in the book of type 'Book old'. The resulting book will have type 'Book new'.

set :: forall field val old new. Settable field val old new => Key field -> val -> Book' old -> Book' new Source #

Sets or updates a field to a value.

>>> set #likesDoctest True julian
Book {age = 28, likesDoctest = True, name = "Julian K. Arni"}

(=:) :: Settable field val old new => Key field -> val -> Book' old -> Book' new infix 3 Source #

Infix version of set

>>> julian & #age =: 29
Book {age = 29, name = "Julian K. Arni"}

Modifiers

type Modifiable field val val' old new = (Settable field val' old new, AsMap new ~ new, Contains old field val, Submap '[field :=> val] old) Source #

Modifiable field val val' old new is a constraint needed to apply a function of type val -> val' to the field field in the book of type Book old. The resulting book will have type Book new.

modify :: Modifiable field val val' old new => Key field -> (val -> val') -> Book' old -> Book new Source #

Apply a function to a field.

>>> julian & modify #name (fmap toUpper)
Book {age = 28, name = "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 ...

(%:) :: Modifiable field val val' old new => Key field -> (val -> val') -> Book' old -> Book new infixr 3 Source #

Infix version of modify.

>>> julian & #name %: fmap toUpper
Book {age = 28, name = "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
...

Generics

class FromGeneric a book | a -> book where Source #

Minimal complete definition

fromGeneric

Methods

fromGeneric :: a x -> Book' book Source #

Instances

((~) [Mapping Symbol Type] book (Expected k [Mapping Symbol Type] lhs), (~) (k -> *) lhs (U1 k)) => FromGeneric k lhs book Source # 

Methods

fromGeneric :: book x -> Book' book Source #

(FromGeneric k l lbook, FromGeneric k r rbook, Unionable lbook rbook, (~) [Mapping Symbol Type] book (Union Symbol Type lbook rbook)) => FromGeneric k ((:*:) k l r) book Source # 

Methods

fromGeneric :: book x -> Book' book Source #

(~) [Mapping Symbol *] v (AsMap Symbol * ((:) (Mapping Symbol *) ((:->) Symbol * name t) ([] (Mapping Symbol *)))) => FromGeneric k (S1 k (MetaSel (Just Symbol name) p s l) (Rec0 k t)) v Source # 

Methods

fromGeneric :: v x -> Book' book Source #

FromGeneric k cs book => FromGeneric k (C1 k m cs) book Source # 

Methods

fromGeneric :: book x -> Book' book Source #

FromGeneric k cs book => FromGeneric k (D1 k m cs) book Source # 

Methods

fromGeneric :: book x -> Book' book Source #

(~) [Mapping Symbol Type] book (Expected k [Mapping Symbol Type] ((:+:) k l r)) => FromGeneric k ((:+:) k l r) book Source # 

Methods

fromGeneric :: book x -> Book' book Source #

type family Expected a where ... Source #

Equations

Expected (l :+: r) = TypeError (Text "Cannot convert sum types into Books") 
Expected U1 = TypeError (Text "Cannot convert non-record types into Books") 

fromRecord :: (Generic a, FromGeneric (Rep a) bookRep) => a -> Book' bookRep Source #

Generate a Book from an ordinary Haskell record via GHC Generics.

>>> data Test = Test {  field1 :: String, field2 :: Int, field3 :: Char } deriving Generic
>>> fromRecord (Test "hello" 0 'c')
Book {field1 = "hello", field2 = 0, field3 = 'c'}

Trying to convert a datatype which is not a record will result in a type error:

>>> data SomeSumType = LeftSide | RightSide deriving Generic
>>> fromRecord LeftSide
...
... • Cannot convert sum types into Books
...
>>> data Unit = Unit deriving Generic
>>> fromRecord Unit
...
... • Cannot convert non-record types into Books
...
>>> import Data.Function ((&))
>>> import Data.Char (toUpper)
>>> type Person = Book '[ "name" :=> String , "age" :=> Int ]
>>> let julian :: Person = emptyBook & #age =: 28 & #name =: "Julian K. Arni"