[add] interpreters for the Except effect in exception handling at the 'IO' layer.

cabal.project

@@ -5,7 +5,7 @@ packages:
 source-repository-package
     type: git
     location: https://github.com/sayo-hs/data-effects
-    tag: 9f406cf246272e7d07310f1768319ccec317383d
+    tag: 283f367b1a93b43f6fb4aa57283ced687aa96d81
     subdir: data-effects-core
     subdir: data-effects-th
     subdir: data-effects

heftia-effects/src/Control/Effect/Handler/Heftia/Except.hs

@@ -22,15 +22,22 @@ import Control.Effect.Hefty (
     interposeK,
     interposeT,
     interpretK,
+    interpretRec,
     interpretRecH,
     interpretT,
  )
+import Control.Exception (Exception)
 import Control.Monad.Freer (MonadFreer)
 import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
 import Data.Effect.Except (Catch (Catch), LThrow, Throw (Throw))
 import Data.Effect.HFunctor (HFunctor)
+import Data.Effect.Unlift (UnliftIO)
 import Data.Function ((&))
+import Data.Hefty.Extensible (ForallHFunctor, type (<<|), type (<|))
+import Data.Hefty.Extensible qualified as Ex
 import Data.Hefty.Union (Member, Union)
+import UnliftIO (throwIO)
+import UnliftIO qualified as IO
 
 -- | Interpret the "Data.Effect.Except" effects using the 'ExceptT' monad transformer internally.
 runExcept ::
@@ -112,3 +119,17 @@ runThrowK ::
     Eff u fr '[] (LThrow e ': r) a ->
     Eff u fr '[] r (Either e a)
 runThrowK = interpretK (pure . Right) \_ (Throw e) -> pure $ Left e
+
+runThrowIO ::
+    forall e eh ef fr c.
+    (MonadFreer c fr, IO <| ef, ForallHFunctor eh, Exception e) =>
+    Ex.Eff fr eh (LThrow e ': ef) ~> Ex.Eff fr eh ef
+runThrowIO = interpretRec \(Throw e) -> throwIO e
+{-# INLINE runThrowIO #-}
+
+runCatchIO ::
+    forall e eh ef fr c.
+    (MonadFreer c fr, UnliftIO <<| eh, IO <| ef, ForallHFunctor eh, Exception e) =>
+    Ex.Eff fr (Catch e ': eh) ef ~> Ex.Eff fr eh ef
+runCatchIO = interpretRecH \(Catch action hdl) -> IO.catch action hdl
+{-# INLINE runCatchIO #-}

heftia/src/Data/Hefty/Extensible.hs

@@ -20,6 +20,8 @@ module Data.Hefty.Extensible (
     Forall,
 ) where
 
+import Control.Effect.Free qualified as E
+import Control.Effect.Hefty qualified as E
 import Data.Effect (SigClass)
 import Data.Effect.HFunctor (HFunctor, hfmap)
 import Data.Extensible (Forall, Match (Match), htabulateFor, match)
@@ -125,3 +127,6 @@ type UH eh = Union.UH ExtensibleUnion eh
 
 type S ef = Union.S ExtensibleUnion ef
 type SH eh = Union.SH ExtensibleUnion eh
+
+type Eff fr eh ef = E.Eff ExtensibleUnion fr eh ef
+type EffF fr es = E.EffF ExtensibleUnion fr es