composable-associations-0.1.0.0: Types and helpers for composing types into a single larger key-value type.

Safe HaskellSafe
LanguageHaskell2010

Data.ComposableAssociation

Contents

Synopsis

Description

This library exports core types, helper functions, and Lens's.

Unless you're implementing a serialization library (orphan instances for these types to implement serialization/deserialization for some format) you probably don't want to import this package directly. Additional packages in this namespace re-export this module along with their orphan instances for serialization.

Core Types

data Association key value Source #

A type representing a key-value association where the "key" itself exists only at the type level.

>>> let x = Association Proxy [1, 2, 3] :: Asssociation "type-level-key" [Int]

This type exists primarily as a way to "tag" data with a key for the purpose of serializing haskell data into formats that have a key-value representation (ex: a JSON object).

The example above represents a serializable key-value pair with a key of "type-level-key" and a value of [1, 2, 3].

Storing the key as type-level information allows for unambiguous deserialization.

Constructors

Association (Proxy key) value 

Instances

Functor (Association k key) Source # 

Methods

fmap :: (a -> b) -> Association k key a -> Association k key b #

(<$) :: a -> Association k key b -> Association k key a #

Foldable (Association k key) Source # 

Methods

fold :: Monoid m => Association k key m -> m #

foldMap :: Monoid m => (a -> m) -> Association k key a -> m #

foldr :: (a -> b -> b) -> b -> Association k key a -> b #

foldr' :: (a -> b -> b) -> b -> Association k key a -> b #

foldl :: (b -> a -> b) -> b -> Association k key a -> b #

foldl' :: (b -> a -> b) -> b -> Association k key a -> b #

foldr1 :: (a -> a -> a) -> Association k key a -> a #

foldl1 :: (a -> a -> a) -> Association k key a -> a #

toList :: Association k key a -> [a] #

null :: Association k key a -> Bool #

length :: Association k key a -> Int #

elem :: Eq a => a -> Association k key a -> Bool #

maximum :: Ord a => Association k key a -> a #

minimum :: Ord a => Association k key a -> a #

sum :: Num a => Association k key a -> a #

product :: Num a => Association k key a -> a #

Traversable (Association k key) Source # 

Methods

traverse :: Applicative f => (a -> f b) -> Association k key a -> f (Association k key b) #

sequenceA :: Applicative f => Association k key (f a) -> f (Association k key a) #

mapM :: Monad m => (a -> m b) -> Association k key a -> m (Association k key b) #

sequence :: Monad m => Association k key (m a) -> m (Association k key a) #

Eq value => Eq (Association k key value) Source # 

Methods

(==) :: Association k key value -> Association k key value -> Bool #

(/=) :: Association k key value -> Association k key value -> Bool #

Show value => Show (Association k key value) Source # 

Methods

showsPrec :: Int -> Association k key value -> ShowS #

show :: Association k key value -> String #

showList :: [Association k key value] -> ShowS #

Generic (Association k key value) Source # 

Associated Types

type Rep (Association k key value) :: * -> * #

Methods

from :: Association k key value -> Rep (Association k key value) x #

to :: Rep (Association k key value) x -> Association k key value #

type Rep (Association k key value) Source # 
type Rep (Association k key value) = D1 (MetaData "Association" "Data.ComposableAssociation" "composable-associations-0.1.0.0-KhkmIMrG6rJ6atlf5GuXdu" False) (C1 (MetaCons "Association" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Proxy k key))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 value))))

data base :<> assoc Source #

A type representing the composition of a base type (which can be serialized into a key-value structure) along with a key-value type.

This type exists as a way to compose a haskell value that has a key-value representation (ex: a haskell record where its fields are keys to their values) with additional key-value associations into a single key-value object.

This is intended for use with Association to add additional key-values to a type for the purposes of serialization/deserialization.

For example:

>>> data User = User { name :: String, age :: Int }
>>> let alice = User "Alice" 26
>>> let bob = User "Bob" 25
>>> let charlie = User "Charlie" 27
>>> let bobsFriends = [alice, charlie]
>>> bobAndFriends :: User :<> Association "friends" [User]
>>> let bobAndFriends = bob :<> Association Proxy bobsFriends

While (bob, bobsFriends) contains the same values as bobAndFriends, it lacks information about how to combine bob and bobsFriends together into a single serialized key-value object (as well as how to deserialize that back into haskell values).

