{-# LANGUAGE CPP #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RecordWildCards #-}

module Bluefin.Internal.Exception where

import Bluefin.Internal hiding (UnsafeMkEff, b)
import Bluefin.Internal.CloneableHandle (app, (:~>))
import Bluefin.Internal.Exception.Scoped (InFlight)
import Bluefin.Internal.Exception.Scoped qualified as SE
import Bluefin.Internal.OneWayCoercible
  ( Generic,
    OneWayCoercible (oneWayCoercibleImpl),
    gOneWayCoercible,
    oneWayCoerce,
    unsafeOneWayCoercible,
  )
import Control.Exception qualified as CE
import Data.Proxy (Proxy)

data HandledKey ret = forall ex. MkHandledKey !(SE.Exception ex) (ex -> ret)

checkHandledKey :: HandledKey ret -> InFlight -> Maybe ret
checkHandledKey :: forall ret. HandledKey ret -> InFlight -> Maybe ret
checkHandledKey (MkHandledKey Exception ex
k ex -> ret
handler) InFlight
inflight =
  ex -> ret
handler (ex -> ret) -> Maybe ex -> Maybe ret
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exception ex -> InFlight -> Maybe ex
forall e. Exception e -> InFlight -> Maybe e
SE.checkException Exception ex
k InFlight
inflight

instance Functor HandledKey where
  fmap :: forall a b. (a -> b) -> HandledKey a -> HandledKey b
fmap a -> b
f (MkHandledKey Exception ex
ex ex -> a
r) = Exception ex -> (ex -> b) -> HandledKey b
forall ret ex. Exception ex -> (ex -> ret) -> HandledKey ret
MkHandledKey Exception ex
ex ((a -> b) -> (ex -> a) -> ex -> b
forall a b. (a -> b) -> (ex -> a) -> ex -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ex -> a
r)

runBodyWithHandlers ::
  ( [HandledKey (r -> Eff es a)],
    BracketBase b r a es
  ) ->
  Eff es a
runBodyWithHandlers :: forall r (es :: Effects) a b.
([HandledKey (r -> Eff es a)], BracketBase b r a es) -> Eff es a
runBodyWithHandlers ([HandledKey (r -> Eff es a)]
handledKeys, BracketBase b r a es
bb) =
  (forall (e :: Effects). IOE e -> Eff (e :& es) a) -> Eff es a
forall (es :: Effects) a.
(forall (e :: Effects). IOE e -> Eff (e :& es) a) -> Eff es a
unsafeProvideIO ((forall (e :: Effects). IOE e -> Eff (e :& es) a) -> Eff es a)
-> (forall (e :: Effects). IOE e -> Eff (e :& es) a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \IOE e
io -> IOE e
-> ((forall {r}. Eff (e :& es) r -> IO r) -> IO a)
-> Eff (e :& es) a
forall (e :: Effects) (es :: Effects) a.
(e :> es) =>
IOE e -> ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
withEffToIO_ IOE e
io (((forall {r}. Eff (e :& es) r -> IO r) -> IO a)
 -> Eff (e :& es) a)
-> ((forall {r}. Eff (e :& es) r -> IO r) -> IO a)
-> Eff (e :& es) a
forall a b. (a -> b) -> a -> b
$ \forall {r}. Eff (e :& es) r -> IO r
runInIO -> do
    let MkBracketBase {Eff (e :& es) r
r -> Eff (e :& es) b
r -> Eff (e :& es) ()
r -> b -> Eff (e :& es) a
acquire :: Eff (e :& es) r
normalRelease :: r -> b -> Eff (e :& es) a
unknownExceptionRelease :: r -> Eff (e :& es) ()
body :: r -> Eff (e :& es) b
body :: forall bodyRes r a (es :: Effects).
BracketBase bodyRes r a es -> r -> Eff es bodyRes
unknownExceptionRelease :: forall bodyRes r a (es :: Effects).
BracketBase bodyRes r a es -> r -> Eff es ()
normalRelease :: forall bodyRes r a (es :: Effects).
BracketBase bodyRes r a es -> r -> bodyRes -> Eff es a
acquire :: forall bodyRes r a (es :: Effects).
BracketBase bodyRes r a es -> Eff es r
..} = BracketBase b r a es -> BracketBase b r a (e :& es)
forall (e :: Effects) (es :: Effects) b r a.
(e :> es) =>
BracketBase b r a e -> BracketBase b r a es
useImplBracketBase BracketBase b r a es
bb
    ((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
CE.mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
-> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
unmasked -> do
      r
resource <- Eff (e :& es) r -> IO r
forall {r}. Eff (e :& es) r -> IO r
runInIO Eff (e :& es) r
acquire
      Either SomeException b
eBodyRes <-
        (IO b -> IO (Either SomeException b)
forall e a. Exception e => IO a -> IO (Either e a)
CE.try (IO b -> IO (Either SomeException b))
-> (r -> IO b) -> r -> IO (Either SomeException b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO b -> IO b
forall a. IO a -> IO a
unmasked (IO b -> IO b) -> (r -> IO b) -> r -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (e :& es) b -> IO b
forall {r}. Eff (e :& es) r -> IO r
runInIO (Eff (e :& es) b -> IO b) -> (r -> Eff (e :& es) b) -> r -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> Eff (e :& es) b
body) r
resource
      Eff (e :& es) a -> IO a
forall {r}. Eff (e :& es) r -> IO r
runInIO (Eff (e :& es) a -> IO a) -> Eff (e :& es) a -> IO a
forall a b. (a -> b) -> a -> b
$ case Either SomeException b
eBodyRes of
        Right b
bodyRes -> r -> b -> Eff (e :& es) a
normalRelease r
resource b
bodyRes
        Left SomeException
e -> case SomeException -> Maybe InFlight
forall e. Exception e => SomeException -> Maybe e
CE.fromException SomeException
e Maybe InFlight
-> (InFlight -> Maybe (r -> Eff es a)) -> Maybe (r -> Eff es a)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [HandledKey (r -> Eff es a)] -> InFlight -> Maybe (r -> Eff es a)
forall a. [HandledKey a] -> InFlight -> Maybe a
findHandler [HandledKey (r -> Eff es a)]
handledKeys of
          Maybe (r -> Eff es a)
Nothing -> do
            r -> Eff (e :& es) ()
unknownExceptionRelease r
resource
            IOE e -> IO a -> Eff (e :& es) a
forall (e :: Effects) (es :: Effects) a.
(e :> es) =>
IOE e -> IO a -> Eff es a
effIO IOE e
io (SomeException -> IO a
forall e a. Exception e => e -> IO a
CE.throwIO SomeException
e)
          Just r -> Eff es a
handler -> Eff es a -> Eff (e :& es) a
forall (e :: Effects) (es :: Effects) r.
(e :> es) =>
Eff e r -> Eff es r
useImpl (r -> Eff es a
handler r
resource)
  where
    firstJust :: (t -> Maybe a) -> [t] -> Maybe a
firstJust t -> Maybe a
_ [] = Maybe a
forall a. Maybe a
Nothing
    firstJust t -> Maybe a
f (t
x : [t]
xs) = case t -> Maybe a
f t
x of
      Maybe a
Nothing -> (t -> Maybe a) -> [t] -> Maybe a
firstJust t -> Maybe a
f [t]
xs
      Just a
r -> a -> Maybe a
forall a. a -> Maybe a
Just a
r

    findHandler :: [HandledKey a] -> SE.InFlight -> Maybe a
    findHandler :: forall a. [HandledKey a] -> InFlight -> Maybe a
findHandler [HandledKey a]
hks InFlight
inflight = (HandledKey a -> Maybe a) -> [HandledKey a] -> Maybe a
forall {t} {a}. (t -> Maybe a) -> [t] -> Maybe a
firstJust ((HandledKey a -> InFlight -> Maybe a)
-> InFlight -> HandledKey a -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip HandledKey a -> InFlight -> Maybe a
forall ret. HandledKey ret -> InFlight -> Maybe ret
checkHandledKey InFlight
inflight) [HandledKey a]
hks

-- | To create a @MakeExceptions@ use 'catchWithResource' and the
-- @Applicative@-like functions that produce and combine them.
newtype MakeExceptions r a h es
  = MkMakeExceptions (Eff es (HandlerUnwrapped r a h es))

data HandlerUnwrapped r a h es
  = MkHandlerUnwrapped
      [HandledKey (r -> Eff es a)]
      (forall b. (forall e. h e -> Eff (e :& es) b) -> Eff es b)

instance (Handle h) => Handle (MakeExceptions r a h) where
  handleImpl :: HandleD (MakeExceptions r a h)
handleImpl = HandleD (MakeExceptions r a h)
forall (h :: Effects -> *).
(forall (e :: Effects) (es :: Effects).
 (e :> es) =>
 OneWayCoercible (h e) (h es)) =>
HandleD h
handleOneWayCoercible

instance (Handle h) => Handle (HandlerUnwrapped r a h) where
  handleImpl :: HandleD (HandlerUnwrapped r a h)
handleImpl = HandleD (HandlerUnwrapped r a h)
forall (h :: Effects -> *).
(forall (e :: Effects) (es :: Effects).
 (e :> es) =>
 OneWayCoercible (h e) (h es)) =>
HandleD h
handleOneWayCoercible

instance
  (Handle h, e :> es) =>
  OneWayCoercible (MakeExceptions r a h e) (MakeExceptions r a h es)
  where
  oneWayCoercibleImpl :: OneWayCoercibleD (MakeExceptions r a h e) (MakeExceptions r a h es)
oneWayCoercibleImpl = OneWayCoercibleD (MakeExceptions r a h e) (MakeExceptions r a h es)
forall {k} (a :: k) (b :: k). OneWayCoercibleD a b
unsafeOneWayCoercible

instance
  (Handle h, e :> es) =>
  OneWayCoercible (HandlerUnwrapped r a h e) (HandlerUnwrapped r a h es)
  where
  oneWayCoercibleImpl :: OneWayCoercibleD
  (HandlerUnwrapped r a h e) (HandlerUnwrapped r a h es)
oneWayCoercibleImpl = OneWayCoercibleD
  (HandlerUnwrapped r a h e) (HandlerUnwrapped r a h es)
forall {k} (a :: k) (b :: k). OneWayCoercibleD a b
unsafeOneWayCoercible

pureHandlerUnwrapped :: h e -> HandlerUnwrapped r a h e
pureHandlerUnwrapped :: forall (h :: Effects -> *) (e :: Effects) r a.
h e -> HandlerUnwrapped r a h e
pureHandlerUnwrapped h e
h = [HandledKey (r -> Eff e a)]
-> (forall b.
    (forall (e :: Effects). h e -> Eff (e :& e) b) -> Eff e b)
-> HandlerUnwrapped r a h e
forall r a (h :: Effects -> *) (es :: Effects).
[HandledKey (r -> Eff es a)]
-> (forall b.
    (forall (e :: Effects). h e -> Eff (e :& es) b) -> Eff es b)
-> HandlerUnwrapped r a h es
MkHandlerUnwrapped [] (\forall (e :: Effects). h e -> Eff (e :& e) b
k -> Eff (e :& e) b -> Eff e b
forall (e :: Effects) r. Eff (e :& e) r -> Eff e r
makeOp (h e -> Eff (e :& e) b
forall (e :: Effects). h e -> Eff (e :& e) b
k h e
h))

-- | Analogous to 'Control.Applicative.pure'
pureMakeExceptions ::
  h e ->
  -- | ͘
  MakeExceptions r a h e
pureMakeExceptions :: forall (h :: Effects -> *) (e :: Effects) r a.
h e -> MakeExceptions r a h e
pureMakeExceptions h e
h = Eff e (HandlerUnwrapped r a h e) -> MakeExceptions r a h e
forall r a (h :: Effects -> *) (es :: Effects).
Eff es (HandlerUnwrapped r a h es) -> MakeExceptions r a h es
MkMakeExceptions (HandlerUnwrapped r a h e -> Eff e (HandlerUnwrapped r a h e)
forall a. a -> Eff e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (h e -> HandlerUnwrapped r a h e
forall (h :: Effects -> *) (e :: Effects) r a.
h e -> HandlerUnwrapped r a h e
pureHandlerUnwrapped h e
h))

apHandlerUnwrapped ::
  (Handle h1, Handle h2) =>
  HandlerUnwrapped r a (h1 :~> h2) e ->
  HandlerUnwrapped r a h1 e ->
  HandlerUnwrapped r a h2 e
apHandlerUnwrapped :: forall (h1 :: Effects -> *) (h2 :: Effects -> *) r a
       (e :: Effects).
(Handle h1, Handle h2) =>
HandlerUnwrapped r a (h1 :~> h2) e
-> HandlerUnwrapped r a h1 e -> HandlerUnwrapped r a h2 e
apHandlerUnwrapped
  hrh1h2 :: HandlerUnwrapped r a (h1 :~> h2) e
hrh1h2@(MkHandlerUnwrapped [HandledKey (r -> Eff e a)]
l1 forall b.
(forall (e :: Effects). (:~>) h1 h2 e -> Eff (e :& e) b) -> Eff e b
_)
  hrh1 :: HandlerUnwrapped r a h1 e
hrh1@(MkHandlerUnwrapped [HandledKey (r -> Eff e a)]
l2 forall b.
(forall (e :: Effects). h1 e -> Eff (e :& e) b) -> Eff e b
_) =
    [HandledKey (r -> Eff e a)]
-> (forall b.
    (forall (e :: Effects). h2 e -> Eff (e :& e) b) -> Eff e b)
-> HandlerUnwrapped r a h2 e
forall r a (h :: Effects -> *) (es :: Effects).
[HandledKey (r -> Eff es a)]
-> (forall b.
    (forall (e :: Effects). h e -> Eff (e :& es) b) -> Eff es b)
-> HandlerUnwrapped r a h es
MkHandlerUnwrapped
      ([HandledKey (r -> Eff e a)]
l1 [HandledKey (r -> Eff e a)]
-> [HandledKey (r -> Eff e a)] -> [HandledKey (r -> Eff e a)]
forall a. Semigroup a => a -> a -> a
<> [HandledKey (r -> Eff e a)]
l2)
      ( \forall (e :: Effects). h2 e -> Eff (e :& e) b
k -> case HandlerUnwrapped r a (h1 :~> h2) e
-> HandlerUnwrapped r a (h1 :~> h2) e
forall (e :: Effects) (es :: Effects).
(e :> es) =>
HandlerUnwrapped r a (h1 :~> h2) e
-> HandlerUnwrapped r a (h1 :~> h2) es
forall (h :: Effects -> *) (e :: Effects) (es :: Effects).
(Handle h, e :> es) =>
h e -> h es
mapHandle HandlerUnwrapped r a (h1 :~> h2) e
hrh1h2 of
          MkHandlerUnwrapped [HandledKey (r -> Eff e a)]
_ forall b.
(forall (e :: Effects). (:~>) h1 h2 e -> Eff (e :& e) b) -> Eff e b
f -> (forall (e :: Effects). (:~>) h1 h2 e -> Eff (e :& e) b) -> Eff e b
forall b.
(forall (e :: Effects). (:~>) h1 h2 e -> Eff (e :& e) b) -> Eff e b
f ((forall (e :: Effects). (:~>) h1 h2 e -> Eff (e :& e) b)
 -> Eff e b)
-> (forall (e :: Effects). (:~>) h1 h2 e -> Eff (e :& e) b)
-> Eff e b
forall a b. (a -> b) -> a -> b
$ \(:~>) h1 h2 e
h1h2 ->
            case HandlerUnwrapped r a h1 e -> HandlerUnwrapped r a h1 (e :& e)
forall (e :: Effects) (es :: Effects).
(e :> es) =>
HandlerUnwrapped r a h1 e -> HandlerUnwrapped r a h1 es
forall (h :: Effects -> *) (e :: Effects) (es :: Effects).
(Handle h, e :> es) =>
h e -> h es
mapHandle HandlerUnwrapped r a h1 e
hrh1 of
              MkHandlerUnwrapped [HandledKey (r -> Eff (e :& e) a)]
_ forall b.
(forall (e :: Effects). h1 e -> Eff (e :& (e :& e)) b)
-> Eff (e :& e) b
x -> (forall (e :: Effects). h1 e -> Eff (e :& (e :& e)) b)
-> Eff (e :& e) b
forall b.
(forall (e :: Effects). h1 e -> Eff (e :& (e :& e)) b)
-> Eff (e :& e) b
x ((forall (e :: Effects). h1 e -> Eff (e :& (e :& e)) b)
 -> Eff (e :& e) b)
-> (forall (e :: Effects). h1 e -> Eff (e :& (e :& e)) b)
-> Eff (e :& e) b
forall a b. (a -> b) -> a -> b
$ \h1 e
h1 ->
                (h2 (e :& (e :& e)) -> Eff ((e :& (e :& e)) :& e) b)
-> h2 (e :& (e :& e)) -> Eff (e :& (e :& e)) b
forall (e :: Effects) (es :: Effects) t r.
(e :> es) =>
(t -> Eff (es :& e) r) -> t -> Eff es r
useImplIn h2 (e :& (e :& e)) -> Eff ((e :& (e :& e)) :& e) b
forall (e :: Effects). h2 e -> Eff (e :& e) b
k ((:~>) h1 h2 (e :& (e :& e))
-> h1 (e :& (e :& e)) -> h2 (e :& (e :& e))
forall (h2 :: Effects -> *) (h1 :: Effects -> *) (e :: Effects).
Handle h2 =>
(:~>) h1 h2 e -> h1 e -> h2 e
app ((:~>) h1 h2 e -> (:~>) h1 h2 (e :& (e :& e))
forall (e :: Effects) (es :: Effects).
(e :> es) =>
(:~>) h1 h2 e -> (:~>) h1 h2 es
forall (h :: Effects -> *) (e :: Effects) (es :: Effects).
(Handle h, e :> es) =>
h e -> h es
mapHandle (:~>) h1 h2 e
h1h2) (h1 e -> h1 (e :& (e :& e))
forall (e :: Effects) (es :: Effects). (e :> es) => h1 e -> h1 es
forall (h :: Effects -> *) (e :: Effects) (es :: Effects).
(Handle h, e :> es) =>
h e -> h es
mapHandle h1 e
h1))
      )

-- | Analogous to 'Control.Monad.ap' and 'Control.Applicative.<*>'
apMakeExceptions ::
  (Handle h1, Handle h2) =>
  MakeExceptions r a (h1 :~> h2) e ->
  MakeExceptions r a h1 e ->
  -- | ͘
  MakeExceptions r a h2 e
apMakeExceptions :: forall (h1 :: Effects -> *) (h2 :: Effects -> *) r a
       (e :: Effects).
(Handle h1, Handle h2) =>
MakeExceptions r a (h1 :~> h2) e
-> MakeExceptions r a h1 e -> MakeExceptions r a h2 e
apMakeExceptions (MkMakeExceptions Eff e (HandlerUnwrapped r a (h1 :~> h2) e)
mh1h2) (MkMakeExceptions Eff e (HandlerUnwrapped r a h1 e)
mh1) = Eff e (HandlerUnwrapped r a h2 e) -> MakeExceptions r a h2 e
forall r a (h :: Effects -> *) (es :: Effects).
Eff es (HandlerUnwrapped r a h es) -> MakeExceptions r a h es
MkMakeExceptions (Eff e (HandlerUnwrapped r a h2 e) -> MakeExceptions r a h2 e)
-> Eff e (HandlerUnwrapped r a h2 e) -> MakeExceptions r a h2 e
forall a b. (a -> b) -> a -> b
$ do
  HandlerUnwrapped r a (h1 :~> h2) e
h1h2 <- Eff e (HandlerUnwrapped r a (h1 :~> h2) e)
mh1h2
  HandlerUnwrapped r a h1 e
h1 <- Eff e (HandlerUnwrapped r a h1 e)
mh1
  HandlerUnwrapped r a h2 e -> Eff e (HandlerUnwrapped r a h2 e)
forall a. a -> Eff e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HandlerUnwrapped r a (h1 :~> h2) e
-> HandlerUnwrapped r a h1 e -> HandlerUnwrapped r a h2 e
forall (h1 :: Effects -> *) (h2 :: Effects -> *) r a
       (e :: Effects).
(Handle h1, Handle h2) =>
HandlerUnwrapped r a (h1 :~> h2) e
-> HandlerUnwrapped r a h1 e -> HandlerUnwrapped r a h2 e
apHandlerUnwrapped HandlerUnwrapped r a (h1 :~> h2) e
h1h2 HandlerUnwrapped r a h1 e
h1)

fmapHandlerUnwrapped ::
  (Handle h1, Handle h2) =>
  (h1 :~> h2) e ->
  HandlerUnwrapped r a h1 e ->
  HandlerUnwrapped r a h2 e
fmapHandlerUnwrapped :: forall (h1 :: Effects -> *) (h2 :: Effects -> *) (e :: Effects) r
       a.
(Handle h1, Handle h2) =>
(:~>) h1 h2 e
-> HandlerUnwrapped r a h1 e -> HandlerUnwrapped r a h2 e
fmapHandlerUnwrapped (:~>) h1 h2 e
f HandlerUnwrapped r a h1 e
h = (:~>) h1 h2 e -> HandlerUnwrapped r a (h1 :~> h2) e
forall (h :: Effects -> *) (e :: Effects) r a.
h e -> HandlerUnwrapped r a h e
pureHandlerUnwrapped (:~>) h1 h2 e
f HandlerUnwrapped r a (h1 :~> h2) e
-> HandlerUnwrapped r a h1 e -> HandlerUnwrapped r a h2 e
forall (h1 :: Effects -> *) (h2 :: Effects -> *) r a
       (e :: Effects).
(Handle h1, Handle h2) =>
HandlerUnwrapped r a (h1 :~> h2) e
-> HandlerUnwrapped r a h1 e -> HandlerUnwrapped r a h2 e
`apHandlerUnwrapped` HandlerUnwrapped r a h1 e
h

-- | Analogous to 'Prelude.fmap' and 'Prelude.<$>'
fmapMakeExceptions ::
  (Handle h1, Handle h2) =>
  (h1 :~> h2) e ->
  MakeExceptions r a h1 e ->
  -- | ͘
  MakeExceptions r a h2 e
fmapMakeExceptions :: forall (h1 :: Effects -> *) (h2 :: Effects -> *) (e :: Effects) r
       a.
(Handle h1, Handle h2) =>
(:~>) h1 h2 e -> MakeExceptions r a h1 e -> MakeExceptions r a h2 e
fmapMakeExceptions (:~>) h1 h2 e
f (MkMakeExceptions Eff e (HandlerUnwrapped r a h1 e)
mh1) = Eff e (HandlerUnwrapped r a h2 e) -> MakeExceptions r a h2 e
forall r a (h :: Effects -> *) (es :: Effects).
Eff es (HandlerUnwrapped r a h es) -> MakeExceptions r a h es
MkMakeExceptions (Eff e (HandlerUnwrapped r a h2 e) -> MakeExceptions r a h2 e)
-> Eff e (HandlerUnwrapped r a h2 e) -> MakeExceptions r a h2 e
forall a b. (a -> b) -> a -> b
$ do
  HandlerUnwrapped r a h1 e
h1 <- Eff e (HandlerUnwrapped r a h1 e)
mh1
  HandlerUnwrapped r a h2 e -> Eff e (HandlerUnwrapped r a h2 e)
forall a. a -> Eff e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((:~>) h1 h2 e
-> HandlerUnwrapped r a h1 e -> HandlerUnwrapped r a h2 e
forall (h1 :: Effects -> *) (h2 :: Effects -> *) (e :: Effects) r
       a.
(Handle h1, Handle h2) =>
(:~>) h1 h2 e
-> HandlerUnwrapped r a h1 e -> HandlerUnwrapped r a h2 e
fmapHandlerUnwrapped (:~>) h1 h2 e
f HandlerUnwrapped r a h1 e
h1)

catchWithResource ::
  forall ex r a es.
  (r -> ex -> Eff es a) ->
  -- | ͘
  MakeExceptions r a (Exception ex) es
catchWithResource :: forall ex r a (es :: Effects).
(r -> ex -> Eff es a) -> MakeExceptions r a (Exception ex) es
catchWithResource r -> ex -> Eff es a
f = Eff es (HandlerUnwrapped r a (Exception ex) es)
-> MakeExceptions r a (Exception ex) es
forall r a (h :: Effects -> *) (es :: Effects).
Eff es (HandlerUnwrapped r a h es) -> MakeExceptions r a h es
MkMakeExceptions (Eff es (HandlerUnwrapped r a (Exception ex) es)
 -> MakeExceptions r a (Exception ex) es)
-> Eff es (HandlerUnwrapped r a (Exception ex) es)
-> MakeExceptions r a (Exception ex) es
forall a b. (a -> b) -> a -> b
$ (forall (e :: Effects).
 IOE e -> Eff (e :& es) (HandlerUnwrapped r a (Exception ex) es))
-> Eff es (HandlerUnwrapped r a (Exception ex) es)
forall (es :: Effects) a.
(forall (e :: Effects). IOE e -> Eff (e :& es) a) -> Eff es a
unsafeProvideIO ((forall (e :: Effects).
  IOE e -> Eff (e :& es) (HandlerUnwrapped r a (Exception ex) es))
 -> Eff es (HandlerUnwrapped r a (Exception ex) es))
-> (forall (e :: Effects).
    IOE e -> Eff (e :& es) (HandlerUnwrapped r a (Exception ex) es))
-> Eff es (HandlerUnwrapped r a (Exception ex) es)
forall a b. (a -> b) -> a -> b
$ \IOE e
io -> do
  Exception ex
scopedEx <- IOE e -> IO (Exception ex) -> Eff (e :& es) (Exception ex)
forall (e :: Effects) (es :: Effects) a.
(e :> es) =>
IOE e -> IO a -> Eff es a
effIO IOE e
io (forall e. IO (Exception e)
SE.newException @ex)
  let hk :: HandledKey (r -> Eff es a)
hk = Exception ex -> (ex -> r -> Eff es a) -> HandledKey (r -> Eff es a)
forall ret ex. Exception ex -> (ex -> ret) -> HandledKey ret
MkHandledKey Exception ex
scopedEx ((r -> ex -> Eff es a) -> ex -> r -> Eff es a
forall a b c. (a -> b -> c) -> b -> a -> c
flip r -> ex -> Eff es a
f)
  HandlerUnwrapped r a (Exception ex) es
-> Eff (e :& es) (HandlerUnwrapped r a (Exception ex) es)
forall a. a -> Eff (e :& es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( [HandledKey (r -> Eff es a)]
-> (forall b.
    (forall (e :: Effects). Exception ex e -> Eff (e :& es) b)
    -> Eff es b)
-> HandlerUnwrapped r a (Exception ex) es
forall r a (h :: Effects -> *) (es :: Effects).
[HandledKey (r -> Eff es a)]
-> (forall b.
    (forall (e :: Effects). h e -> Eff (e :& es) b) -> Eff es b)
-> HandlerUnwrapped r a h es
MkHandlerUnwrapped
        [HandledKey (r -> Eff es a)
hk]
        ( \forall (e :: Effects). Exception ex e -> Eff (e :& es) b
k -> do
            let ex :: Exception ex es
ex = (forall a. ex -> Eff es a) -> Exception ex es
forall exn (e :: Effects).
(forall a. exn -> Eff e a) -> Exception exn e
MkException (\ex
e -> (forall (e :: Effects). IOE e -> Eff (e :& es) a) -> Eff es a
forall (es :: Effects) a.
(forall (e :: Effects). IOE e -> Eff (e :& es) a) -> Eff es a
unsafeProvideIO ((forall (e :: Effects). IOE e -> Eff (e :& es) a) -> Eff es a)
-> (forall (e :: Effects). IOE e -> Eff (e :& es) a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \IOE e
io' -> IOE e -> IO a -> Eff (e :& es) a
forall (e :: Effects) (es :: Effects) a.
(e :> es) =>
IOE e -> IO a -> Eff es a
effIO IOE e
io' (Exception ex -> ex -> IO a
forall e a. Exception e -> e -> IO a
SE.throw Exception ex
scopedEx ex
e))
            Eff (es :& es) b -> Eff es b
forall (e :: Effects) r. Eff (e :& e) r -> Eff e r
makeOp (Exception ex es -> Eff (es :& es) b
forall (e :: Effects). Exception ex e -> Eff (e :& es) b
k Exception ex es
ex)
        )
    )

-- | A generalization of 'bracket' that enables distinguishing
-- exceptional from normal exit.
--
-- [@r@]: The type of the resource
-- [@b@]: The result type of the body
-- [@a@]: The type of the overall result
-- [@h@]: The handle of exceptions available in the body

-- Alsa
-- https://www.stackage.org/haddock/lts-24.26/exceptions-0.10.9/Control-Monad-Catch.html#v:generalBracket
generalBracket ::
  forall r b h a es.
  (Handle h) =>
  -- | Acquire the resource
  Eff es r ->
  -- | Construct the handle @h@ of exceptions to pass into the body,
  -- and determine what to run when the body terminates via one of
  -- those exceptions.
  MakeExceptions r a h es ->
  -- | To run on normal termination
  (r -> b -> Eff es a) ->
  -- | To run on unknown exception
  (r -> Eff es ()) ->
  -- | Body
  (forall e. h e -> r -> Eff (e :& es) b) ->
  Eff es a
generalBracket :: forall r b (h :: Effects -> *) a (es :: Effects).
Handle h =>
Eff es r
-> MakeExceptions r a h es
-> (r -> b -> Eff es a)
-> (r -> Eff es ())
-> (forall (e :: Effects). h e -> r -> Eff (e :& es) b)
-> Eff es a
generalBracket
  Eff es r
acquire'
  (MkMakeExceptions Eff es (HandlerUnwrapped r a h es)
handlers)
  r -> b -> Eff es a
normalRelease'
  r -> Eff es ()
unknownExceptionRelease'
  forall (e :: Effects). h e -> r -> Eff (e :& es) b
body' =
    do
      MkHandlerUnwrapped [HandledKey (r -> Eff es a)]
handledKeys forall b.
(forall (e :: Effects). h e -> Eff (e :& es) b) -> Eff es b
k <- Eff es (HandlerUnwrapped r a h es)
handlers
      (forall (e :: Effects). h e -> Eff (e :& es) a) -> Eff es a
forall b.
(forall (e :: Effects). h e -> Eff (e :& es) b) -> Eff es b
k ((forall (e :: Effects). h e -> Eff (e :& es) a) -> Eff es a)
-> (forall (e :: Effects). h e -> Eff (e :& es) a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \h e
h -> do
        Proxy e
_ :: Proxy e1 <- h e -> Eff (e :& es) (Proxy e)
forall {k} (h :: k -> *) (e :: k) (es :: Effects).
h e -> Eff es (Proxy e)
handleTag h e
h
        let bb :: BracketBase b r a (e1 :& es)
            bb :: BracketBase b r a (e :& es)
bb =
              MkBracketBase
                { acquire :: Eff (e :& es) r
acquire = Eff es r -> Eff (e :& es) r
forall (e :: Effects) (es :: Effects) r.
(e :> es) =>
Eff e r -> Eff es r
useImpl Eff es r
acquire',
                  normalRelease :: r -> b -> Eff (e :& es) a
normalRelease = \r
r b
b -> Eff es a -> Eff (e :& es) a
forall (e :: Effects) (es :: Effects) r.
(e :> es) =>
Eff e r -> Eff es r
useImpl (r -> b -> Eff es a
normalRelease' r
r b
b),
                  unknownExceptionRelease :: r -> Eff (e :& es) ()
unknownExceptionRelease =
                    \r
r -> Eff es () -> Eff (e :& es) ()
forall (e :: Effects) (es :: Effects) r.
(e :> es) =>
Eff e r -> Eff es r
useImpl (r -> Eff es ()
unknownExceptionRelease' r
r),
                  body :: r -> Eff (e :& es) b
body = \r
resource -> Eff (e :& es) b -> Eff (e :& es) b
forall (e :: Effects) (es :: Effects) r.
(e :> es) =>
Eff e r -> Eff es r
useImpl (h e -> r -> Eff (e :& es) b
forall (e :: Effects). h e -> r -> Eff (e :& es) b
body' h e
h r
resource)
                }
        ([HandledKey (r -> Eff (e :& es) a)], BracketBase b r a (e :& es))
-> Eff (e :& es) a
forall r (es :: Effects) a b.
([HandledKey (r -> Eff es a)], BracketBase b r a es) -> Eff es a
runBodyWithHandlers (((HandledKey (r -> Eff es a) -> HandledKey (r -> Eff (e :& es) a))
-> [HandledKey (r -> Eff es a)]
-> [HandledKey (r -> Eff (e :& es) a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HandledKey (r -> Eff es a) -> HandledKey (r -> Eff (e :& es) a))
 -> [HandledKey (r -> Eff es a)]
 -> [HandledKey (r -> Eff (e :& es) a)])
-> ((Eff es a -> Eff (e :& es) a)
    -> HandledKey (r -> Eff es a) -> HandledKey (r -> Eff (e :& es) a))
-> (Eff es a -> Eff (e :& es) a)
-> [HandledKey (r -> Eff es a)]
-> [HandledKey (r -> Eff (e :& es) a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((r -> Eff es a) -> r -> Eff (e :& es) a)
-> HandledKey (r -> Eff es a) -> HandledKey (r -> Eff (e :& es) a)
forall a b. (a -> b) -> HandledKey a -> HandledKey b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((r -> Eff es a) -> r -> Eff (e :& es) a)
 -> HandledKey (r -> Eff es a) -> HandledKey (r -> Eff (e :& es) a))
-> ((Eff es a -> Eff (e :& es) a)
    -> (r -> Eff es a) -> r -> Eff (e :& es) a)
-> (Eff es a -> Eff (e :& es) a)
-> HandledKey (r -> Eff es a)
-> HandledKey (r -> Eff (e :& es) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Eff es a -> Eff (e :& es) a)
-> (r -> Eff es a) -> r -> Eff (e :& es) a
forall a b. (a -> b) -> (r -> a) -> r -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Eff es a -> Eff (e :& es) a
forall (e :: Effects) (es :: Effects) r.
(e :> es) =>
Eff e r -> Eff es r
useImpl [HandledKey (r -> Eff es a)]
handledKeys, BracketBase b r a (e :& es)
bb)

data BracketBase bodyRes r a es = MkBracketBase
  { -- | Acquire the resource
    --
    -- This is run inside an asynchronous exception 'CE.mask'.
    forall bodyRes r a (es :: Effects).
BracketBase bodyRes r a es -> Eff es r
acquire :: !(Eff es r),
    -- | Release the resource after normal exit
    --
    -- This is run inside an asynchronous exception 'CE.mask'.
    forall bodyRes r a (es :: Effects).
BracketBase bodyRes r a es -> r -> bodyRes -> Eff es a
normalRelease :: !(r -> bodyRes -> Eff es a),
    -- | Release the resource after exit due to an unknown exception.
    --
    -- The exception will continue to be raised after this.
    --
    -- This is run inside an asynchronous exception 'CE.mask'.
    forall bodyRes r a (es :: Effects).
BracketBase bodyRes r a es -> r -> Eff es ()
unknownExceptionRelease :: !(r -> Eff es ()),
    -- | Use the resource
    forall bodyRes r a (es :: Effects).
BracketBase bodyRes r a es -> r -> Eff es bodyRes
body :: !(r -> Eff es bodyRes)
  }
  deriving ((forall x.
 BracketBase bodyRes r a es -> Rep (BracketBase bodyRes r a es) x)
-> (forall x.
    Rep (BracketBase bodyRes r a es) x -> BracketBase bodyRes r a es)
-> Generic (BracketBase bodyRes r a es)
forall x.
Rep (BracketBase bodyRes r a es) x -> BracketBase bodyRes r a es
forall x.
BracketBase bodyRes r a es -> Rep (BracketBase bodyRes r a es) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall bodyRes r a (es :: Effects) x.
Rep (BracketBase bodyRes r a es) x -> BracketBase bodyRes r a es
forall bodyRes r a (es :: Effects) x.
BracketBase bodyRes r a es -> Rep (BracketBase bodyRes r a es) x
$cfrom :: forall bodyRes r a (es :: Effects) x.
BracketBase bodyRes r a es -> Rep (BracketBase bodyRes r a es) x
from :: forall x.
BracketBase bodyRes r a es -> Rep (BracketBase bodyRes r a es) x
$cto :: forall bodyRes r a (es :: Effects) x.
Rep (BracketBase bodyRes r a es) x -> BracketBase bodyRes r a es
to :: forall x.
Rep (BracketBase bodyRes r a es) x -> BracketBase bodyRes r a es
Generic)

instance
  (e :> es) =>
  OneWayCoercible
    (BracketBase bodyRes r a e)
    (BracketBase bodyRes r a es)
  where
  oneWayCoercibleImpl :: OneWayCoercibleD
  (BracketBase bodyRes r a e) (BracketBase bodyRes r a es)
oneWayCoercibleImpl = OneWayCoercibleD
  (BracketBase bodyRes r a e) (BracketBase bodyRes r a es)
forall {k} (h :: k -> *) (e :: k) (es :: k).
GOneWayCoercible (Rep (h e)) (Rep (h es)) =>
OneWayCoercibleD (h e) (h es)
gOneWayCoercible

useImplBracketBase ::
  (e :> es) =>
  BracketBase b r a e ->
  BracketBase b r a es
useImplBracketBase :: forall (e :: Effects) (es :: Effects) b r a.
(e :> es) =>
BracketBase b r a e -> BracketBase b r a es
useImplBracketBase = BracketBase b r a e -> BracketBase b r a es
forall a b. OneWayCoercible a b => a -> b
oneWayCoerce