1 files changed, 64 insertions, 0 deletions
diff --git a/hsm-dummy-pulser/Main.hs b/hsm-dummy-pulser/Main.hs
new file mode 100644
index 0000000..3d734ba
--- /dev/null
+++ b/hsm-dummy-pulser/Main.hs
@@ -0,0 +1,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