1 files changed, 12 insertions, 9 deletions
diff --git a/hsm-status/Main.hs b/hsm-status/Main.hs
index 594661b..8d02d76 100644
--- a/hsm-status/Main.hs
+++ b/hsm-status/Main.hs
@@ -7,8 +7,9 @@ import Data.Function ((&))
 import Data.Set (Set, singleton)
 import Data.Text (Text, pack)
 import Effectful (Eff, (:>), runEff)
+import Effectful.Concurrent (Concurrent, runConcurrent, threadDelay)
 import Effectful.Log (Log, LogLevel(LogAttention), runLog)
-import Effectful.Reader.Static (Reader, ask, runReader)
+import Effectful.Reader.Static (Reader, asks, runReader)
 import Effectful.Resource (runResource)
 import Effectful.State.Static.Local (evalState)
 import Hsm.Core.App (launch)
@@ -16,7 +17,7 @@ import Hsm.Core.Env (deriveFromYaml)
 import Hsm.Core.Fsm qualified as F
 import Hsm.Core.Message (body)
 import Hsm.Core.Zmq.Client (poll, runClient)
-import Hsm.GPIO (GPIO, GPIOEffect, runGPIO, toggle)
+import Hsm.GPIO qualified as G
 import Hsm.Status.Error (Error(Error))
 import Streamly.Data.Fold qualified as S (drain)
 import Streamly.Data.Stream qualified as S (Stream, fold, mapM)
@@ -24,8 +25,8 @@ import System.IO.Echo (withoutInputEcho)
 
 data Env = Env
   { name :: Text
-  , gpioOk :: GPIO
-  , gpioError :: GPIO
+  , gpioOk :: G.GPIO
+  , gpioError :: G.GPIO
   , period :: Word
   , subEps :: [Text]
   , topics :: [Text]
@@ -60,16 +61,17 @@ stateError :: F.FsmState [ByteString] Bool Env ()
 stateError = F.FsmState "error" $ \errs _ _ -> result False stateError errs
 
 handle ::
-     (GPIOEffect Bool :> es, Log :> es, Reader Env :> es)
+     (Concurrent :> es, G.GPIOEffect Bool :> es, Log :> es, Reader Env :> es)
   => S.Stream (Eff es) Bool
   -> Eff es ()
 handle = S.fold S.drain . S.mapM handler
   where
+    sleep = asks period >>= threadDelay . fromIntegral
     handler sta = do
-      env <- ask @Env
-      toggle False sta [env.period, env.period, 0]
+      G.setPins G.active sta >> sleep
+      G.setPins G.inactive sta >> sleep
 
-mapper :: Env -> Bool -> Set GPIO
+mapper :: Env -> Bool -> Set G.GPIO
 mapper env True = singleton env.gpioOk
 mapper env False = singleton env.gpioError
 
@@ -80,7 +82,8 @@ main =
   launch "status" withoutInputEcho $ \env logger level ->
     (poll & F.fsm @_ @_ @Env @() & handle)
       & runClient @Env
-      & runGPIO (mapper env)
+      & G.runGPIO @Env (mapper env)
+      & runConcurrent
       & evalState ()
       & evalState stateOk
       & runLog env.name logger level