aboutsummaryrefslogtreecommitdiff
path: root/hsm-dummy-pulser
diff options
context:
space:
mode:
Diffstat (limited to 'hsm-dummy-pulser')
-rw-r--r--hsm-dummy-pulser/Main.hs64
-rw-r--r--hsm-dummy-pulser/hsm-dummy-pulser.cabal25
2 files changed, 89 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
diff --git a/hsm-dummy-pulser/hsm-dummy-pulser.cabal b/hsm-dummy-pulser/hsm-dummy-pulser.cabal
new file mode 100644
index 0000000..747f62c
--- /dev/null
+++ b/hsm-dummy-pulser/hsm-dummy-pulser.cabal
@@ -0,0 +1,25 @@
+cabal-version: 3.4
+author: Paul Oliver
+build-type: Simple
+maintainer: contact@pauloliver.dev
+name: hsm-dummy-pulser
+version: 0.1.0.0
+
+executable dummy-pulser
+ build-depends:
+ , base
+ , echo
+ , effectful
+ , hsm-core
+ , log-effectful
+ , resourcet-effectful
+ , streamly-core
+ , text
+
+ main-is: Main.hs
+ ghc-options: -Wall -Wunused-packages
+
+ if !arch(x86_64)
+ ghc-options: -optl=-mno-fix-cortex-a53-835769
+
+ default-language: GHC2021