aboutsummaryrefslogtreecommitdiff
path: root/hsm-dummy-blinker/Main.hs
blob: 88b7b5fef06bde550b9bc2853f149b8af98f372a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
{-# 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" $ \_ _ sta ->
    F.FsmOutput
      (Just $ F.FsmResult sta False stateOff)
      [(LogInfo, "Turning on blinker")]

stateOff :: F.FsmState () Bool Env Bool
stateOff =
  F.FsmState "off" $ \_ _ sta ->
    F.FsmOutput
      (Just $ F.FsmResult sta True stateOn)
      [(LogInfo, "Turning off blinker")]

handle ::
     (GPIOEffect () :> es, Log :> es, Reader Env :> es)
  => S.Stream (Eff es) Bool
  -> Eff es ()
handle = S.fold S.drain . S.mapM handler
  where
    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