GenStatem

Event-Driven FSM

See: Erlang gen_statem Behaviour

  1. State(S) x Event(E) -> Actions(A), State(S')

GenStatem Typeclass

  1. class GenStatem e s d | e -> s, s -> d, d -> e where
  2.   handleEvent :: HandleEvent e s d

CodeLock Example

  1. module Demo.FSM.CodeLock
  2.   ( name
  3.   , start
  4.   , push
  5.   , stop
  6.   ) where
  8. import Prelude
  10. import Control.Behaviour.GenStatem
  11.   ( class GenStatem
  12.   , Action(..)
  13.   , EventType(..)
  14.   , Init
  15.   , OnEvent
  16.   , initOk
  17.   , handleWith
  18.   , unhandled
  19.   )
  20. import Control.Behaviour.GenStatem as FSM
  22. data Event = Button Integer | Lock
  23. data State = Locked | Opened
  24. data Data = Data
  25.   { code :: [Integer]
  26.   , length :: Integer
  27.   , buttons :: [Integer]
  28.   }
  30. instance Eq State where
  31.   eq Locked Locked = true
  32.   eq Opened Opened = true
  33.   eq _ _ = false
  35. instance GenStatem Event State Data where
  36.   handleEvent = handleWith [(Locked, locked), (Opened, opened)]
  38. name :: Atom
  39. name = :code_lock
  41. start :: [Integer] -> Process Pid
  42. start code = FSM.startLinkWith name (init code)
  44. push :: Integer -> Process ()
  45. push n = FSM.cast name (Button n)
  47. stop :: Process ()
  48. stop = FSM.stop name
  50. init :: [Integer] -> Init Event State Data
  51. init code = initOk Locked d
  52.   where d = Data $ { code = reverse code
  53.                    , length = length code
  54.                    , buttons = []
  55.                    }
  57. locked :: OnEvent Event State Data
  58. locked Cast (Button n) (Data d) =
  59.   let buttons = take d.length [n|d.buttons]
  60.    in if buttons == d.code then
  61.         let actions = [StateTimeout 1000 Lock] in
  62.             FSM.nextWith Opened (Data d{buttons = []}) actions
  63.       else FSM.keep (Data d{buttons = buttons})
  65. locked t e d = unhandled t e Locked d
  67. opened :: OnEvent Event State Data
  68. opened Cast (Button _) d = FSM.keep d
  70. opened Timeout Lock d = do
  71.   println "Timeout Lock"
  72.   FSM.next Locked d
  74. opened t e d = unhandled t e Opened d

Start a FSM process

  1. -- | Start a standalone FSM process
  2. start :: forall e s d. GenStatem e s d => (Init e s d) -> Process Pid
  3. startWith :: forall e s d. GenStatem e s d => Name -> (Init e s d) -> Process Pid
  5. -- | Start a FSM process as part of a supervision tree.
  6. startLink :: forall e s d. GenStatem e s d => (Init e s d) -> Process Pid
  7. startLinkWith :: forall e s d. GenStatem e s d => Name -> (Init e s d) -> Process Pid

Init callback

  1. -- | Init Result
  2. data InitResult e s d
  3.   = InitOk s d [Action e]
  4.     -- ^ {ok, State, Actions}
  5.   | InitIgnore
  6.     -- ^ ignore
  7.   | InitStop ExitReason
  8.     -- ^ {stop, Reason}
  10. -- | Init Action
  11. type Init e s d = Process (InitResult e s d)

HandleEvent callback

  1. -- | Event Type
  2. data EventType
  3.   = Call From | Cast | Info
  4.     -- ^ external event type
  5.   | Timeout
  6.     -- ^ timeout event type
  7.   | Internal
  8.     -- ^ internal
  10. -- | Statem Transition
  11. data Transition e s d
  12.   = Keep d [Action e]
  13.   | Next s d [Action e]
  14.   | Repeat d [Action e]
  15.   | Shutdown ExitReason d
  17. type HandleEvent e s d = EventType -> e -> s -> d -> Process (Transition e s d)
  19. -- | On Event
  20. type OnEvent e s d = EventType -> e -> d -> Process (Transition e s d)
  22. -- | Handle with state functions.
  23. handleWith :: forall e s d. [(s, OnEvent e s d)] -> HandleEvent e s d

Client APIs

  1. call :: forall req rep. Name -> req -> Process rep
  3. cast :: forall msg. Name -> msg -> Process ()