distributed-process-fsm-0.0.1: The Cloud Haskell implementation of Erlang/OTP gen_statem

Copyright(c) Tim Watson 2017
LicenseBSD3 (see the file LICENSE)
MaintainerTim Watson <watson.timothy@gmail.com>
Stabilityexperimental
Portabilitynon-portable (requires concurrency)
Safe HaskellNone
LanguageHaskell98

Control.Distributed.Process.FSM.Internal.Types

Description

Types and common functionality.

Synopsis

Documentation

apply :: Show s => State s d -> Message -> Step s d -> Process (Maybe (State s d)) Source #

applyTransitions :: forall s d. Show s => State s d -> [GenProcess (State s d) ()] -> Action (State s d) Source #

data State s d Source #

The internal state of an FSM process.

Constructors

(Show s, Eq s) => State 

Fields

Instances

Show s => Show (State s d) Source # 

Methods

showsPrec :: Int -> State s d -> ShowS #

show :: State s d -> String #

showList :: [State s d] -> ShowS #

MonadState (State s d) (FSM s d) Source # 

Methods

get :: FSM s d (State s d) #

put :: State s d -> FSM s d () #

state :: (State s d -> (a, State s d)) -> FSM s d a #

data Transition s d Source #

Represents a transition from one world state to another. Transitions can be used to alter the process state, state data, to modify and/or interact with the process mailbox, and to postpone processing of messages until state changes take place.

The fundmental state transactions are Remain, Enter newState, and Stop exitReason.

Instances

Show s => Show (Transition s d) Source # 

Methods

showsPrec :: Int -> Transition s d -> ShowS #

show :: Transition s d -> String #

showList :: [Transition s d] -> ShowS #

data Event m where Source #

Represents an event arriving, parameterised by the type m of the event. Used in a combinatorial style to wire FSM steps, actions and transitions to specific types of input event.

Constructors

Wait :: Serializable m => Event m 
WaitP :: Serializable m => Priority () -> Event m 
Event :: Serializable m => m -> Event m 

Instances

Typeable * m => Show (Event m) Source # 

Methods

showsPrec :: Int -> Event m -> ShowS #

show :: Event m -> String #

showList :: [Event m] -> ShowS #

data Stopping Source #

Event type wrapper passed to the FSM whenever we're shutting down.

Constructors

Stopping 

Fields

Instances

Show Stopping Source # 
Generic Stopping Source # 

Associated Types

type Rep Stopping :: * -> * #

Methods

from :: Stopping -> Rep Stopping x #

to :: Rep Stopping x -> Stopping #

Binary Stopping Source # 

Methods

put :: Stopping -> Put #

get :: Get Stopping #

putList :: [Stopping] -> Put #

type Rep Stopping Source # 
type Rep Stopping = D1 (MetaData "Stopping" "Control.Distributed.Process.FSM.Internal.Types" "distributed-process-fsm-0.0.1-CkNPRCCWUDwKnzcrQjxehF" False) (C1 (MetaCons "Stopping" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "reason") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 ExitReason)) (S1 (MetaSel (Just Symbol "errored") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Bool))))

resolveEvent :: forall s d m. Serializable m => Event m -> Message -> State s d -> m -> Process (Int, Message) Source #

Resolve an event into a priority setting, for insertion into a priority queue.

data Step s d where Source #

Represents a step in a FSM definition

Constructors

Init :: Step s d -> Step s d -> Step s d 
Yield :: s -> d -> Step s d 
SafeWait :: Serializable m => Event m -> Step s d -> Step s d 
Await :: Serializable m => Event m -> Step s d -> Step s d 
Always :: Serializable m => (m -> FSM s d (Transition s d)) -> Step s d 
Perhaps :: Eq s => s -> FSM s d (Transition s d) -> Step s d 
Matching :: Serializable m => (m -> Bool) -> (m -> FSM s d (Transition s d)) -> Step s d 
Sequence :: Step s d -> Step s d -> Step s d 
Alternate :: Step s d -> Step s d -> Step s d 
Reply :: Serializable r => FSM s d r -> Step s d 

Instances

Show s => Show (Step s d) Source # 

Methods

showsPrec :: Int -> Step s d -> ShowS #

show :: Step s d -> String #

showList :: [Step s d] -> ShowS #

newtype FSM s d o Source #

State monad transformer.

Constructors

FSM 

Fields

Instances

Monad (FSM s d) Source # 

Methods

(>>=) :: FSM s d a -> (a -> FSM s d b) -> FSM s d b #

(>>) :: FSM s d a -> FSM s d b -> FSM s d b #

return :: a -> FSM s d a #

fail :: String -> FSM s d a #

Functor (FSM s d) Source # 

Methods

fmap :: (a -> b) -> FSM s d a -> FSM s d b #

(<$) :: a -> FSM s d b -> FSM s d a #

MonadFix (FSM s d) Source # 

Methods

mfix :: (a -> FSM s d a) -> FSM s d a #

Applicative (FSM s d) Source # 

Methods

pure :: a -> FSM s d a #

(<*>) :: FSM s d (a -> b) -> FSM s d a -> FSM s d b #

(*>) :: FSM s d a -> FSM s d b -> FSM s d b #

(<*) :: FSM s d a -> FSM s d b -> FSM s d a #

MonadIO (FSM s d) Source # 

Methods

liftIO :: IO a -> FSM s d a #

MonadState (State s d) (FSM s d) Source # 

Methods

get :: FSM s d (State s d) #

put :: State s d -> FSM s d () #

state :: (State s d -> (a, State s d)) -> FSM s d a #

runFSM :: State s d -> FSM s d o -> Process (o, State s d) Source #

Run an action in the FSM monad.

lift :: Process a -> FSM s d a Source #

Lift an action in the Process monad to FSM.

liftIO :: IO a -> FSM s d a Source #

Lift an IO action directly into FSM, liftIO = lift . Process.LiftIO.

currentState :: FSM s d s Source #

Fetch the state for the current pass.

currentInput :: forall s d m. Serializable m => FSM s d (Maybe m) Source #

Retrieve the currentMessage and attempt to decode it to type m

currentMessage :: forall s d. FSM s d Message Source #

Fetch the message that initiated the current pass.

stateData :: FSM s d d Source #

Fetch the state data for the current pass.

addTransition :: Transition s d -> FSM s d () Source #

Add a Transition to be evaluated once the current pass completes.

baseErr :: String Source #

Base module name for error messages.

decodeToEvent :: Serializable m => Event m -> Message -> Maybe (Event m) Source #

Given an Event for any Serializable type m and a raw message, decode the message and map it to either Event m if the types are aligned, otherwise Nothing.