Adds PWM effect and dummy gradient service

1 files changed, 48 insertions, 0 deletions

diff --git a/hsm-dummy-gradient/Main.hs b/hsm-dummy-gradient/Main.hs
new file mode 100644
index 0000000..05ead49
--- /dev/null
+++ b/hsm-dummy-gradient/Main.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+import Control.Monad (forM_, forever)
+import Data.Function ((&))
+import Data.Text (Text)
+import Effectful (Eff, (:>), runEff)
+import Effectful.Concurrent (Concurrent, runConcurrent, threadDelay)
+import Effectful.Log (Log, runLog)
+import Effectful.Reader.Static (Reader, ask, runReader)
+import Hsm.Core.App (launch)
+import Hsm.Core.Env (deriveFromYaml)
+import Hsm.PWM (PWMEffect, dutyCycle, runPWM, withPWM)
+import System.IO.Echo (withoutInputEcho)
+
+data Env = Env
+  { name :: Text
+  , pwmPeriod :: Word
+  , stepDelay :: Word
+  }
+
+$(deriveFromYaml ''Env)
+
+pwmLoop ::
+     (Concurrent :> es, Log :> es, PWMEffect :> es, Reader Env :> es)
+  => Eff es ()
+pwmLoop = do
+  env <- ask @Env
+  withPWM
+    $ forever
+    $ forM_ [0,env.pwmPeriod `div` 10 .. env.pwmPeriod]
+    $ \dc -> do
+        threadDelay $ fromIntegral env.stepDelay
+        dutyCycle dc
+
+-- Dummy gradient service:
+-- Simple test for PWM control. Increases duty-cycle gradually on default PWM
+-- channel.
+main :: IO ()
+main =
+  launch @Env "dummy-gradient" withoutInputEcho $ \env logger level ->
+    pwmLoop
+      & runPWM @Env
+      & runConcurrent
+      & runLog env.name logger level
+      & runReader env
+      & runEff