From e1fa79eb713c249055fb23fcc6684a94f77d8368 Mon Sep 17 00:00:00 2001
From: Paul Oliver <contact@pauloliver.dev>
Date: Tue, 14 Jan 2025 15:42:46 -0800
Subject: Adds GPIO effect and dummy blinker service

---
 hsm-dummy-blinker/Main.hs | 71 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 71 insertions(+)
 create mode 100644 hsm-dummy-blinker/Main.hs

(limited to 'hsm-dummy-blinker/Main.hs')

diff --git a/hsm-dummy-blinker/Main.hs b/hsm-dummy-blinker/Main.hs
new file mode 100644
index 0000000..cfc6654
--- /dev/null
+++ b/hsm-dummy-blinker/Main.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+import Data.Function ((&))
+import Data.Set (fromList)
+import Data.Text (Text)
+import Effectful (Eff, (:>), runEff)
+import Effectful.Log (Log, LogLevel(LogInfo), runLog)
+import Effectful.Reader.Static (Reader, ask, 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.GPIO (GPIO, GPIOEffect, runGPIO, toggle)
+import Streamly.Data.Fold qualified as S (drain)
+import Streamly.Data.Stream qualified as S (Stream, fold, mapM, repeat)
+import System.IO.Echo (withoutInputEcho)
+
+data Env = Env
+  { name :: Text
+  , gpio :: [GPIO]
+  , period :: Int
+  }
+
+$(deriveFromYaml ''Env)
+
+stateOn :: F.FsmState () Bool Env Bool
+stateOn = F.FsmState "on" action
+  where
+    action :: () -> Env -> Bool -> F.FsmOutput () Bool Env Bool
+    action _ _ sta =
+      F.FsmOutput
+        (Just $ F.FsmResult sta False stateOff)
+        [(LogInfo, "Turning on blinker")]
+
+stateOff :: F.FsmState () Bool Env Bool
+stateOff = F.FsmState "off" action
+  where
+    action :: () -> Env -> Bool -> F.FsmOutput () Bool Env Bool
+    action _ _ sta =
+      F.FsmOutput
+        (Just $ F.FsmResult sta True stateOn)
+        [(LogInfo, "Turning off blinker")]
+
+handle ::
+     forall es. (GPIOEffect () :> es, Log :> es, Reader Env :> es)
+  => S.Stream (Eff es) Bool
+  -> Eff es ()
+handle = S.fold S.drain . S.mapM handler
+  where
+    handler :: Bool -> Eff es ()
+    handler sta = do
+      env <- ask @Env
+      toggle sta () [env.period, 0]
+
+-- Dummy blinker service:
+-- Proof of concept. This service toggles a GPIO on and off using a set
+-- period.
+main :: IO ()
+main =
+  launch @Env "dummy-blinker" withoutInputEcho $ \env logger level ->
+    (S.repeat () & F.fsm @_ @_ @Env @Bool & handle)
+      & runGPIO (\() -> fromList env.gpio)
+      & evalState False
+      & evalState stateOff
+      & runLog env.name logger level
+      & runReader env
+      & runResource
+      & runEff
-- 
cgit v1.2.1