From ac5a85abac1a47645713d3b7539fccb1b744dd85 Mon Sep 17 00:00:00 2001
From: Paul Oliver <contact@pauloliver.dev>
Date: Thu, 11 Sep 2025 03:04:36 +0000
Subject: Adds `hsm-drive`

---
 hsm-gpio/Hsm/GPIO.hs | 18 ++++++++++++++----
 1 file changed, 14 insertions(+), 4 deletions(-)

(limited to 'hsm-gpio/Hsm')

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
-- 
cgit v1.2.1