diff options
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 | 