Constructors

base :<> assoc 

Instances

Functor ((:<>) base) Source # 

Methods

fmap :: (a -> b) -> (base :<> a) -> base :<> b #

(<$) :: a -> (base :<> b) -> base :<> a #

Foldable ((:<>) base) Source # 

Methods

fold :: Monoid m => (base :<> m) -> m #

foldMap :: Monoid m => (a -> m) -> (base :<> a) -> m #

foldr :: (a -> b -> b) -> b -> (base :<> a) -> b #

foldr' :: (a -> b -> b) -> b -> (base :<> a) -> b #

foldl :: (b -> a -> b) -> b -> (base :<> a) -> b #

foldl' :: (b -> a -> b) -> b -> (base :<> a) -> b #

foldr1 :: (a -> a -> a) -> (base :<> a) -> a #

foldl1 :: (a -> a -> a) -> (base :<> a) -> a #

toList :: (base :<> a) -> [a] #

null :: (base :<> a) -> Bool #

length :: (base :<> a) -> Int #

elem :: Eq a => a -> (base :<> a) -> Bool #

maximum :: Ord a => (base :<> a) -> a #

minimum :: Ord a => (base :<> a) -> a #

sum :: Num a => (base :<> a) -> a #

product :: Num a => (base :<> a) -> a #

Traversable ((:<>) base) Source # 

Methods

traverse :: Applicative f => (a -> f b) -> (base :<> a) -> f (base :<> b) #

sequenceA :: Applicative f => (base :<> f a) -> f (base :<> a) #

mapM :: Monad m => (a -> m b) -> (base :<> a) -> m (base :<> b) #

sequence :: Monad m => (base :<> m a) -> m (base :<> a) #

(Eq assoc, Eq base) => Eq ((:<>) base assoc) Source # 

Methods

(==) :: (base :<> assoc) -> (base :<> assoc) -> Bool #

(/=) :: (base :<> assoc) -> (base :<> assoc) -> Bool #

(Show assoc, Show base) => Show ((:<>) base assoc) Source # 

Methods

showsPrec :: Int -> (base :<> assoc) -> ShowS #

show :: (base :<> assoc) -> String #

showList :: [base :<> assoc] -> ShowS #

Generic ((:<>) base assoc) Source # 

Associated Types

type Rep ((:<>) base assoc) :: * -> * #

Methods

from :: (base :<> assoc) -> Rep (base :<> assoc) x #

to :: Rep (base :<> assoc) x -> base :<> assoc #

type Rep ((:<>) base assoc) Source # 
type Rep ((:<>) base assoc) = D1 (MetaData ":<>" "Data.ComposableAssociation" "composable-associations-0.1.0.0-KhkmIMrG6rJ6atlf5GuXdu" False) (C1 (MetaCons ":<>" (InfixI LeftAssociative 9) False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 base)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 assoc))))

type WithAssociation base assoc = base :<> assoc Source #

Type alias for the (:<>) type operator.

Useful if you don't like the TypeOperators extension.

Helper Functions

withAssociation :: a -> b -> WithAssociation a b Source #

Function alias for the (:<>) type constructor.

asValue :: obj -> Association key obj Source #

Convenience function for creating associations.

This is especially useful when type-inference elsewhere in your program will determine the type of the Association.

>>> let x = asValue True :: Association "whatever-key" Bool

reKey :: Association key obj -> Association key' obj Source #

Convenience function for changing the type of the Association's key.

>>> let x = Association Proxy 10 :: Association "key-x" Int
>>> let y = reKey x :: Association "key-y" Int

Lens

_value :: Functor f => (value -> f value') -> Association key value -> f (Association key value') Source #

_value :: Lens value value' (Association key value) (Association key value')

_assoc :: Functor f => (assoc -> f assoc') -> (base :<> assoc) -> f (base :<> assoc') Source #

_assoc :: Lens assoc assoc' (base :<> assoc) (base :<> assoc')

_base :: Functor f => (base -> f base') -> (base :<> assoc) -> f (base' :<> assoc) Source #

_base :: Lens base base' (base :<> assoc) (base' :<> assoc)

Generic Invalid Encoding Exception

data ObjectEncodingException Source #

Generic encoding exception for when a :<> "base" cannot be encoded as something object-like.

Each serialization should have a more specific version of this exception to convey information about the failure.

Constructors

Exception e => ObjectEncodingException e