{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE QuantifiedConstraints #-}

-- SPDX-License-Identifier: MPL-2.0

{- |
Copyright   :  (c) 2023-2025 Sayo contributors
License     :  MPL-2.0 (see the file LICENSE)
Maintainer  :  ymdfield@outlook.jp

An effect to escape from the normal control structure with an exception value in the middle of a context.
-}
module Data.Effect.Except (
    module Data.Effect.Except,
    Catch (..),
    Throw (..),
)
where

import Data.Effect (Catch (Catch), Emb, Throw (Throw), UnliftIO)
import UnliftIO (Exception, throwIO)
import UnliftIO qualified as IO

makeEffectF_' (def & noGenerateLabel & noGenerateOrderInstance) ''Throw
makeEffectH_' (def & noGenerateLabel & noGenerateOrderInstance) ''Catch

-- | Throws the given `Either` value as an exception if it is `Left`.
liftEither :: forall e es a ff c. (Throw e :> es, Applicative (Eff ff es), Free c ff) => Either e a -> Eff ff es a
liftEither :: forall e (es :: [Effect]) a (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Throw e :> es, Applicative (Eff ff es), Free c ff) =>
Either e a -> Eff ff es a
liftEither = (e -> Eff ff es a)
-> (a -> Eff ff es a) -> Either e a -> Eff ff es a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> Eff ff es a
forall e b (a :: * -> *) (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Free c ff, a ~ Eff ff es, Throw e :> es) =>
e -> a b
throw a -> Eff ff es a
forall a. a -> Eff ff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE liftEither #-}

-- | Throws the result of the given action as an exception if it is `Left`.
joinEither :: forall e es a ff c. (Throw e :> es, Monad (Eff ff es), Free c ff) => Eff ff es (Either e a) -> Eff ff es a
joinEither :: forall e (es :: [Effect]) a (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Throw e :> es, Monad (Eff ff es), Free c ff) =>
Eff ff es (Either e a) -> Eff ff es a
joinEither = (Eff ff es (Either e a)
-> (Either e a -> Eff ff es a) -> Eff ff es a
forall a b. Eff ff es a -> (a -> Eff ff es b) -> Eff ff es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (e -> Eff ff es a)
-> (a -> Eff ff es a) -> Either e a -> Eff ff es a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> Eff ff es a
forall e b (a :: * -> *) (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Free c ff, a ~ Eff ff es, Throw e :> es) =>
e -> a b
throw a -> Eff ff es a
forall a. a -> Eff ff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
{-# INLINE joinEither #-}

-- | If the given `Either` value is `Left`, execute it as an action.
joinExcept :: (Monad m) => Either (m a) a -> m a
joinExcept :: forall (m :: * -> *) a. Monad m => Either (m a) a -> m a
joinExcept = (m a -> m a) -> (a -> m a) -> Either (m a) a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either m a -> m a
forall a. a -> a
id a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE joinExcept #-}

-- | If the result of the given action is `Left`, execute it as an action.
exc :: (Monad m) => m (Either (m a) a) -> m a
exc :: forall (m :: * -> *) a. Monad m => m (Either (m a) a) -> m a
exc = (m (Either (m a) a) -> (Either (m a) a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (m a -> m a) -> (a -> m a) -> Either (m a) a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either m a -> m a
forall a. a -> a
id a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
{-# INLINE exc #-}

-- | If an exception occurs, executes the given exception handler, but the exception is not stopped there and is rethrown.
withExcept
    :: forall e es a ff c
     . (Catch e :> es, Throw e :> es, Applicative (Eff ff es), Free c ff)
    => Eff ff es a
    -- ^ Scope to which the exception handler applies
    -> (e -> Eff ff es ())
    -- ^ Exception handler
    -> Eff ff es a
withExcept :: forall e (es :: [Effect]) a (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Catch e :> es, Throw e :> es, Applicative (Eff ff es),
 Free c ff) =>
Eff ff es a -> (e -> Eff ff es ()) -> Eff ff es a
withExcept Eff ff es a
thing e -> Eff ff es ()
after = Eff ff es a
thing Eff ff es a -> (e -> Eff ff es a) -> Eff ff es a
forall b e (a :: * -> *) (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Free c ff, a ~ Eff ff es, Catch e :> es) =>
a b -> (e -> a b) -> a b
`catch` \e
e -> e -> Eff ff es ()
after e
e Eff ff es () -> Eff ff es a -> Eff ff es a
forall a b. Eff ff es a -> Eff ff es b -> Eff ff es b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> e -> Eff ff es a
forall e b (a :: * -> *) (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Free c ff, a ~ Eff ff es, Throw e :> es) =>
e -> a b
throw e
e
{-# INLINE withExcept #-}

-- | If an exception occurs, executes the specified action, but the exception is not stopped there and is rethrown.
onExcept
    :: forall e es ff a c
     . (Catch e :> es, Throw e :> es, Applicative (Eff ff es), Free c ff)
    => Eff ff es a
    -- ^ Scope in which to detect exceptions
    -> Eff ff es ()
    -- ^ Action to execute in case of an exception
    -> Eff ff es a
onExcept :: forall e (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(Catch e :> es, Throw e :> es, Applicative (Eff ff es),
 Free c ff) =>
Eff ff es a -> Eff ff es () -> Eff ff es a
onExcept Eff ff es a
thing Eff ff es ()
after = Eff ff es a
thing Eff ff es a -> (e -> Eff ff es ()) -> Eff ff es a
forall e (es :: [Effect]) a (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Catch e :> es, Throw e :> es, Applicative (Eff ff es),
 Free c ff) =>
Eff ff es a -> (e -> Eff ff es ()) -> Eff ff es a
`withExcept` \(e
_ :: e) -> Eff ff es ()
after
{-# INLINE onExcept #-}

-- | Interpret the t'Throw' effect based on an IO-fused semantics using IO-level exceptions.
runThrowIO
    :: forall e es ff a c
     . (Emb IO :> es, Exception e, Monad (Eff ff es), Free c ff)
    => Eff ff (Throw e ': es) a
    -> Eff ff es a
runThrowIO :: forall e (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(Emb IO :> es, Exception e, Monad (Eff ff es), Free c ff) =>
Eff ff (Throw e : es) a -> Eff ff es a
runThrowIO = (Throw e ~~> Eff ff es) -> Eff ff (Throw e : es) a -> Eff ff es a
forall (e :: Effect) (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
(e ~~> Eff ff es) -> Eff ff (e : es) a -> Eff ff es a
interpret \(Throw e
e) -> e -> Eff ff es x
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO e
e
{-# INLINE runThrowIO #-}

-- | Interpret the t'Catch' effect based on an IO-fused semantics using IO-level exceptions.
runCatchIO
    :: forall e es ff a c
     . (UnliftIO :> es, Emb IO :> es, Exception e, Monad (Eff ff es), Free c ff)
    => Eff ff (Catch e ': es) a
    -> Eff ff es a
runCatchIO :: forall e (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(UnliftIO :> es, Emb IO :> es, Exception e, Monad (Eff ff es),
 Free c ff) =>
Eff ff (Catch e : es) a -> Eff ff es a
runCatchIO = (Catch e ~~> Eff ff es) -> Eff ff (Catch e : es) a -> Eff ff es a
forall (e :: Effect) (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
(e ~~> Eff ff es) -> Eff ff (e : es) a -> Eff ff es a
interpret \(Catch Eff ff es x
action e -> Eff ff es x
hdl) -> Eff ff es x -> (e -> Eff ff es x) -> Eff ff es x
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
IO.catch Eff ff es x
action e -> Eff ff es x
hdl
{-# INLINE runCatchIO #-}