module Polysemy.Resume.Resume where

import Polysemy (raiseUnder, raiseUnder2)
import Polysemy.Error (throw)

import Polysemy.Resume.Data.Resumable (Resumable)
import Polysemy.Resume.Data.Stop (Stop, stop)
import Polysemy.Resume.Resumable (runAsResumable)
import Polysemy.Resume.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.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 :: Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
resume Sem (eff : r) a
sem err -> Sem r a
handler =
  (err -> Sem r a) -> (a -> Sem r a) -> Either err a -> Sem r a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either err -> Sem r a
handler a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either err a -> Sem r a) -> Sem r (Either err a) -> Sem r a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem (Stop err : r) a -> Sem r (Either err a)
forall e (r :: [(* -> *) -> * -> *]) a.
Sem (Stop e : r) a -> Sem r (Either e a)
runStop (Sem (eff : Stop err : r) a -> Sem (Stop err : r) a
forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
runAsResumable @err (Sem (eff : r) a -> Sem (eff : Stop err : r) a
forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) 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
!! :: Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
(!!) =
  Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       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 :: 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 =
  (err -> Sem (Resumable err eff : r) a)
-> (a -> Sem (Resumable err eff : r) a)
-> Either err a
-> Sem (Resumable err eff : r) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either err -> Sem (Resumable err eff : r) a
handler a -> Sem (Resumable err eff : r) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either err a -> Sem (Resumable err eff : r) a)
-> Sem (Resumable err eff : r) (Either err a)
-> Sem (Resumable err eff : r) a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem (Stop err : Resumable err eff : r) a
-> Sem (Resumable err eff : r) (Either err a)
forall e (r :: [(* -> *) -> * -> *]) a.
Sem (Stop e : r) a -> Sem r (Either e a)
runStop (Sem (eff : Stop err : Resumable err eff : r) a
-> Sem (Stop err : Resumable err eff : r) a
forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
runAsResumable @err (Sem (eff : r) a -> Sem (eff : Stop err : Resumable err eff : r) a
forall (e2 :: (* -> *) -> * -> *) (e3 :: (* -> *) -> * -> *)
       (e1 :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) 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 :: (err -> Sem r a) -> Sem (eff : r) a -> Sem r a
resuming =
  (Sem (eff : r) a -> (err -> Sem r a) -> Sem r a)
-> (err -> Sem r a) -> Sem (eff : r) a -> Sem r a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       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 :: (err -> Sem (Resumable err eff : r) a)
-> Sem (eff : r) a -> Sem (Resumable err eff : r) a
resumingRe =
  (Sem (eff : r) a
 -> (err -> Sem (Resumable err eff : r) a)
 -> Sem (Resumable err eff : r) a)
-> (err -> Sem (Resumable err eff : r) a)
-> Sem (eff : r) a
-> Sem (Resumable err eff : r) a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Sem (eff : r) a
-> (err -> Sem (Resumable err eff : r) a)
-> Sem (Resumable err eff : r) a
forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       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 :: a -> Sem (eff : r) a -> Sem r a
resumeAs a
a =
  (err -> Sem r a) -> Sem (eff : r) a -> Sem r a
forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       a.
Member (Resumable err eff) r =>
(err -> Sem r a) -> Sem (eff : r) a -> Sem r a
resuming @err \ err
_ -> a -> Sem r a
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
<! :: a -> Sem (eff : r) a -> Sem r a
(<!) =
  forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       a.
Member (Resumable err eff) r =>
a -> Sem (eff : r) a -> Sem r a
forall (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) 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
!> :: Sem (eff : r) a -> a -> Sem r a
(!>) =
  (a -> Sem (eff : r) a -> Sem r a)
-> Sem (eff : r) a -> a -> Sem r a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       a.
Member (Resumable err eff) r =>
a -> Sem (eff : r) a -> Sem r a
forall (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) 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_ :: Sem (eff : r) () -> Sem r ()
resume_ =
  () -> Sem (eff : r) () -> Sem r ()
forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       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 :: Sem (eff : r) a -> Sem r a -> Sem r a
resumeWith Sem (eff : r) a
ma Sem r a
ma' =
  Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
resume @err Sem (eff : r) a
ma (Sem r a -> err -> Sem r a
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
!>> :: Sem (eff : r) a -> Sem r a -> Sem r a
(!>>) =
  forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> Sem r a -> Sem r a
forall (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) 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 :: Sem r a -> Sem (eff : r) a -> Sem r a
resumingWith Sem r a
ma' Sem (eff : r) a
ma =
  Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
resume @err Sem (eff : r) a
ma (Sem r a -> err -> Sem r a
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
<<! :: Sem r a -> Sem (eff : r) a -> Sem r a
(<<!) =
  forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       a.
Member (Resumable err eff) r =>
Sem r a -> Sem (eff : r) a -> Sem r a
forall (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) 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 :: (err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist err -> err'
f =
  (err -> Sem r a) -> Sem (eff : r) a -> Sem r a
forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       a.
Member (Resumable err eff) r =>
(err -> Sem r a) -> Sem (eff : r) a -> Sem r a
resuming (err' -> Sem r a
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Stop e) r =>
e -> Sem r a
stop (err' -> Sem r a) -> (err -> err') -> err -> Sem r a
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 :: err' -> InterpreterFor eff r
resumeHoistAs err'
err =
  (err -> err') -> Sem (eff : r) a -> Sem r a
forall err (eff :: (* -> *) -> * -> *) err'
       (r :: [(* -> *) -> * -> *]) a.
Members '[Resumable err eff, Stop err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist @err (err' -> err -> 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 :: InterpreterFor eff r
restop =
  (err -> err) -> Sem (eff : r) a -> Sem r a
forall err (eff :: (* -> *) -> * -> *) err'
       (r :: [(* -> *) -> * -> *]) a.
Members '[Resumable err eff, Stop err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist @err err -> 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 :: Sem (eff : r) a -> Sem r (Either err a)
resumeEither Sem (eff : r) a
ma =
  (err -> Sem r (Either err a))
-> Sem (eff : r) (Either err a) -> Sem r (Either err a)
forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       a.
Member (Resumable err eff) r =>
(err -> Sem r a) -> Sem (eff : r) a -> Sem r a
resuming (Either err a -> Sem r (Either err a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either err a -> Sem r (Either err a))
-> (err -> Either err a) -> err -> Sem r (Either err a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. err -> Either err a
forall a b. a -> Either a b
Left) (a -> Either err a
forall a b. b -> Either a b
Right (a -> Either err a)
-> Sem (eff : r) a -> Sem (eff : r) (Either err a)
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 :: 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 =
  Sem (eff : r) a -> Sem r (Either err a)
forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> Sem r (Either err a)
resumeEither Sem (eff : r) a
ma Sem r (Either err a) -> (Either err a -> Sem r b) -> Sem r b
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 :: (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 =
  Sem (eff : r) a -> (a -> Sem r b) -> (err -> Sem r b) -> Sem r b
forall 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 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 :: (err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoistError err -> err'
f =
  (err -> Sem r a) -> Sem (eff : r) a -> Sem r a
forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       a.
Member (Resumable err eff) r =>
(err -> Sem r a) -> Sem (eff : r) a -> Sem r a
resuming (err' -> Sem r a
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw (err' -> Sem r a) -> (err -> err') -> err -> Sem r a
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 :: err' -> Sem (eff : r) a -> Sem r a
resumeHoistErrorAs err'
err =
  (err -> err') -> Sem (eff : r) a -> Sem r a
forall err (eff :: (* -> *) -> * -> *) err'
       (r :: [(* -> *) -> * -> *]) a.
Members '[Resumable err eff, Error err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoistError @err (err' -> err -> 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 :: Sem (eff : r) a -> Sem r a
resumeError =
  (err -> err) -> Sem (eff : r) a -> Sem r a
forall err (eff :: (* -> *) -> * -> *) err'
       (r :: [(* -> *) -> * -> *]) a.
Members '[Resumable err eff, Error err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoistError @err err -> err
forall a. a -> a
id
{-# inline resumeError #-}