diff options
Diffstat (limited to 'hsm-gpio')
| -rw-r--r-- | hsm-gpio/Hsm/GPIO.hs | 18 | ||||
| -rw-r--r-- | hsm-gpio/hsm-gpio.cabal | 1 |
2 files changed, 15 insertions, 4 deletions
diff --git a/hsm-gpio/Hsm/GPIO.hs b/hsm-gpio/Hsm/GPIO.hs index 31b73d9..c182cf1 100644 --- a/hsm-gpio/Hsm/GPIO.hs +++ b/hsm-gpio/Hsm/GPIO.hs @@ -3,7 +3,9 @@ {-# LANGUAGE TypeFamilies #-} module Hsm.GPIO - ( GPIOPin (..) + ( active + , inactive + , GPIOPin (..) , GPIO , setPins , setAllPins @@ -13,18 +15,21 @@ where import Control.Monad (forM_, void) import Control.Monad.Trans.Cont (evalCont) +import Data.Proxy (Proxy (Proxy)) 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.Exception (bracket) +import Effectful.Exception (bracket, finally) import Foreign.C.String (withCString) import Foreign.C.Types (CSize (CSize), CUInt) import Foreign.Ptr (Ptr) +import GHC.TypeLits (KnownSymbol, symbolVal) import Hsm.Core.Bracket (bracketCont) import Hsm.Core.Serial (makeSerial) import Hsm.GPIO.FFI ( LineRequest , LineValue + , active , chipClose , chipOpen , chipRequestLines @@ -77,9 +82,14 @@ setAllPins lineValue = do logMsg Trace $ "Setting all pins " <> show allPins <> " to " <> show lineValue unsafeEff_ . unsafeWith (replicate pinCount lineValue) $ void . lineRequestSetValues lineRequest -runGPIO :: (IOE :> es, Log "gpio" :> es) => String -> Eff (GPIO : es) a -> Eff es a -runGPIO consumer action = bracket lineRequestAlloc lineRequestDealloc $ \lineRequest -> evalStaticRep (GPIO lineRequest) action +runGPIO + :: forall c es a + . (IOE :> es, KnownSymbol c, Log "gpio" :> es) + => Eff (GPIO : es) a + -> Eff es a +runGPIO action = bracket lineRequestAlloc lineRequestDealloc $ \lineRequest -> evalStaticRep (GPIO lineRequest) . finally action $ setAllPins inactive where + consumer = symbolVal $ Proxy @c chipPath = "/dev/gpiochip0" chipAlloc = do logMsg Info $ "Opening GPIO chip " <> chipPath diff --git a/hsm-gpio/hsm-gpio.cabal b/hsm-gpio/hsm-gpio.cabal index ba538db..75e22f8 100644 --- a/hsm-gpio/hsm-gpio.cabal +++ b/hsm-gpio/hsm-gpio.cabal @@ -15,6 +15,7 @@ library default-language: GHC2024 exposed-modules: Hsm.GPIO + extra-libraries: gpiod ghc-options: -O2 -Wall -Werror -Wno-star-is-type -Wunused-packages -ddump-splices -fplugin=Effectful.Plugin |