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
|
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
import Data.ByteString (ByteString)
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.Message (message)
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 () ByteString Env Int
stateRun =
F.FsmState "run" $ \_ env sta ->
if sta < env.pulses
then F.FsmOutput
(Just $ F.FsmResult (message env.name sta) (succ sta) stateRun)
[(LogInfo, "Sending pulse #" <> pack (show sta))]
else F.FsmOutput
Nothing
[(LogAttention, "Sent " <> pack (show env.pulses) <> " pulses")]
-- Dummy pulser service:
-- Proof of concept. Publishes a "pulse" through ZMQ at a set interval.
main :: IO ()
main =
launch @Env "dummy-pulser" withoutInputEcho $ \env logger level ->
(pulse & F.fsm @_ @_ @Env @Int & send)
& runServer @Env
& evalState @Int 1
& evalState stateRun
& runConcurrent
& runLog env.name logger level
& runReader env
& runResource
& runEff
|
