Initial

1 files changed, 56 insertions, 0 deletions

diff --git a/hsm-dummy-poller/Main.hs b/hsm-dummy-poller/Main.hs
new file mode 100644
index 0000000..7a35230
--- /dev/null
+++ b/hsm-dummy-poller/Main.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+import Control.Monad (forM_)
+import Data.Function ((&))
+import Data.Text (Text, pack)
+import Effectful (Eff, (:>), runEff)
+import Effectful.Concurrent (Concurrent, runConcurrent, threadDelay)
+import Effectful.Log (Log, localDomain, logInfo_, runLog)
+import Effectful.Reader.Static (Reader, asks, runReader)
+import Effectful.Resource (runResource)
+import Hsm.Core.App (launch)
+import Hsm.Core.Env (deriveFromYaml)
+import Hsm.Core.Zmq.Client (poll, runClient)
+import Streamly.Data.Fold qualified as S (drain)
+import Streamly.Data.Stream qualified as S (Stream, fold, mapM)
+import System.IO.Echo (withoutInputEcho)
+
+data Env = Env
+  { name :: Text
+  , subEps :: [Text]
+  , topics :: [Text]
+  , period :: Int
+  }
+
+$(deriveFromYaml ''Env)
+
+handle ::
+     forall es. (Concurrent :> es, Log :> es, Reader Env :> es)
+  => S.Stream (Eff es) [Int]
+  -> Eff es ()
+handle =
+  S.fold S.drain . S.mapM (\p -> asks period >>= threadDelay >> handler p)
+  where
+    receiverDomain :: Text
+    receiverDomain = "receiver"
+    --
+    handler :: [Int] -> Eff es ()
+    handler [] = localDomain receiverDomain $ logInfo_ "No pulse received yet"
+    handler ps =
+      forM_ ps $ \p ->
+        localDomain receiverDomain
+          $ logInfo_
+          $ "Received pulse #" <> pack (show p)
+
+main :: IO ()
+main =
+  launch @Env "dummy-poller" withoutInputEcho $ \env logger level ->
+    (poll & handle)
+      & runClient @Env
+      & runConcurrent
+      & runLog env.name logger level
+      & runReader env
+      & runResource
+      & runEff