diff options
Diffstat (limited to 'hsm-gpio/Hsm/GPIO.hs')
| -rw-r--r-- | hsm-gpio/Hsm/GPIO.hs | 39 |
1 files changed, 11 insertions, 28 deletions
diff --git a/hsm-gpio/Hsm/GPIO.hs b/hsm-gpio/Hsm/GPIO.hs index 0e4e2e5..4786379 100644 --- a/hsm-gpio/Hsm/GPIO.hs +++ b/hsm-gpio/Hsm/GPIO.hs @@ -3,28 +3,21 @@ {-# LANGUAGE TypeFamilies #-} module Hsm.GPIO - ( GPIOPin (..) + ( GPIOPin(..) , GPIO , setPins , setAllPins , runGPIO - ) -where + ) where import Control.Monad (forM_, void) import Data.Vector.Storable (fromList, replicate, unsafeWith) -import Effectful (Dispatch (Static), DispatchOf, Eff, IOE, liftIO, (:>)) -import Effectful.Dispatch.Static - ( SideEffects (WithSideEffects) - , StaticRep - , evalStaticRep - , getStaticRep - , unsafeEff_ - ) +import Effectful (Dispatch(Static), DispatchOf, Eff, IOE, (:>), liftIO) +import Effectful.Dispatch.Static (SideEffects(WithSideEffects), StaticRep, evalStaticRep, getStaticRep, unsafeEff_) import Effectful.Exception (bracket) import Effectful.Resource (Resource, allocateEff, releaseEff) import Foreign.C.String (withCString) -import Foreign.C.Types (CSize (CSize), CUInt) +import Foreign.C.Types (CSize(CSize), CUInt) import Foreign.Ptr (Ptr) import Hsm.Core.Serial (makeSerial) import Hsm.GPIO.FFI @@ -49,7 +42,7 @@ import Hsm.GPIO.FFI , requestConfigNew , requestConfigSetConsumer ) -import Hsm.Log (Log, Severity (Info, Trace), logMsg) +import Hsm.Log (Log, Severity(Info, Trace), logMsg) import Prelude hiding (replicate) $(makeSerial "GPIO" "Pin" "pinLine" ''CUInt $ [2 .. 17] <> [20 .. 27]) @@ -67,8 +60,8 @@ data GPIO (a :: * -> *) (b :: *) type instance DispatchOf GPIO = Static WithSideEffects -newtype instance StaticRep GPIO - = GPIO (Ptr LineRequest) +newtype instance StaticRep GPIO = + GPIO (Ptr LineRequest) setPins :: (GPIO :> es, Log "gpio" :> es) => [GPIOPin] -> LineValue -> Eff es () setPins pins lineValue = do @@ -80,14 +73,9 @@ setAllPins :: (GPIO :> es, Log "gpio" :> es) => LineValue -> Eff es () setAllPins lineValue = do GPIO lineRequest <- getStaticRep logMsg Trace $ "Setting all pins " <> show allPins <> " to " <> show lineValue - unsafeEff_ . unsafeWith (replicate pinCount lineValue) $ - void . lineRequestSetValues lineRequest + unsafeEff_ . unsafeWith (replicate pinCount lineValue) $ void . lineRequestSetValues lineRequest -runGPIO - :: (IOE :> es, Log "gpio" :> es, Resource :> es) - => String - -> Eff (GPIO : es) a - -> Eff es a +runGPIO :: (IOE :> es, Log "gpio" :> es, Resource :> es) => String -> Eff (GPIO : es) a -> Eff es a runGPIO consumer action = do (chipKey, chip) <- chipBracket (lineSettingsKey, lineSettings) <- lineSettingsBracket @@ -128,12 +116,7 @@ runGPIO consumer action = do logMsg Info "Allocating line config" logMsg Info $ "With GPIO pins " <> show allPins lineConfig <- liftIO lineConfigNew - liftIO . void . unsafeWith (fromList allLines) $ \pinsVector -> - lineConfigAddLineSettings - lineConfig - pinsVector - (CSize $ fromIntegral pinCount) - lineSettings + liftIO . void . unsafeWith (fromList allLines) $ \pinsVector -> lineConfigAddLineSettings lineConfig pinsVector (CSize $ fromIntegral pinCount) lineSettings return lineConfig lineConfigDealloc lineConfig = do logMsg Info "Freeing line config" |