mealstrom-0.0.1.1: Manipulate FSMs and store them in PostgreSQL.
Copyright(c) Max Amanshauser 2016
LicenseMIT
Maintainermax@lambdalifting.org
Safe HaskellNone
LanguageHaskell2010

Mealstrom.FSM

Description

These defintions are concerned with the basic functions of finite state machines, keeping a memory and state transitions.

Synopsis

Documentation

type MachineTransformer s e a = Machine s e a -> IO (Machine s e a) Source #

data MealyStatus Source #

A data type that often comes in handy when describing whether updates have succeeded in the backend.

Constructors

MealyError 
Pending 
Done 

Instances

Instances details
Eq MealyStatus Source # 
Instance details

Defined in Mealstrom.FSM

Show MealyStatus Source # 
Instance details

Defined in Mealstrom.FSM

class (Hashable k, Eq k) => FSMKey k where Source #

FSMs are uniquely identified by a type k, which must be convertible from/to Text.

Methods

toText :: k -> Text Source #

fromText :: Text -> k Source #

Instances

Instances details
FSMKey Text Source # 
Instance details

Defined in Mealstrom.FSM

FSMKey UUID Source # 
Instance details

Defined in Mealstrom.FSM

class FSMKey k => MealyInstance k s e a Source #

This typeclass is needed to provide a constraint for the FSMStore abstraction.

data Change s e a Source #

A change in a FSM is either a (Step Timestamp oldState event newState Actions) or an increase in a counter.

Constructors

Step UTCTime s e s [a] 
Count Int 

Instances

Instances details
(Eq s, Eq e) => Eq (Change s e a) Source #

Steps are equal to each other when they originated in the same state received the same event and ended up in the same state

Instance details

Defined in Mealstrom.FSM

Methods

(==) :: Change s e a -> Change s e a -> Bool #

(/=) :: Change s e a -> Change s e a -> Bool #

(Show s, Show e, Show a) => Show (Change s e a) Source # 
Instance details

Defined in Mealstrom.FSM

Methods

showsPrec :: Int -> Change s e a -> ShowS #

show :: Change s e a -> String #

showList :: [Change s e a] -> ShowS #

(ToJSON s, ToJSON e, ToJSON a) => ToJSON (Change s e a) Source # 
Instance details

Defined in Mealstrom.FSM

Methods

toJSON :: Change s e a -> Value #

toEncoding :: Change s e a -> Encoding #

toJSONList :: [Change s e a] -> Value #

toEncodingList :: [Change s e a] -> Encoding #

(FromJSON s, FromJSON e, FromJSON a) => FromJSON (Change s e a) Source # 
Instance details

Defined in Mealstrom.FSM

Methods

parseJSON :: Value -> Parser (Change s e a) #

parseJSONList :: Value -> Parser [Change s e a] #

data Instance k s e a Source #

Constructors

Instance 

Fields

Instances

Instances details
(Eq k, Eq e, Eq a, Eq s) => Eq (Instance k s e a) Source # 
Instance details

Defined in Mealstrom.FSM

Methods

(==) :: Instance k s e a -> Instance k s e a -> Bool #

(/=) :: Instance k s e a -> Instance k s e a -> Bool #

(Show k, Show e, Show a, Show s) => Show (Instance k s e a) Source # 
Instance details

Defined in Mealstrom.FSM

Methods

showsPrec :: Int -> Instance k s e a -> ShowS #

show :: Instance k s e a -> String #

showList :: [Instance k s e a] -> ShowS #

Generic (Instance k s e a) Source # 
Instance details

Defined in Mealstrom.FSM

Associated Types

type Rep (Instance k s e a) :: Type -> Type #

Methods

from :: Instance k s e a -> Rep (Instance k s e a) x #

to :: Rep (Instance k s e a) x -> Instance k s e a #

(Typeable s, Typeable e, Typeable a, FromJSON s, FromJSON e, FromJSON a, FSMKey k) => FromRow (Instance k s e a) Source # 
Instance details

Defined in Mealstrom.PostgresJSONStore

Methods

fromRow :: RowParser (Instance k s e a) #

type Rep (Instance k s e a) Source # 
Instance details

Defined in Mealstrom.FSM

