diff options
Diffstat (limited to 'hsm-dummy-blinker')
| -rw-r--r-- | hsm-dummy-blinker/Main.hs | 71 | ||||
| -rw-r--r-- | hsm-dummy-blinker/hsm-dummy-blinker.cabal | 27 | 
2 files changed, 98 insertions, 0 deletions
| 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 diff --git a/hsm-dummy-blinker/hsm-dummy-blinker.cabal b/hsm-dummy-blinker/hsm-dummy-blinker.cabal new file mode 100644 index 0000000..670252e --- /dev/null +++ b/hsm-dummy-blinker/hsm-dummy-blinker.cabal @@ -0,0 +1,27 @@ +cabal-version: 3.4 +author:        Paul Oliver +build-type:    Simple +maintainer:    contact@pauloliver.dev +name:          hsm-dummy-blinker +version:       0.1.0.0 + +executable dummy-blinker +  build-depends: +    , base +    , containers +    , echo +    , effectful-core +    , hsm-core +    , hsm-gpio +    , log-effectful +    , resourcet-effectful +    , streamly-core +    , text + +  main-is:          Main.hs +  ghc-options:      -Wall -Wunused-packages + +  if !arch(x86_64) +    ghc-options: -optl=-mno-fix-cortex-a53-835769 + +  default-language: GHC2021 | 
