2 files changed, 108 insertions, 0 deletions
diff --git a/hsm-dummy-pulser/Main.hs b/hsm-dummy-pulser/Main.hs
new file mode 100644
index 0000000..a432301
--- /dev/null
+++ b/hsm-dummy-pulser/Main.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- Proof of concept application, defines custom @Producer@ and FSM @Pipe@
+-- components. Publishes a new number (in sequence) through ZMQ every second.
+-- Throws an exception after a set number of pulses is reached.
+module Main
+  ( main
+  )
+where
+
+import Control.Concurrent (threadDelay)
+import Control.Exception.Safe (StringException, throwString)
+import Control.Monad (forever)
+import Control.Monad.Extra (whenM)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Reader (asks)
+import Control.Monad.State (get, gets, modify)
+import Data.Aeson (FromJSON)
+import Data.Function ((&))
+import Data.Text (Text, pack)
+import Effectful (IOE, runEff)
+import Effectful.Log (Log, localDomain, logInfo_, logTrace_, runLog)
+import Effectful.Reader.Static (Reader, runReader)
+import Effectful.Resource (Resource, runResource)
+import Effectful.State.Static.Local (State, evalState)
+import GHC.Generics (Generic)
+import Hsm.Core.App (launch)
+import Hsm.Core.Fsm (FsmC, Method (Method), fsm)
+import Hsm.Core.Pipes (Pipe, Producer, await, runEffect, yield, (>->))
+import Hsm.Core.Zmq (server)
+
+data Env = Env
+  { name :: Text
+  , pubEp :: Text
+  , pulses :: Int
+  }
+  deriving (FromJSON, Generic)
+
+type Effs = [Log, Reader Env, Resource, State Int, IOE]
+
+type Pulser = Producer () Env Int Effs
+
+type FsmMethodC es = (FsmC Env Int StringException es)
+
+type FsmMethod es = Method () Int Env Int StringException es
+
+type FsmPipe es = Pipe () Int Env Int es
+
+pulser :: Pulser ()
+pulser =
+  localDomain "pulser" $
+    forever $
+      liftIO (threadDelay 1000000) >> logTrace_ "Tick" >> yield ()
+
+stateRun :: FsmMethodC es => FsmMethod es
+stateRun =
+  Method "run" $ do
+    check >> await >> modify succ >> report >> get >>= yield
+    return stateRun
+ where
+  check :: FsmMethodC es => FsmPipe es ()
+  check =
+    asks pulses >>= \top ->
+      whenM (gets (== top)) $
+        throwString $
+          "Reached " <> show top <> " pulses"
+
+  report :: FsmMethodC es => FsmPipe es ()
+  report = get >>= logInfo_ . mappend "Sending pulse #" . pack . show
+
+stateError :: FsmMethodC es => FsmMethod es
+stateError = Method "error" $ logInfo_ "Doing nothing" >> forever await
+
+main :: IO ()
+main =
+  launch "dummy-pulser" $ \logger level e ->
+    (pulser >-> fsm stateRun stateError >-> server)
+      & runEffect
+      & runLog e.name logger level
+      & runReader e
+      & runResource
+      & evalState 0
+      & 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..46db00b
--- /dev/null
+++ b/hsm-dummy-pulser/hsm-dummy-pulser.cabal
@@ -0,0 +1,23 @@
+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-core
+    , extra
+    , hsm-core
+    , log-effectful
+    , mtl
+    , resourcet-effectful
+    , safe-exceptions
+    , text
+
+  main-is:          Main.hs
+  ghc-options:      -Wall -Wunused-packages
+  default-language: GHC2024