aboutsummaryrefslogtreecommitdiff
path: root/hsm-dummy-blinker/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'hsm-dummy-blinker/Main.hs')
-rw-r--r--hsm-dummy-blinker/Main.hs30
1 files changed, 16 insertions, 14 deletions
diff --git a/hsm-dummy-blinker/Main.hs b/hsm-dummy-blinker/Main.hs
index 5c7cb13..779bf6c 100644
--- a/hsm-dummy-blinker/Main.hs
+++ b/hsm-dummy-blinker/Main.hs
@@ -6,58 +6,60 @@ import Data.Function ((&))
import Data.Set (fromList)
import Data.Text (Text)
import Effectful (Eff, (:>), runEff)
+import Effectful.Concurrent (Concurrent, runConcurrent, threadDelay)
import Effectful.Log (Log, LogLevel(LogInfo), 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)
import Hsm.Core.Env (deriveFromYaml)
import Hsm.Core.Fsm qualified as F
-import Hsm.GPIO (GPIO, GPIOEffect, runGPIO, toggle)
+import Hsm.GPIO qualified as G
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]
+ , gpio :: [G.GPIO]
, period :: Word
}
$(deriveFromYaml ''Env)
-stateOn :: F.FsmState () Bool Env Bool
+stateOn :: F.FsmState () G.LineValue Env G.LineValue
stateOn =
F.FsmState "on" $ \_ _ sta ->
F.FsmOutput
- (Just $ F.FsmResult sta False stateOff)
+ (Just $ F.FsmResult sta G.inactive stateOff)
[(LogInfo, "Turning on blinker")]
-stateOff :: F.FsmState () Bool Env Bool
+stateOff :: F.FsmState () G.LineValue Env G.LineValue
stateOff =
F.FsmState "off" $ \_ _ sta ->
F.FsmOutput
- (Just $ F.FsmResult sta True stateOn)
+ (Just $ F.FsmResult sta G.active stateOn)
[(LogInfo, "Turning off blinker")]
handle ::
- (GPIOEffect () :> es, Log :> es, Reader Env :> es)
- => S.Stream (Eff es) Bool
+ (Concurrent :> es, G.GPIOEffect () :> es, Log :> es, Reader Env :> es)
+ => S.Stream (Eff es) G.LineValue
-> Eff es ()
handle = S.fold S.drain . S.mapM handler
where
handler sta = do
- env <- ask @Env
- toggle sta () [env.period, 0]
+ G.setAllPins @() sta
+ asks period >>= threadDelay . fromIntegral
-- Dummy Blinker Service: A proof of concept that toggles a GPIO pin on and
-- off at a set interval.
main :: IO ()
main =
launch @Env "dummy-blinker" withoutInputEcho $ \env logger level ->
- (S.repeat () & F.fsm @_ @_ @Env @Bool & handle)
- & runGPIO (\() -> fromList env.gpio)
- & evalState False
+ (S.repeat () & F.fsm @_ @_ @Env @G.LineValue & handle)
+ & G.runGPIO @Env (\() -> fromList env.gpio)
+ & runConcurrent
+ & evalState G.inactive
& evalState stateOff
& runLog env.name logger level
& runReader env