diff options
Diffstat (limited to 'hsm-pwm/Hsm/PWM.hs')
-rw-r--r-- | hsm-pwm/Hsm/PWM.hs | 29 |
1 files changed, 9 insertions, 20 deletions
diff --git a/hsm-pwm/Hsm/PWM.hs b/hsm-pwm/Hsm/PWM.hs index 9a4fe5c..2fd5955 100644 --- a/hsm-pwm/Hsm/PWM.hs +++ b/hsm-pwm/Hsm/PWM.hs @@ -12,26 +12,20 @@ -- - SysFS Reference: https://forums.raspberrypi.com/viewtopic.php?t=359251 -- - UDEV Setup: https://forums.raspberrypi.com/viewtopic.php?t=316514 module Hsm.PWM - ( PWMChannel (..) + ( PWMChannel(..) , PWM , setCycleDuration , runPWM - ) -where + ) where import Control.Concurrent (threadDelay) import Control.Monad (forM_) import Control.Monad.Loops (untilM_) -import Effectful (Dispatch (Static), DispatchOf, Eff, IOE, liftIO, (:>)) -import Effectful.Dispatch.Static - ( SideEffects (WithSideEffects) - , StaticRep - , evalStaticRep - , unsafeEff_ - ) +import Effectful (Dispatch(Static), DispatchOf, Eff, IOE, (:>), liftIO) +import Effectful.Dispatch.Static (SideEffects(WithSideEffects), StaticRep, evalStaticRep, unsafeEff_) import Effectful.Exception (bracket_) import Hsm.Core.Serial (makeSerial) -import Hsm.Log (Log, Severity (Info, Trace), logMsg) +import Hsm.Log (Log, Severity(Info, Trace), logMsg) import System.FilePath ((</>)) import System.Posix.Files (fileAccess) @@ -41,8 +35,8 @@ data PWM (a :: * -> *) (b :: *) type instance DispatchOf PWM = Static WithSideEffects -newtype instance StaticRep PWM - = PWM () +newtype instance StaticRep PWM = + PWM () chipPath :: FilePath chipPath = "/sys/class/pwm/pwmchip0" @@ -83,17 +77,12 @@ setDutyCycle channel dutyCycle = do -- 2. Update period -- 3. Set default 50% duty cycle -- 4. Re-enable output -setCycleDuration - :: (Log "pwm" :> es, PWM :> es) => PWMChannel -> Int -> Eff es () +setCycleDuration :: (Log "pwm" :> es, PWM :> es) => PWMChannel -> Int -> Eff es () setCycleDuration channel 0 = do logMsg Trace $ "Halting PWM signals on channel " <> show channel setEnable channel False setCycleDuration channel cycleDuration = do - logMsg Trace $ - "Setting cycle duration on channel " - <> show channel - <> " to " - <> show cycleDuration + logMsg Trace $ "Setting cycle duration on channel " <> show channel <> " to " <> show cycleDuration setEnable channel False setDutyCycle channel 0 setPeriod channel cycleDuration |