{-# 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