Copyright | (c) Max Amanshauser 2016 |
---|---|
License | MIT |
Maintainer | max@lambdalifting.org |
Safe Haskell | None |
Language | Haskell2010 |
These defintions are concerned with the basic functions of finite state machines, keeping a memory and state transitions.
Synopsis
- type MachineTransformer s e a = Machine s e a -> IO (Machine s e a)
- data MealyStatus
- = MealyError
- | Pending
- | Done
- class (Hashable k, Eq k) => FSMKey k where
- class FSMKey k => MealyInstance k s e a
- data Change s e a
- data Instance k s e a = Instance {}
- data Machine s e a = Machine {}
- mkEmptyMachine :: s -> Machine s e a
- mkEmptyInstance :: k -> s -> Instance k s e a
- mkInstance :: k -> s -> [Msg e] -> Instance k s e a
- data Msg e = Msg {
- msgID :: Maybe UUID
- msgContents :: e
- mkMsg :: t -> IO (Msg t)
- mkMsgs :: [t] -> IO [Msg t]
- mkBogusMsg :: Eq t => t -> Msg t
- histAppend :: (Eq s, Eq e) => Change s e a -> [Change s e a] -> [Change s e a]
Documentation
data MealyStatus Source #
A data type that often comes in handy when describing whether updates have succeeded in the backend.
Instances
Eq MealyStatus Source # | |
Defined in Mealstrom.FSM (==) :: MealyStatus -> MealyStatus -> Bool # (/=) :: MealyStatus -> MealyStatus -> Bool # | |
Show MealyStatus Source # | |
Defined in Mealstrom.FSM showsPrec :: Int -> MealyStatus -> ShowS # show :: MealyStatus -> String # showList :: [MealyStatus] -> ShowS # |
class (Hashable k, Eq k) => FSMKey k where Source #
FSMs are uniquely identified by a type k, which must be convertible from/to Text.
class FSMKey k => MealyInstance k s e a Source #
This typeclass is needed to provide a constraint for the FSMStore abstraction.
A change in a FSM is either a (Step Timestamp oldState event newState Actions) or an increase in a counter.
Instances
(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 |
(Show s, Show e, Show a) => Show (Change s e a) Source # | |
(ToJSON s, ToJSON e, ToJSON a) => ToJSON (Change s e a) Source # | |
Defined in Mealstrom.FSM | |
(FromJSON s, FromJSON e, FromJSON a) => FromJSON (Change s e a) Source # | |
data Instance k s e a Source #
Instances
(Eq k, Eq e, Eq a, Eq s) => Eq (Instance k s e a) Source # | |
(Show k, Show e, Show a, Show s) => Show (Instance k s e a) Source # | |
Generic (Instance k s e a) Source # | |
(Typeable s, Typeable e, Typeable a, FromJSON s, FromJSON e, FromJSON a, FSMKey k) => FromRow (Instance k s e a) Source # | |
Defined in Mealstrom.PostgresJSONStore | |
type Rep (Instance k s e a) Source # | |
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)))) |
Instances
mkEmptyMachine :: s -> Machine s e a Source #
mkEmptyInstance :: k -> s -> Instance k s e a Source #
mkInstance :: k -> s -> [Msg e] -> Instance k s e a 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.
Msg | |
|
Instances
Eq e => Eq (Msg e) Source # | |
Show e => Show (Msg e) Source # | |
Generic (Msg e) Source # | |
ToJSON e => ToJSON (Msg e) Source # | |
Defined in Mealstrom.PostgresJSONStore | |
FromJSON e => FromJSON (Msg e) Source # | |
type Rep (Msg e) Source # | |
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))) |
mkBogusMsg :: Eq t => t -> Msg t Source #