type Rep (Instance k s e a) = D1 ('MetaData "Instance" "Mealstrom.FSM" "mealstrom-0.0.1.1-8m4QeTDuQN8CBXSSOFNKH6" 'False) (C1 ('MetaCons "Instance" 'PrefixI 'True) (S1 ('MetaSel ('Just "key") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 k) :*: S1 ('MetaSel ('Just "machine") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Machine s e a))))

data Machine s e a Source #

Constructors

Machine 

Fields

Instances

Instances details
(Eq e, Eq a, Eq s) => Eq (Machine s e a) Source # 
Instance details

Defined in Mealstrom.FSM

Methods

(==) :: Machine s e a -> Machine s e a -> Bool #

(/=) :: Machine s e a -> Machine s e a -> Bool #

(Show e, Show a, Show s) => Show (Machine s e a) Source # 
Instance details

Defined in Mealstrom.FSM

Methods

showsPrec :: Int -> Machine s e a -> ShowS #

show :: Machine s e a -> String #

showList :: [Machine s e a] -> ShowS #

Generic (Machine s e a) Source # 
Instance details

Defined in Mealstrom.FSM

Associated Types

type Rep (Machine s e a) :: Type -> Type #

Methods

from :: Machine s e a -> Rep (Machine s e a) x #

to :: Rep (Machine s e a) x -> Machine s e a #

(ToJSON s, ToJSON e, ToJSON a) => ToJSON (Machine s e a) Source #

Instance to convert one DB row to an instance of Instance ;) users of this module must provide instances for ToJSON, FromJSON for s, e and a.

Instance details

Defined in Mealstrom.PostgresJSONStore

Methods

toJSON :: Machine s e a -> Value #

toEncoding :: Machine s e a -> Encoding #

toJSONList :: [Machine s e a] -> Value #

toEncodingList :: [Machine s e a] -> Encoding #

(FromJSON s, FromJSON e, FromJSON a) => FromJSON (Machine s e a) Source # 
Instance details

Defined in Mealstrom.PostgresJSONStore

Methods

parseJSON :: Value -> Parser (Machine s e a) #

parseJSONList :: Value -> Parser [Machine s e a] #

(Typeable s, Typeable e, Typeable a, FromJSON s, FromJSON e, FromJSON a) => FromField (Machine s e a) Source # 
Instance details

Defined in Mealstrom.PostgresJSONStore

Methods

fromField :: FieldParser (Machine s e a) #

(Typeable s, Typeable e, Typeable a, ToJSON s, ToJSON e, ToJSON a) => ToField (Machine s e a) Source # 
Instance details

Defined in Mealstrom.PostgresJSONStore

Methods

toField :: Machine s e a -> Action #

type Rep (Machine s e a) Source # 
Instance details

Defined in Mealstrom.FSM

type Rep (Machine s e a) = D1 ('MetaData "Machine" "Mealstrom.FSM" "mealstrom-0.0.1.1-8m4QeTDuQN8CBXSSOFNKH6" 'False) (C1 ('MetaCons "Machine" 'PrefixI 'True) ((S1 ('MetaSel ('Just "inbox") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Msg e]) :*: (S1 ('MetaSel ('Just "outbox") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Msg a]) :*: S1 ('MetaSel ('Just "committed") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [UUID]))) :*: (S1 ('MetaSel ('Just "initState") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 s) :*: (S1 ('MetaSel ('Just "currState") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 s) :*: S1 ('MetaSel ('Just "hist") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Change s e a])))))

mkEmptyInstance :: k -> s -> Instance k s e a Source #

mkInstance :: k -> s -> [Msg e] -> Instance k s e a Source #

data Msg e Source #

Type of messages that are sent between FSMs Messages are always identified by UUID. The purpose of Msg is to attach a unique ID to an event, so that certain guarantees can be provided.

Constructors

Msg 

Fields

Instances

Instances details
Eq e => Eq (Msg e) Source # 
Instance details

Defined in Mealstrom.FSM

Methods

(==) :: Msg e -> Msg e -> Bool #

(/=) :: Msg e -> Msg e -> Bool #

Show e => Show (Msg e) Source # 
Instance details

Defined in Mealstrom.FSM

Methods

showsPrec :: Int -> Msg e -> ShowS #

show :: Msg e -> String #

showList :: [Msg e] -> ShowS #

Generic (Msg e) Source # 
Instance details

Defined in Mealstrom.FSM

Associated Types

type Rep (Msg e) :: Type -> Type #

Methods

from :: Msg e -> Rep (Msg e) x #

to :: Rep (Msg e) x -> Msg e #

ToJSON e => ToJSON (Msg e) Source # 
Instance details

Defined in Mealstrom.PostgresJSONStore

Methods

toJSON :: Msg e -> Value #

toEncoding :: Msg e -> Encoding #

toJSONList :: [Msg e] -> Value #

toEncodingList :: [Msg e] -> Encoding #

FromJSON e => FromJSON (Msg e) Source # 
Instance details

Defined in Mealstrom.PostgresJSONStore

Methods

parseJSON :: Value -> Parser (Msg e) #

parseJSONList :: Value -> Parser [Msg e] #

type Rep (Msg e) Source # 
Instance details

Defined in Mealstrom.FSM

type Rep (Msg e) = D1 ('MetaData "Msg" "Mealstrom.FSM" "mealstrom-0.0.1.1-8m4QeTDuQN8CBXSSOFNKH6" 'False) (C1 ('MetaCons "Msg" 'PrefixI 'True) (S1 ('MetaSel ('Just "msgID") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe UUID)) :*: S1 ('MetaSel ('Just "msgContents") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 e)))

mkMsg :: t -> IO (Msg t) Source #

mkMsgs :: [t] -> IO [Msg t] Source #

mkBogusMsg :: Eq t => t -> Msg t Source #

histAppend :: (Eq s, Eq e) => Change s e a -> [Change s e a] -> [Change s e a] Source #

Append a Change to a history. Identical steps are just counted, otherwise they are consed to the history.