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
67
|
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
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, 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 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 :: [G.GPIO]
, period :: Word
}
$(deriveFromYaml ''Env)
stateOn :: F.FsmState () G.LineValue Env G.LineValue
stateOn =
F.FsmState "on" $ \_ _ sta ->
F.FsmOutput
(Just $ F.FsmResult sta G.inactive stateOff)
[(LogInfo, "Turning on blinker")]
stateOff :: F.FsmState () G.LineValue Env G.LineValue
stateOff =
F.FsmState "off" $ \_ _ sta ->
F.FsmOutput
(Just $ F.FsmResult sta G.active stateOn)
[(LogInfo, "Turning off blinker")]
handle ::
(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
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 @G.LineValue & handle)
& G.runGPIO @Env (\() -> fromList env.gpio)
& runConcurrent
& evalState G.inactive
& evalState stateOff
& runLog env.name logger level
& runReader env
& runResource
& runEff
|
