diff options
author | Paul Oliver <contact@pauloliver.dev> | 2024-12-29 17:05:34 +0000 |
---|---|---|
committer | Paul Oliver <contact@pauloliver.dev> | 2025-01-16 18:30:09 -0800 |
commit | cc639b06c7126fac7b445d8f778455620d7f8f50 (patch) | |
tree | a4c5c7c0b0a9cdb5bea0891e198003035065e57d /hsm-dummy-pulser |
Initial
Diffstat (limited to 'hsm-dummy-pulser')
-rw-r--r-- | hsm-dummy-pulser/Main.hs | 64 | ||||
-rw-r--r-- | hsm-dummy-pulser/hsm-dummy-pulser.cabal | 25 |
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 |