Adds drive service and test app

1 files changed, 15 insertions, 8 deletions

diff --git a/hsm-pwm/Hsm/PWM.hs b/hsm-pwm/Hsm/PWM.hs
index ad4c052..6b2a882 100644
--- a/hsm-pwm/Hsm/PWM.hs
+++ b/hsm-pwm/Hsm/PWM.hs
@@ -3,7 +3,7 @@
 module Hsm.PWM
   ( PWMHandle
   , PWMChannel(PWM2, PWM3)
-  , setFrequency
+  , setCycleDuration
   , allocatePWM
   ) where
 
@@ -78,16 +78,23 @@ setDutyCycle channel dutyCycle = do
   where
     (_, _, dutyCyclePath) = channelPaths channel
 
-setFrequency :: PWMHandle -> PWMChannel -> Int -> IO ()
-setFrequency _ channel frequency = do
+setCycleDuration :: PWMHandle -> PWMChannel -> Int -> IO ()
+setCycleDuration _ channel 0 = do
+  logMsg $ "Halting PWM signals on channel " <> pack (show channel)
+  setEnable channel False
+setCycleDuration _ channel cycleDuration = do
   logMsg
-    $ "Setting frequency on channel "
+    $ "Setting cycle duration on channel "
         <> pack (show channel)
         <> " to "
-        <> pack (show frequency)
+        <> pack (show cycleDuration)
   setEnable channel False
-  setPeriod channel frequency
-  setDutyCycle channel $ frequency `div` 2
+  -- Sets the duty cycle to zero before updating the period. This prevents
+  -- `Invalid argument` errors, as the period must never be set to a value
+  -- smaller than the duty cycle.
+  setDutyCycle channel 0
+  setPeriod channel cycleDuration
+  setDutyCycle channel $ cycleDuration `div` 2
   setEnable channel True
 
 allocatePWM :: Region -> (PWMChannel -> Int) -> IO PWMHandle
@@ -118,7 +125,7 @@ allocatePWM region mapper = alloc_ region acquire $ const release
       waitWritable enablePath
       waitWritable periodPath
       waitWritable dutyCyclePath
-      setFrequency PWMHandle channel $ mapper channel
+      setCycleDuration PWMHandle channel $ mapper channel
     acquire = do
       waitWritable exportPath
       waitWritable unexportPath