blob: caa2e7ec62d7cc20f7dcd8b4391bc42887fe7aa0 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
|
{-# LANGUAGE OverloadedStrings #-}
-- Module : Hsm.Core.Fsm
-- Maintainer : contact@pauloliver.dev
module Hsm.Core.Fsm
( Method (Method)
, FsmC
, fsm
)
where
import Control.Exception.Safe (Exception, catch, displayException)
import Data.Text (Text, pack)
import Effectful ((:>))
import Effectful.Log (Log, localDomain, logAttention_, logTrace_)
import Effectful.Reader.Static (Reader)
import Effectful.State.Static.Local (State)
import GHC.Records (HasField)
import Hsm.Core.Pipes (Pipe)
data Method a b e s x es = Method Text (Pipe a b e s es (Method a b e s x es))
type FsmC e s x es = (HasField "name" e Text, Exception x, Log :> es, Reader e :> es, State s :> es)
-- Builds an FSM with an initial and a default method. Because both @Proxy@
-- and @Eff@ are instances of @MonadCatch@ and @MonadThrow@, exceptions may be
-- thrown from within state methods. The FSM transitions to its default state
-- if an exception is thrown.
fsm :: forall a b e s x es. FsmC e s x es => Method a b e s x es -> Method a b e s x es -> Pipe a b e s es ()
fsm actionInit actionDefault = localDomain "fsm" $ run actionInit
where
run :: Method a b e s x es -> Pipe a b e s es ()
run (Method name action) = do
logTrace_ $ "Entering state " <> name
next <- localDomain name action `catch` handle
logTrace_ $ "Exiting state " <> name
run next
where
handle :: x -> Pipe a b e s es (Method a b e s x es)
handle exception = do
logAttention_ $ "Exception caught while on state " <> name
logAttention_ $ pack $ displayException exception
return actionDefault
|
