aboutsummaryrefslogtreecommitdiff
path: root/hsm-gpio/Hsm
diff options
context:
space:
mode:
Diffstat (limited to 'hsm-gpio/Hsm')
-rw-r--r--hsm-gpio/Hsm/GPIO.hs18
1 files changed, 14 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