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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
import Data.Function ((&))
import Data.Text (Text, pack)
import Effectful (Eff, (:>), runEff)
import Effectful.Concurrent (Concurrent, runConcurrent, threadDelay)
import Effectful.Log (LogLevel(LogAttention, LogInfo), runLog)
import Effectful.Reader.Static (Reader, asks, runReader)
import Effectful.Resource (runResource)
import Effectful.State.Static.Local (evalState)
import Hsm.Core.App (launch)
import Hsm.Core.Env (deriveFromYaml)
import Hsm.Core.Fsm qualified as F
import Hsm.Core.Zmq.Server (runServer, send)
import Streamly.Data.Stream (Stream, repeatM)
import System.IO.Echo (withoutInputEcho)
data Env = Env
{ name :: Text
, pubEp :: Text
, period :: Int
, pulses :: Int
}
$(deriveFromYaml ''Env)
pulse :: (Concurrent :> es, Reader Env :> es) => Stream (Eff es) ()
pulse = repeatM $ asks period >>= threadDelay
stateRun :: F.FsmState () Int Env Int
stateRun = F.FsmState "run" action
where
action :: () -> Env -> Int -> F.FsmOutput () Int Env Int
action _ env sta =
if sta < env.pulses
then next
else exit
where
next :: F.FsmOutput () Int Env Int
next =
F.FsmOutput
(Just $ F.FsmResult sta (succ sta) stateRun)
[(LogInfo, "Sending pulse #" <> pack (show sta))]
--
exit :: F.FsmOutput () Int Env Int
exit =
F.FsmOutput
Nothing
[(LogAttention, "Reached " <> pack (show env.pulses) <> " pulses")]
main :: IO ()
main =
launch @Env "dummy-pulser" withoutInputEcho $ \env logger level ->
(pulse & F.fsm @_ @_ @Env @Int & send @Env @_ @Int)
& runServer @Env
& evalState @Int 1
& evalState stateRun
& runConcurrent
& runLog env.name logger level
& runReader env
& runResource
& runEff
|
