-- | Resumption combinators, transforming an effect into 'Resumable' and 'Stop'.
module Polysemy.Resume.Resume where

import Polysemy.Resume.Effect.Resumable (Resumable)
import Polysemy.Resume.Effect.Stop (Stop, stop)
import Polysemy.Resume.Interpreter.Resumable (runAsResumable)
import Polysemy.Resume.Interpreter.Stop (runStop)

-- | Execute the action of a regular effect @eff@ so that any error of type @err@ that maybe be thrown by the (unknown)
-- interpreter used for @eff@ will be caught here and handled by the @handler@ argument.
-- This is similar to 'Polysemy.Error.catch' with the additional guarantee that the error will have to be explicitly
-- matched, therefore preventing accidental failure to handle an error and bubbling it up to @main@.
-- It also imposes a membership of @Resumable err eff@ on the program, requiring the interpreter for @eff@ to be adapted
-- with 'Polysemy.Resume.Interpreter.Resumable.resumable'.
--
-- @
-- data Resumer :: Effect where
--   MainProgram :: Resumer m Int
--
-- makeSem ''Resumer
--
-- interpretResumer ::
--   Member (Resumable Boom Stopper) r =>
--   InterpreterFor Resumer r
-- interpretResumer =
--   interpret \\ MainProgram ->
--     resume (192 \<$ stopBang) \\ _ ->
--       pure 237
-- @
resume ::
  ∀ err eff r a .
  Member (Resumable err eff) r =>
  Sem (eff : r) a ->
  (err -> Sem r a) ->
  Sem r a
