aboutsummaryrefslogtreecommitdiff
path: root/hsm-dummy-poller/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'hsm-dummy-poller/Main.hs')
-rw-r--r--hsm-dummy-poller/Main.hs56
1 files changed, 0 insertions, 56 deletions
diff --git a/hsm-dummy-poller/Main.hs b/hsm-dummy-poller/Main.hs
deleted file mode 100644
index 9f2fad9..0000000
--- a/hsm-dummy-poller/Main.hs
+++ /dev/null
@@ -1,56 +0,0 @@
-{-# 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 ::
- (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 = "receiver"
- handler [] = localDomain receiverDomain $ logInfo_ "No pulse received yet"
- handler ps =
- forM_ ps $ \p ->
- localDomain receiverDomain
- $ logInfo_
- $ "Received pulse #" <> pack (show p)
-
--- Dummy poller service:
--- Proof of concept. Polls for "pulses" through ZMQ at a set interval and
--- logs each time one is received.
-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