summaryrefslogtreecommitdiff
path: root/hsm-dummy-pulser
diff options
context:
space:
mode:
Diffstat (limited to 'hsm-dummy-pulser')
-rw-r--r--hsm-dummy-pulser/Main.hs72
-rw-r--r--hsm-dummy-pulser/hsm-dummy-pulser.cabal21
2 files changed, 93 insertions, 0 deletions
diff --git a/hsm-dummy-pulser/Main.hs b/hsm-dummy-pulser/Main.hs
new file mode 100644
index 0000000..5c1e818
--- /dev/null
+++ b/hsm-dummy-pulser/Main.hs
@@ -0,0 +1,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
diff --git a/hsm-dummy-pulser/hsm-dummy-pulser.cabal b/hsm-dummy-pulser/hsm-dummy-pulser.cabal
new file mode 100644
index 0000000..7f89c08
--- /dev/null
+++ b/hsm-dummy-pulser/hsm-dummy-pulser.cabal
@@ -0,0 +1,21 @@
+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:
+ , aeson
+ , base
+ , effectful
+ , hsm-core
+ , log-effectful
+ , resourcet-effectful
+ , streamly-core
+ , text
+
+ main-is: Main.hs
+ ghc-options: -Wall -Wunused-packages
+ default-language: GHC2024