resume :: forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
resume Sem (eff : r) a
sem err -> Sem r a
handler =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either err -> Sem r a
handler forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall err (r :: EffectRow) a.
Sem (Stop err : r) a -> Sem r (Either err a)
runStop (forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
runAsResumable @err (forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder Sem (eff : r) a
sem))
{-# inline resume #-}

-- | Operator version of 'resume'.
--
-- @since 0.2.0.0
(!!) ::
  ∀ err eff r a .
  Member (Resumable err eff) r =>
  Sem (eff : r) a ->
  (err -> Sem r a) ->
  Sem r a
!! :: forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
(!!) =
  forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
resume
{-# inline (!!) #-}

-- | Reinterpreting version of 'resume'.
resumeRe ::
  ∀ err eff r a .
  Sem (eff : r) a ->
  (err -> Sem (Resumable err eff : r) a) ->
  Sem (Resumable err eff : r) a
resumeRe :: forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem (eff : r) a
-> (err -> Sem (Resumable err eff : r) a)
-> Sem (Resumable err eff : r) a
resumeRe Sem (eff : r) a
sem err -> Sem (Resumable err eff : r) a
handler =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either err -> Sem (Resumable err eff : r) a
handler forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall err (r :: EffectRow) a.
Sem (Stop err : r) a -> Sem r (Either err a)
runStop (forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
runAsResumable @err (forall (e2 :: (* -> *) -> * -> *) (e3 :: (* -> *) -> * -> *)
       (e1 :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : e3 : r) a
raiseUnder2 Sem (eff : r) a
sem))
{-# inline resumeRe #-}

-- | Flipped variant of 'resume'.
resuming ::
  ∀ err eff r a .
  Member (Resumable err eff) r =>
  (err -> Sem r a) ->
  Sem (eff : r) a ->
  Sem r a
resuming :: forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
(err -> Sem r a) -> Sem (eff : r) a -> Sem r a
resuming =
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
resume
{-# inline resuming #-}

-- | Flipped variant of 'resumeRe'.
resumingRe ::
  ∀ err eff r a .
  (err -> Sem (Resumable err eff : r) a) ->
  Sem (eff : r) a ->
  Sem (Resumable err eff : r) a
resumingRe :: forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
(err -> Sem (Resumable err eff : r) a)
-> Sem (eff : r) a -> Sem (Resumable err eff : r) a
resumingRe =
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem (eff : r) a
-> (err -> Sem (Resumable err eff : r) a)
-> Sem (Resumable err eff : r) a
resumeRe
{-# inline resumingRe #-}

-- | Variant of 'resume' that unconditionally recovers with a constant value.
resumeAs ::
  ∀ err eff r a .
  Member (Resumable err eff) r =>
  a ->
  Sem (eff : r) a ->
  Sem r a
resumeAs :: forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
a -> Sem (eff : r) a -> Sem r a
resumeAs a
a =
  forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
(err -> Sem r a) -> Sem (eff : r) a -> Sem r a
resuming @err \ err
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
{-# inline resumeAs #-}

-- | Operator version of 'resumeAs'.
--
-- @since 0.2.0.0
(<!) ::
  ∀ err eff r a .
  Member (Resumable err eff) r =>
  a ->
  Sem (eff : r) a ->
  Sem r a
<! :: forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
a -> Sem (eff : r) a -> Sem r a
(<!) =
  forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
a -> Sem (eff : r) a -> Sem r a
resumeAs @err

-- | Operator version of 'resumeAs', flipped version of '(<!)'.
--
-- @since 0.2.0.0
(!>) ::
  ∀ err eff r a .
  Member (Resumable err eff) r =>
  Sem (eff : r) a ->
  a ->
  Sem r a
!> :: forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> a -> Sem r a
(!>) =
  forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
a -> Sem (eff : r) a -> Sem r a
resumeAs @err)

-- | Convenience specialization of 'resume' that silently discards errors for void programs.
resume_ ::
  ∀ err eff r .
  Member (Resumable err eff) r =>
  Sem (eff : r) () ->
  Sem r ()
resume_ :: forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
Member (Resumable err eff) r =>
Sem (eff : r) () -> Sem r ()
resume_ =
  forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
a -> Sem (eff : r) a -> Sem r a
resumeAs @err ()

-- | Variant of 'resume' that unconditionally recovers with an action.
--
-- @since 0.2.0.0
resumeWith ::
  ∀ err eff r a .
  Member (Resumable err eff) r =>
  Sem (eff : r) a ->
  Sem r a ->
  Sem r a
resumeWith :: forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> Sem r a -> Sem r a
resumeWith Sem (eff : r) a
ma Sem r a
ma' =
  forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
resume @err Sem (eff : r) a
ma (forall a b. a -> b -> a
const Sem r a
ma')
{-# inline resumeWith #-}

-- | Operator variant of 'resumeWith'.
--
-- @since 0.2.0.0
(!>>) ::
  ∀ err eff r a .
  Member (Resumable err eff) r =>
  Sem (eff : r) a ->
  Sem r a ->
  Sem r a
!>> :: forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> Sem r a -> Sem r a
(!>>) =
  forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> Sem r a -> Sem r a
resumeWith @err
{-# inline (!>>) #-}

-- | Variant of 'resuming' that unconditionally recovers with an action.
--
-- @since 0.2.0.0
resumingWith ::
  ∀ err eff r a .
  Member (Resumable err eff) r =>
  Sem r a ->
  Sem (eff : r) a ->
  Sem r a
resumingWith :: forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem r a -> Sem (eff : r) a -> Sem r a
resumingWith Sem r a
ma' Sem (eff : r) a
ma =
  forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
resume @err Sem (eff : r) a
ma (forall a b. a -> b -> a
const Sem r a
ma')
{-# inline resumingWith #-}

-- | Operator variant of 'resumingWith'.
--
-- @since 0.2.0.0
(<<!) ::
  ∀ err eff r a .
  Member (Resumable err eff) r =>
  Sem r a ->
  Sem (eff : r) a ->
  Sem r a
<<! :: forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem r a -> Sem (eff : r) a -> Sem r a
(<<!) =
  forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem r a -> Sem (eff : r) a -> Sem r a
resumingWith @err
{-# inline (<<!) #-}

-- | Variant of 'resume' that propagates the error to another 'Stop' effect after applying a function.
resumeHoist ::
  ∀ err eff err' r a .
  Members [Resumable err eff, Stop err'] r =>
  (err -> err') ->
  Sem (eff : r) a ->
  Sem r a
resumeHoist :: forall err (eff :: (* -> *) -> * -> *) err' (r :: EffectRow) a.
Members '[Resumable err eff, Stop err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist err -> err'
f =
  forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
(err -> Sem r a) -> Sem (eff : r) a -> Sem r a
resuming (forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop forall b c a. (b -> c) -> (a -> b) -> a -> c
. err -> err'
f)
{-# inline resumeHoist #-}

-- | Variant of 'resumeHoist' that uses a constant value.
resumeHoistAs ::
  ∀ err eff err' r .
  Members [Resumable err eff, Stop err'] r =>
  err' ->
  InterpreterFor eff r
resumeHoistAs :: forall err (eff :: (* -> *) -> * -> *) err' (r :: EffectRow).
Members '[Resumable err eff, Stop err'] r =>
err' -> InterpreterFor eff r
resumeHoistAs err'
err =
  forall err (eff :: (* -> *) -> * -> *) err' (r :: EffectRow) a.
Members '[Resumable err eff, Stop err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist @err (forall a b. a -> b -> a
const err'
err)
{-# inline resumeHoistAs #-}

-- | Variant of 'resumeHoist' that uses the unchanged error.
restop ::
  ∀ err eff r .
  Members [Resumable err eff, Stop err] r =>
  InterpreterFor eff r
restop :: forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
restop =
  forall err (eff :: (* -> *) -> * -> *) err' (r :: EffectRow) a.
Members '[Resumable err eff, Stop err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist @err forall a. a -> a
id
{-# inline restop #-}

-- | Variant of 'resume' that immediately produces an 'Either'.
resumeEither ::
  ∀ err eff r a .
  Member (Resumable err eff) r =>
  Sem (eff : r) a ->
  Sem r (Either err a)
resumeEither :: forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> Sem r (Either err a)
resumeEither Sem (eff : r) a
ma =
  forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
(err -> Sem r a) -> Sem (eff : r) a -> Sem r a
resuming (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 a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem (eff : r) a
ma)

-- | Variant of 'resume' that takes a branch for error and success.
-- This allows the success branch to contain other resumptions.
--
-- @since 0.2.0.0
resumeOr ::
  ∀ err eff r a b .
  Member (Resumable err eff) r =>
  Sem (eff : r) a ->
  (a -> Sem r b) ->
  (err -> Sem r b) ->
  Sem r b
resumeOr :: forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a b.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (a -> Sem r b) -> (err -> Sem r b) -> Sem r b
resumeOr Sem (eff : r) a
ma a -> Sem r b
fb err -> Sem r b
err =
  forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> Sem r (Either err a)
resumeEither Sem (eff : r) a
ma forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right a
a -> a -> Sem r b
fb a
a
    Left err
e -> err -> Sem r b
err err
e

-- | Variant of 'resuming' that takes a branch for error and success.
-- This allows the success branch to contain other resumptions.
--
-- @since 0.2.0.0
resumingOr ::
  ∀ err eff r a b .
  Member (Resumable err eff) r =>
  (err -> Sem r b) ->
  Sem (eff : r) a ->
  (a -> Sem r b) ->
  Sem r b
resumingOr :: forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a b.
Member (Resumable err eff) r =>
(err -> Sem r b) -> Sem (eff : r) a -> (a -> Sem r b) -> Sem r b
resumingOr err -> Sem r b
err Sem (eff : r) a
ma a -> Sem r b
fb =
  forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a b.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (a -> Sem r b) -> (err -> Sem r b) -> Sem r b
resumeOr Sem (eff : r) a
ma a -> Sem r b
fb err -> Sem r b
err

-- | Variant of 'resume' that propagates the error to an 'Error' effect after applying a function.
resumeHoistError ::
  ∀ err eff err' r a .
  Members [Resumable err eff, Error err'] r =>
  (err -> err') ->
  Sem (eff : r) a ->
  Sem r a
resumeHoistError :: forall err (eff :: (* -> *) -> * -> *) err' (r :: EffectRow) a.
Members '[Resumable err eff, Error err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoistError err -> err'
f =
  forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
(err -> Sem r a) -> Sem (eff : r) a -> Sem r a
resuming (forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw forall b c a. (b -> c) -> (a -> b) -> a -> c
. err -> err'
f)
{-# inline resumeHoistError #-}

-- | Variant of 'resumeHoistError' that uses the unchanged error.
resumeHoistErrorAs ::
  ∀ err eff err' r a .
  Members [Resumable err eff, Error err'] r =>
  err' ->
  Sem (eff : r) a ->
  Sem r a
resumeHoistErrorAs :: forall err (eff :: (* -> *) -> * -> *) err' (r :: EffectRow) a.
Members '[Resumable err eff, Error err'] r =>
err' -> Sem (eff : r) a -> Sem r a
resumeHoistErrorAs err'
err =
  forall err (eff :: (* -> *) -> * -> *) err' (r :: EffectRow) a.
Members '[Resumable err eff, Error err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoistError @err (forall a b. a -> b -> a
const err'
err)
{-# inline resumeHoistErrorAs #-}

-- | Variant of 'resumeHoistError' that uses the unchanged error.
resumeError ::
  ∀ err eff r a .
  Members [Resumable err eff, Error err] r =>
  Sem (eff : r) a ->
  Sem r a
resumeError :: forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Members '[Resumable err eff, Error err] r =>
Sem (eff : r) a -> Sem r a
resumeError =
  forall err (eff :: (* -> *) -> * -> *) err' (r :: EffectRow) a.
Members '[Resumable err eff, Error err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoistError @err forall a. a -> a
id
{-# inline resumeError #-}

-- | Transform 'Stop' to 'Fail' using the supplied error message rendering function.
stopToFailWith ::
  ∀ err r .
  Member Fail r =>
  (err -> Text) ->
  InterpreterFor (Stop err) r
stopToFailWith :: forall err (r :: EffectRow).
Member Fail r =>
(err -> Text) -> InterpreterFor (Stop err) r
stopToFailWith err -> Text
f =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToString a => a -> String
toString forall b c a. (b -> c) -> (a -> b) -> a -> c
. err -> Text
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 :: EffectRow) a.
Sem (Stop err : r) a -> Sem r (Either err a)
runStop
{-# inline stopToFailWith #-}

-- | Resume a computation, converting 'Stop' to 'Fail'.
resumeFailWith ::
  ∀ err eff r .
  Members [Fail, Resumable err eff] r =>
  (err -> Text) ->
  InterpreterFor eff r
resumeFailWith :: forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
Members '[Fail, Resumable err eff] r =>
(err -> Text) -> InterpreterFor eff r
resumeFailWith err -> Text
f =
  forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
(err -> Sem r a) -> Sem (eff : r) a -> Sem r a
resuming (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToString a => a -> String
toString forall b c a. (b -> c) -> (a -> b) -> a -> c
. err -> Text
f)
{-# inline resumeFailWith #-}

-- | Transform 'Stop' to 'Fail' using 'show'.
stopToFail ::
  ∀ err r .
  Show err =>
  Member Fail r =>
  InterpreterFor (Stop err) r
stopToFail :: forall err (r :: EffectRow).
(Show err, Member Fail r) =>
InterpreterFor (Stop err) r
stopToFail =
  forall err (r :: EffectRow).
Member Fail r =>
(err -> Text) -> InterpreterFor (Stop err) r
stopToFailWith forall b a. (Show a, IsString b) => a -> b
show
{-# inline stopToFail #-}

-- | Resume a computation, converting 'Stop' to 'Fail' using 'show'.
resumeFail ::
  ∀ err eff r .
  Show err =>
  Members [Fail, Resumable err eff] r =>
  InterpreterFor eff r
resumeFail :: forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
(Show err, Members '[Fail, Resumable err eff] r) =>
InterpreterFor eff r
resumeFail =
  forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
Members '[Fail, Resumable err eff] r =>
(err -> Text) -> InterpreterFor eff r
resumeFailWith @err forall b a. (Show a, IsString b) => a -> b
show
{-# inline resumeFail #-}