module Polysemy.Resume.Resume where

import Polysemy (raiseUnder)
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@.
-- This 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 :: Sem (eff : r) a
sem handler :: 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 (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 #-}

-- |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 #-}

-- |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
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 \ _ -> a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
{-# INLINE resumeAs #-}

-- |Variant of 'resume' that propagates the error to another 'Stop' effect after applying a function.
resumeHoist ::
   err err' eff 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 f :: 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 err' eff r a .
  Members [Resumable err eff, Stop err'] r =>
  err' ->
  Sem (eff : r) a ->
  Sem r a
resumeHoistAs :: err' -> Sem (eff : r) a -> Sem r a
resumeHoistAs err :: err'
err =
  (err -> err') -> Sem (eff : r) a -> Sem r a
forall err err' (eff :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
Members '[Resumable err eff, Stop err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist (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 a .
  Members [Resumable err eff, Stop err] r =>
  Sem (eff : r) a ->
  Sem r a
restop :: Sem (eff : r) a -> Sem r a
restop =
  (err -> err) -> Sem (eff : r) a -> Sem r a
forall err err' (eff :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
Members '[Resumable err eff, Stop err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist err -> err
forall a. a -> a
id
{-# INLINE restop #-}

-- |Variant of 'resume' that propagates the error to an 'Error' effect after applying a function.
resumeHoistError ::
   err err' eff 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 f :: 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 err' eff 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 -> err') -> Sem (eff : r) a -> Sem r a
forall err err' (eff :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
Members '[Resumable err eff, Error err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoistError (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 err' (eff :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
Members '[Resumable err eff, Error err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoistError err -> err
forall a. a -> a
id
{-# INLINE resumeError #-}