diff options
Diffstat (limited to 'hsm-dummy-gradient/Main.hs')
-rw-r--r-- | hsm-dummy-gradient/Main.hs | 48 |
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 |