Moves commonly used `bracket` combinators into separate module

5 files changed, 38 insertions, 10 deletions

diff --git a/hsm-cam/Hsm/Cam.hs b/hsm-cam/Hsm/Cam.hs
index c82cdd7..fe17057 100644
--- a/hsm-cam/Hsm/Cam.hs
+++ b/hsm-cam/Hsm/Cam.hs
@@ -44,6 +44,7 @@ import Hsm.Cam.FFI
   , stopCamera
   , stopCameraManager
   )
+import Hsm.Core.Bracket (bracketConst, bracketLiftIO_)
 import Hsm.Log (Log, Severity(Attention, Info, Trace), getLevel, logMsg, makeLoggerIO)
 import MMAP (mapShared, mkMmapFlags, mmap, munmap, protRead)
 import System.Directory (doesFileExist, removeFile)
@@ -127,8 +128,6 @@ runCam action = do
     . bracketLiftIO_ createRequest (return ())
     . bracket mapDmaBuffer unmapDmaBuffer $ \dmaBuffer -> evalStaticRep (Cam Rep {..}) action
   where
-    bracketConst alloc dealloc = bracket alloc dealloc . const
-    bracketLiftIO_ alloc dealloc = bracket_ (liftIO alloc) (liftIO dealloc)
     loggerAlloc = do
       logMsg @"cam" Info "Registering FFI logger"
       loggerIO <- makeLoggerIO @"cam"
diff --git a/hsm-cam/hsm-cam.cabal b/hsm-cam/hsm-cam.cabal
index 5c06ea7..fe767cb 100644
--- a/hsm-cam/hsm-cam.cabal
+++ b/hsm-cam/hsm-cam.cabal
@@ -13,6 +13,7 @@ library
     , directory
     , effectful-core
     , effectful-plugin
+    , hsm-core
     , hsm-log
     , JuicyPixels
     , monad-loops
@@ -44,6 +45,7 @@ executable test-cam
     , directory
     , effectful-core
     , effectful-plugin
+    , hsm-core
     , hsm-log
     , JuicyPixels
     , monad-loops
diff --git a/hsm-core/Hsm/Core/Bracket.hs b/hsm-core/Hsm/Core/Bracket.hs
new file mode 100644
index 0000000..f666d86
--- /dev/null
+++ b/hsm-core/Hsm/Core/Bracket.hs
@@ -0,0 +1,23 @@
+-- Resource management combinators for safe acquisition/release patterns.
+-- Provides specialized bracket variants for common scenarios.
+module Hsm.Core.Bracket
+  ( bracketConst
+  , bracketCont
+  , bracketLiftIO_
+  ) where
+
+import Control.Monad.Trans.Cont (Cont, cont)
+import Effectful (Eff, IOE, (:>), liftIO)
+import Effectful.Exception (bracket, bracket_)
+
+-- Ignores allocated resource in the action
+bracketConst :: Eff es a -> (a -> Eff es b) -> Eff es c -> Eff es c
+bracketConst alloc dealloc = bracket alloc dealloc . const
+
+-- Continuation-passing style integration
+bracketCont :: Eff es a -> (a -> Eff es b) -> Cont (Eff es c) a
+bracketCont alloc dealloc = cont $ bracket alloc dealloc
+
+-- Lifts IO operations into Effectful brackets
+bracketLiftIO_ :: IOE :> es => IO a -> IO b -> Eff es c -> Eff es c
+bracketLiftIO_ alloc dealloc = bracket_ (liftIO alloc) $ liftIO dealloc
diff --git a/hsm-core/hsm-core.cabal b/hsm-core/hsm-core.cabal
index 856a359..67a63e2 100644
--- a/hsm-core/hsm-core.cabal
+++ b/hsm-core/hsm-core.cabal
@@ -3,12 +3,16 @@ author:        Paul Oliver <contact@pauloliver.dev>
 name:          hsm-core
 version:       0.1.0.0
 
-
 library
   build-depends:
     , base
+    , effectful-core
     , template-haskell
+    , transformers
 
   default-language: GHC2024
-  exposed-modules:  Hsm.Core.Serial
+  exposed-modules:
+    Hsm.Core.Bracket
+    Hsm.Core.Serial
+
   ghc-options:      -O2 -Wall -Werror -Wno-star-is-type -Wunused-packages
diff --git a/hsm-gpio/Hsm/GPIO.hs b/hsm-gpio/Hsm/GPIO.hs
index 0f320a1..8f3115d 100644
--- a/hsm-gpio/Hsm/GPIO.hs
+++ b/hsm-gpio/Hsm/GPIO.hs
@@ -11,7 +11,7 @@ module Hsm.GPIO
   ) where
 
 import Control.Monad (forM_, void)
-import Control.Monad.Trans.Cont (cont, evalCont)
+import Control.Monad.Trans.Cont (evalCont)
 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_)
@@ -19,6 +19,7 @@ import Effectful.Exception (bracket)
 import Foreign.C.String (withCString)
 import Foreign.C.Types (CSize(CSize), CUInt)
 import Foreign.Ptr (Ptr)
+import Hsm.Core.Bracket (bracketCont)
 import Hsm.Core.Serial (makeSerial)
 import Hsm.GPIO.FFI
   ( LineRequest
@@ -78,7 +79,6 @@ setAllPins lineValue = do
 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
   where
-    contBracket alloc dealloc = cont $ bracket alloc dealloc
     chipPath = "/dev/gpiochip0"
     chipAlloc = do
       logMsg Info $ "Opening GPIO chip " <> chipPath
@@ -118,10 +118,10 @@ runGPIO consumer action = bracket lineRequestAlloc lineRequestDealloc $ \lineReq
     lineRequestAlloc = do
       logMsg Info "Allocating line request"
       evalCont $ do
-        chip <- contBracket chipAlloc chipDealloc
-        lineSettings <- contBracket lineSettingsAlloc lineSettingsDealloc
-        lineConfig <- contBracket (lineConfigAlloc lineSettings) lineConfigDealloc
-        requestConfig <- contBracket requestConfigAlloc requestConfigDealloc
+        chip <- bracketCont chipAlloc chipDealloc
+        lineSettings <- bracketCont lineSettingsAlloc lineSettingsDealloc
+        lineConfig <- bracketCont (lineConfigAlloc lineSettings) lineConfigDealloc
+        requestConfig <- bracketCont requestConfigAlloc requestConfigDealloc
         return . liftIO $ chipRequestLines chip requestConfig lineConfig
     lineRequestDealloc lineRequest = do
       logMsg Info "Releasing line request"