aboutsummaryrefslogtreecommitdiff
path: root/hsm-dummy-gradient
diff options
context:
space:
mode:
Diffstat (limited to 'hsm-dummy-gradient')
-rw-r--r--hsm-dummy-gradient/Main.hs48
-rw-r--r--hsm-dummy-gradient/hsm-dummy-gradient.cabal24
2 files changed, 72 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
diff --git a/hsm-dummy-gradient/hsm-dummy-gradient.cabal b/hsm-dummy-gradient/hsm-dummy-gradient.cabal
new file mode 100644
index 0000000..1f895a0
--- /dev/null
+++ b/hsm-dummy-gradient/hsm-dummy-gradient.cabal
@@ -0,0 +1,24 @@
+cabal-version: 3.4
+author: Paul Oliver
+build-type: Simple
+maintainer: contact@pauloliver.dev
+name: hsm-dummy-gradient
+version: 0.1.0.0
+
+executable dummy-gradient
+ build-depends:
+ , base
+ , echo
+ , effectful
+ , hsm-core
+ , hsm-pwm
+ , log-effectful
+ , 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