{-# options_haddock prune #-}

-- |Description: Interpreters for 'Stop'.
module Polysemy.Resume.Interpreter.Stop where

import qualified Control.Exception as Base
import Control.Exception (throwIO)
import Control.Monad.Trans.Except (ExceptT (ExceptT), runExceptT, throwE)
import Data.Typeable (typeRep)
import Polysemy.Final (getInitialStateS, interpretFinal, runS, withStrategicToFinal)
import Polysemy.Internal (Sem (Sem), usingSem)
import Polysemy.Internal.Union (Weaving (Weaving), decomp, hoist, weave)
import qualified Text.Show

import Polysemy.Resume.Effect.Stop (Stop (Stop), stop)

-- |Equivalent of 'runError'.
runStop ::
  Sem (Stop err : r) a ->
  Sem r (Either err a)
runStop :: forall err (r :: [(* -> *) -> * -> *]) a.
Sem (Stop err : r) a -> Sem r (Either err a)
runStop (Sem forall (m :: * -> *).
Monad m =>
(forall x. Union (Stop err : r) (Sem (Stop err : r)) x -> m x)
-> m a
m) =
  forall (r :: [(* -> *) -> * -> *]) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem \ forall x. Union r (Sem r) x -> m x
k ->
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
(forall x. Union (Stop err : r) (Sem (Stop err : r)) x -> m x)
-> m a
m \ Union (Stop err : r) (Sem (Stop err : r)) x
u ->
      case forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp Union (Stop err : r) (Sem (Stop err : r)) x
u of
        Left Union r (Sem (Stop err : r)) x
x ->
          forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall x. Union r (Sem r) x -> m x
k forall a b. (a -> b) -> a -> b
$ forall (s :: * -> *) (n :: * -> *) (m :: * -> *)
       (r :: [(* -> *) -> * -> *]) a.
(Functor s, Functor n) =>
s ()
-> (forall x. s (m x) -> n (s x))
-> (forall x. s x -> Maybe x)
-> Union r m a
-> Union r n (s a)
weave (forall a b. b -> Either a b
Right ()) (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) forall err (r :: [(* -> *) -> * -> *]) a.
Sem (Stop err : r) a -> Sem r (Either err a)
runStop) forall l r. Either l r -> Maybe r
rightToMaybe Union r (Sem (Stop err : r)) x
x
        Right (Weaving (Stop err
err) f ()
_ forall x. f (Sem rInitial x) -> Sem (Stop err : r) (f x)
_ f a -> x
_ forall x. f x -> Maybe x
_) ->
          forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE err
