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
65
66
67
68
69
70
71
72
|
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Main
( main
)
where
import Data.Aeson.TH (defaultOptions, deriveFromJSON, rejectUnknownFields)
import Data.Function ((&))
import Data.Text (Text, show)
import Effectful (Eff, runEff, (:>))
import Effectful.Concurrent (Concurrent, runConcurrent, threadDelay)
import Effectful.Log (runLog)
import Effectful.Reader.Static (Reader, ask, runReader)
import Effectful.Resource (runResource)
import Effectful.State.Static.Local (evalState)
import Hsm.Core.App (launch)
import Hsm.Core.Fsm qualified as F
import Hsm.Core.Zmq (runServer, send)
import Streamly.Data.Fold (drain)
import Streamly.Data.Stream (fold, mapM, repeatM)
import Prelude hiding (mapM, show)
data Env = Env
{ name :: Text
, pubEp :: Text
, period :: Int
, pulses :: Int
}
$(deriveFromJSON defaultOptions {rejectUnknownFields = True} ''Env)
tick :: (Concurrent :> es, Reader Env :> es) => Eff es ()
tick = ask >>= threadDelay . period >> return ()
run :: F.FsmState () Int Env Int
run = F.FsmState "run" action
where
action :: () -> Env -> Int -> F.FsmOutput () Int Env Int
action _ env state = if state < env.pulses then next else exit
where
next :: F.FsmOutput () Int Env Int
next =
"Sending pulse #" <> show state
& F.pLogInfo
& F.FsmOutput (Just $ F.FsmResult state (succ state) run)
exit :: F.FsmOutput () Int Env Int
exit =
"Reached " <> show env.pulses <> " pulses"
& F.pLogAttention
& F.FsmOutput Nothing
main :: IO ()
main =
launch @Env "dummy-pulser" $ \env logger level ->
( repeatM tick
& F.fsmStream @_ @Int @Env @Int
& mapM (send @_ @Env)
& fold drain
)
& runServer @Env
& runConcurrent
& runLog env.name logger level
& runReader env
& runResource
& evalState @Int 1
& evalState run
& runEff
|