err
{-# inline runStop #-}

-- | Internal type used to tag exceptions thrown by 'Stop' interpreters.
newtype StopExc err =
  StopExc { forall err. StopExc err -> err
unStopExc :: err }
  deriving stock (Typeable)

instance {-# overlappable #-} Typeable err => Show (StopExc err) where
  show :: StopExc err -> String
show =
    forall a. Monoid a => a -> a -> a
mappend String
"StopExc: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (Show a, IsString b) => a -> b
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep

instance Show (StopExc Text) where
  show :: StopExc Text -> String
show (StopExc Text
err) =
    String
"StopExc " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Text
err

instance {-# overlappable #-} Typeable err => Exception (StopExc err)

instance Exception (StopExc Text)

-- |Run 'Stop' by throwing exceptions.
runStopAsExcFinal ::
  ∀ err r a .
  Exception (StopExc err) =>
  Member (Final IO) r =>
  Sem (Stop err : r) a ->
  Sem r a
runStopAsExcFinal :: forall err (r :: [(* -> *) -> * -> *]) a.
(Exception (StopExc err), Member (Final IO) r) =>
Sem (Stop err : r) a -> Sem r a
runStopAsExcFinal =
  forall (m :: * -> *) (e :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
Member (Final m) r =>
(forall x (rInitial :: [(* -> *) -> * -> *]).
 e (Sem rInitial) x -> Strategic m (Sem rInitial) x)
-> Sem (e : r) a -> Sem r a
interpretFinal \case
    Stop err
err ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall e a. Exception e => e -> IO a
throwIO (forall err. err -> StopExc err
StopExc err
err))
{-# inline runStopAsExcFinal #-}

-- |Run 'Stop' by throwing and catching exceptions.
stopToIOFinal ::
  ∀ err r a .
  Exception (StopExc err) =>
  Member (Final IO) r =>
  Sem (Stop err : r) a ->
  Sem r (Either err a)
stopToIOFinal :: forall err (r :: [(* -> *) -> * -> *]) a.
(Exception (StopExc err), Member (Final IO) r) =>
Sem (Stop err : r) a -> Sem r (Either err a)
stopToIOFinal Sem (Stop err : r) a
sem =
  forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Final m) r =>
Strategic m (Sem r) a -> Sem r a
withStrategicToFinal @IO do
    IO (f a)
m' <- forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS (forall err (r :: [(* -> *) -> * -> *]) a.
(Exception (StopExc err), Member (Final IO) r) =>
Sem (Stop err : r) a -> Sem r a
runStopAsExcFinal Sem (Stop err : r) a
sem)
    f ()
s <- forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (f ())
getInitialStateS
    pure $ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall err. StopExc err -> err
unStopExc) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a. Exception e => IO a -> IO (Either e a)
Base.try IO (f a)
m'
{-# inline stopToIOFinal #-}

-- |Stop if the argument is 'Left', transforming the error with @f@.
stopEitherWith ::
  ∀ err err' r a .
  Member (Stop err') r =>
  (err -> err') ->
  Either err a ->
  Sem r a
stopEitherWith :: forall err err' (r :: [(* -> *) -> * -> *]) a.
Member (Stop err') r =>
(err -> err') -> Either err a -> Sem r a
stopEitherWith err -> err'
f =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (r :: [(* -> *) -> * -> *]) a.
Member (Stop e) r =>
e -> Sem r a
stop forall b c a. (b -> c) -> (a -> b) -> a -> c
. err -> err'
f) forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# inline stopEitherWith #-}

-- |Stop if the argument is 'Left', using the supplied error.
stopEitherAs ::
  ∀ err err' r a .
  Member (Stop err') r =>
  err' ->
  Either err a ->
  Sem r a
stopEitherAs :: forall err err' (r :: [(* -> *) -> * -> *]) a.
Member (Stop err') r =>
err' -> Either err a -> Sem r a
stopEitherAs err'
err =
  forall err err' (r :: [(* -> *) -> * -> *]) a.
Member (Stop err') r =>
(err -> err') -> Either err a -> Sem r a
stopEitherWith (forall a b. a -> b -> a
const err'
err)
{-# inline stopEitherAs #-}

-- |Stop if the argument is 'Left'.
stopEither ::
  ∀ err r a .
  Member (Stop err) r =>
  Either err a ->
  Sem r a
stopEither :: forall err (r :: [(* -> *) -> * -> *]) a.
Member (Stop err) r =>
Either err a -> Sem r a
stopEither =
  forall err err' (r :: [(* -> *) -> * -> *]) a.
Member (Stop err') r =>
(err -> err') -> Either err a -> Sem r a
stopEitherWith forall a. a -> a
id
{-# inline stopEither #-}

-- |Stop with the supplied error if the argument is 'Nothing'.
stopNote ::
  ∀ err r a .
  Member (Stop err) r =>
  err ->
  Maybe a ->
  Sem r a
stopNote :: forall err (r :: [(* -> *) -> * -> *]) a.
Member (Stop err) r =>
err -> Maybe a -> Sem r a
stopNote err
err =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (r :: [(* -> *) -> * -> *]) a.
Member (Stop e) r =>
e -> Sem r a
stop err
err) forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# inline stopNote #-}

-- |Convert a program using regular 'Error's to one using 'Stop'.
stopOnError ::
  ∀ err r a .
  Member (Stop err) r =>
  Sem (Error err : r) a ->
  Sem r a
stopOnError :: forall err (r :: [(* -> *) -> * -> *]) a.
Member (Stop err) r =>
Sem (Error err : r) a -> Sem r a
stopOnError =
  forall err (r :: [(* -> *) -> * -> *]) a.
Member (Stop err) r =>
Either err a -> Sem r a
stopEither forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall e (r :: [(* -> *) -> * -> *]) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError
{-# inline stopOnError #-}

-- |Convert a program using regular 'Error's to one using 'Stop'.
stopOnErrorWith ::
  ∀ err err' r a .
  Member (Stop err') r =>
  (err -> err') ->
  Sem (Error err : r) a ->
  Sem r a
stopOnErrorWith :: forall err err' (r :: [(* -> *) -> * -> *]) a.
Member (Stop err') r =>
(err -> err') -> Sem (Error err : r) a -> Sem r a
stopOnErrorWith err -> err'
f =
  forall err err' (r :: [(* -> *) -> * -> *]) a.
Member (Stop err') r =>
(err -> err') -> Either err a -> Sem r a
stopEitherWith err -> err'
f forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall e (r :: [(* -> *) -> * -> *]) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError
{-# inline stopOnErrorWith #-}

-- |Convert a program using 'Stop' to one using 'Error', transforming the error with the supplied function.
stopToErrorWith ::
  ∀ err err' r a .
  Member (Error err') r =>
  (err -> err') ->
  Sem (Stop err : r) a ->
  Sem r a
stopToErrorWith :: forall err err' (r :: [(* -> *) -> * -> *]) a.
Member (Error err') r =>
(err -> err') -> Sem (Stop err : r) a -> Sem r a
stopToErrorWith err -> err'
f =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
e -> Sem r a
throw forall b c a. (b -> c) -> (a -> b) -> a -> c
. err -> err'
f) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall err (r :: [(* -> *) -> * -> *]) a.
Sem (Stop err : r) a -> Sem r (Either err a)
runStop
{-# inline stopToErrorWith #-}

-- |Convert a program using 'Stop' to one using 'Error'.
stopToError ::
  ∀ err r a .
  Member (Error err) r =>
  Sem (Stop err : r) a ->
  Sem r a
stopToError :: forall err (r :: [(* -> *) -> * -> *]) a.
Member (Error err) r =>
Sem (Stop err : r) a -> Sem r a
stopToError =
  forall err err' (r :: [(* -> *) -> * -> *]) a.
Member (Error err') r =>
(err -> err') -> Sem (Stop err : r) a -> Sem r a
stopToErrorWith forall a. a -> a
id
{-# inline stopToError #-}

-- |Convert a program using 'Stop' to one using 'Error'.
stopToErrorIO ::
  ∀ err r a .
  Exception (StopExc err) =>
  Members [Error err, Final IO] r =>
  Sem (Stop err : r) a ->
  Sem r a
stopToErrorIO :: forall err (r :: [(* -> *) -> * -> *]) a.
(Exception (StopExc err), Members '[Error err, Final IO] r) =>
Sem (Stop err : r) a -> Sem r a
stopToErrorIO =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
e -> Sem r a
throw forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall err (r :: [(* -> *) -> * -> *]) a.
(Exception (StopExc err), Member (Final IO) r) =>
Sem (Stop err : r) a -> Sem r (Either err a)
stopToIOFinal
{-# inline stopToErrorIO #-}

-- |Map over the error type in a 'Stop'.
mapStop ::
  ∀ err e' r a .
  Member (Stop e') r =>
  (err -> e') ->
  Sem (Stop err : r) a ->
  Sem r a
mapStop :: forall err e' (r :: [(* -> *) -> * -> *]) a.
Member (Stop e') r =>
(err -> e') -> Sem (Stop err : r) a -> Sem r a
mapStop err -> e'
f (Sem forall (m :: * -> *).
Monad m =>
(forall x. Union (Stop err : r) (Sem (Stop err : r)) x -> m x)
-> m a
m) =
  forall (r :: [(* -> *) -> * -> *]) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem \ forall x. Union r (Sem r) x -> m x
k -> forall (m :: * -> *).
Monad m =>
(forall x. Union (Stop err : r) (Sem (Stop err : r)) x -> m x)
-> m a
m \ Union (Stop err : r) (Sem (Stop err : r)) x
u ->
    case forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp Union (Stop err : r) (Sem (Stop err : r)) x
u of
      Left Union r (Sem (Stop err : r)) x
x ->
        forall x. Union r (Sem r) x -> m x
k (forall (m :: * -> *) (n :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist (forall err e' (r :: [(* -> *) -> * -> *]) a.
Member (Stop e') r =>
(err -> e') -> Sem (Stop err : r) a -> Sem r a
mapStop err -> e'
f) Union r (Sem (Stop err : r)) x
x)
      Right (Weaving (Stop err
err) f ()
_ forall x. f (Sem rInitial x) -> Sem (Stop err : r) (f x)
_ f a -> x
_ forall x. f x -> Maybe x
_) ->
        forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> Sem r a -> m a
usingSem forall x. Union r (Sem r) x -> m x
k (forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Member e r =>
e (Sem r) a -> Sem r a
send forall a b. (a -> b) -> a -> b
$ forall e (a :: * -> *) b. e -> Stop e a b
Stop (err -> e'
f err
err))
{-# inline mapStop #-}

-- |Replace the error in a 'Stop' with another type.
replaceStop ::
  ∀ err e' r a .
  Member (Stop e') r =>
  e' ->
  Sem (Stop err : r) a ->
  Sem r a
replaceStop :: forall err e' (r :: [(* -> *) -> * -> *]) a.
Member (Stop e') r =>
e' -> Sem (Stop err : r) a -> Sem r a
replaceStop e'
e' =
  forall err e' (r :: [(* -> *) -> * -> *]) a.
Member (Stop e') r =>
(err -> e') -> Sem (Stop err : r) a -> Sem r a
mapStop (forall a b. a -> b -> a
const e'
e')
{-# inline replaceStop #-}

-- |Convert the error type in a 'Stop' to 'Text'.
showStop ::
  ∀ err r a .
  Show err =>
  Member (Stop Text) r =>
  Sem (Stop err : r) a ->
  Sem r a
showStop :: forall err (r :: [(* -> *) -> * -> *]) a.
(Show err, Member (Stop Text) r) =>
Sem (Stop err : r) a -> Sem r a
showStop =
  forall err e' (r :: [(* -> *) -> * -> *]) a.
Member (Stop e') r =>
(err -> e') -> Sem (Stop err : r) a -> Sem r a
mapStop @err @Text forall b a. (Show a, IsString b) => a -> b
show
{-# inline showStop #-}

-- |Convert an 'IO' exception to 'Stop' using the provided transformation.
stopTryIOE ::
  ∀ exc err r a .
  Exception exc =>
  Members [Stop err, Embed IO] r =>
  (exc -> err) ->
  IO a ->
  Sem r a
stopTryIOE :: forall exc err (r :: [(* -> *) -> * -> *]) a.
(Exception exc, Members '[Stop err, Embed IO] r) =>
(exc -> err) -> IO a -> Sem r a
stopTryIOE exc -> err
f =
  forall err err' (r :: [(* -> *) -> * -> *]) a.
Member (Stop err') r =>
(err -> err') -> Either err a -> Sem r a
stopEitherWith exc -> err
f forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall e (r :: [(* -> *) -> * -> *]) a.
(Exception e, Member (Embed IO) r) =>
IO a -> Sem r (Either e a)
tryIOE @exc
{-# inline stopTryIOE #-}

-- |Convert an 'IO' exception of type @err@ to 'Stop' using the provided transformation from 'Text'.
stopTryIO ::
  ∀ exc err r a .
  Exception exc =>
  Members [Stop err, Embed IO] r =>
  (Text -> err) ->
  IO a ->
  Sem r a
stopTryIO :: forall exc err (r :: [(* -> *) -> * -> *]) a.
(Exception exc, Members '[Stop err, Embed IO] r) =>
(Text -> err) -> IO a -> Sem r a
stopTryIO Text -> err
f =
  forall err err' (r :: [(* -> *) -> * -> *]) a.
Member (Stop err') r =>
(err -> err') -> Either err a -> Sem r a
stopEitherWith Text -> err
f forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall e (r :: [(* -> *) -> * -> *]) a.
(Exception e, Member (Embed IO) r) =>
IO a -> Sem r (Either Text a)
tryIO @exc
{-# inline stopTryIO #-}

-- |Convert an 'IO' exception of type 'Control.Exception.IOError' to 'Stop' using the provided transformation from
-- 'Text'.
stopTryIOError ::
  ∀ err r a .
  Members [Stop err, Embed IO] r =>
  (Text -> err) ->
  IO a ->
  Sem r a
stopTryIOError :: forall err (r :: [(* -> *) -> * -> *]) a.
Members '[Stop err, Embed IO] r =>
(Text -> err) -> IO a -> Sem r a
stopTryIOError Text -> err
f =
  forall err err' (r :: [(* -> *) -> * -> *]) a.
Member (Stop err') r =>
(err -> err') -> Either err a -> Sem r a
stopEitherWith Text -> err
f forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryIOError
{-# inline stopTryIOError #-}

-- |Convert an 'IO' exception to 'Stop' using the provided transformation from 'Text'.
stopTryAny ::
  ∀ err r a .
  Members [Stop err, Embed IO] r =>
  (Text -> err) ->
  IO a ->
  Sem r a
stopTryAny :: forall err (r :: [(* -> *) -> * -> *]) a.
Members '[Stop err, Embed IO] r =>
(Text -> err) -> IO a -> Sem r a
stopTryAny Text -> err
f =
  forall err err' (r :: [(* -> *) -> * -> *]) a.
Member (Stop err') r =>
(err -> err') -> Either err a -> Sem r a
stopEitherWith Text -> err
f forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryAny
{-# inline stopTryAny #-}