{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{- | Live programs in the @'ExceptT' e m@ monad can stop execution by throwing an exception @e@.

Handling these exceptions is done by realising that live programs in fact form a monad in the exception type.
The interface is analogous to 'CellExcept'.
-}
module LiveCoding.LiveProgram.Except where

-- base
import Control.Monad (liftM, ap)
import Data.Data
import Data.Void (Void)

-- transformers
import Control.Monad.Trans.Except
import Control.Monad.Trans.Reader

-- essence-of-live-coding
import LiveCoding.Cell (hoistCell, toLiveCell, liveCell, constM)
import LiveCoding.CellExcept (CellExcept, runCellExcept, once_)
import LiveCoding.Exceptions.Finite (Finite)
import LiveCoding.Forever
import LiveCoding.LiveProgram
import qualified LiveCoding.CellExcept as CellExcept

{- | A live program that can throw an exception.

* @m@: The monad in which the live program operates.
* @e@: The type of exceptions the live program can eventually throw.

'LiveProgramExcept' is a monad in the exception type.
This means that it is possible to chain several live programs,
where later programs can handle the exceptions thrown by the earlier ones.
'return' plays the role of directly throwing an exception.
'(>>=)' lets a handler decide which program to handle the exception with.

The interface is the basically the same as 'CellExcept',
and it is in fact a newtype around it.
-}
newtype LiveProgramExcept m e = LiveProgramExcept
  { LiveProgramExcept m e -> CellExcept () () m e
unLiveProgramExcept :: CellExcept () () m e }
  deriving (a -> LiveProgramExcept m b -> LiveProgramExcept m a
(a -> b) -> LiveProgramExcept m a -> LiveProgramExcept m b
(forall a b.
 (a -> b) -> LiveProgramExcept m a -> LiveProgramExcept m b)
-> (forall a b.
    a -> LiveProgramExcept m b -> LiveProgramExcept m a)
-> Functor (LiveProgramExcept m)
forall a b. a -> LiveProgramExcept m b -> LiveProgramExcept m a
forall a b.
(a -> b) -> LiveProgramExcept m a -> LiveProgramExcept m b
forall (m :: * -> *) a b.
Monad m =>
a -> LiveProgramExcept m b -> LiveProgramExcept m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> LiveProgramExcept m a -> LiveProgramExcept m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LiveProgramExcept m b -> LiveProgramExcept m a
$c<$ :: forall (m :: * -> *) a b.
Monad m =>
a -> LiveProgramExcept m b -> LiveProgramExcept m a
fmap :: (a -> b) -> LiveProgramExcept m a -> LiveProgramExcept m b
$cfmap :: forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> LiveProgramExcept m a -> LiveProgramExcept m b
Functor, Functor (LiveProgramExcept m)
a -> LiveProgramExcept m a
Functor (LiveProgramExcept m)
-> (forall a. a -> LiveProgramExcept m a)
-> (forall a b.
    LiveProgramExcept m (a -> b)
    -> LiveProgramExcept m a -> LiveProgramExcept m b)
-> (forall a b c.
    (a -> b -> c)
    -> LiveProgramExcept m a
    -> LiveProgramExcept m b
    -> LiveProgramExcept m c)
-> (forall a b.
    LiveProgramExcept m a
    -> LiveProgramExcept m b -> LiveProgramExcept m b)
-> (forall a b.
    LiveProgramExcept m a
    -> LiveProgramExcept m b -> LiveProgramExcept m a)
-> Applicative (LiveProgramExcept m)
LiveProgramExcept m a
-> LiveProgramExcept m b -> LiveProgramExcept m b
LiveProgramExcept m a
-> LiveProgramExcept m b -> LiveProgramExcept m a
LiveProgramExcept m (a -> b)
-> LiveProgramExcept m a -> LiveProgramExcept m b
(a -> b -> c)
-> LiveProgramExcept m a
-> LiveProgramExcept m b
-> LiveProgramExcept m c
forall a. a -> LiveProgramExcept m a
forall a b.
LiveProgramExcept m a
-> LiveProgramExcept m b -> LiveProgramExcept m a
forall a b.
LiveProgramExcept m a
-> LiveProgramExcept m b -> LiveProgramExcept m b
forall a b.
LiveProgramExcept m (a -> b)
-> LiveProgramExcept m a -> LiveProgramExcept m b
forall a b c.
(a -> b -> c)
-> LiveProgramExcept m a
-> LiveProgramExcept m b
-> LiveProgramExcept m c
forall (m :: * -> *). Monad m => Functor (LiveProgramExcept m)
forall (m :: * -> *) a. Monad m => a -> LiveProgramExcept m a
forall (m :: * -> *) a b.
Monad m =>
LiveProgramExcept m a
-> LiveProgramExcept m b -> LiveProgramExcept m a
forall (m :: * -> *) a b.
Monad m =>
LiveProgramExcept m a
-> LiveProgramExcept m b -> LiveProgramExcept m b
forall (m :: * -> *) a b.
Monad m =>
LiveProgramExcept m (a -> b)
-> LiveProgramExcept m a -> LiveProgramExcept m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> LiveProgramExcept m a
-> LiveProgramExcept m b
-> LiveProgramExcept m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: LiveProgramExcept m a
-> LiveProgramExcept m b -> LiveProgramExcept m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
LiveProgramExcept m a
-> LiveProgramExcept m b -> LiveProgramExcept m a
*> :: LiveProgramExcept m a
-> LiveProgramExcept m b -> LiveProgramExcept m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
LiveProgramExcept m a
-> LiveProgramExcept m b -> LiveProgramExcept m b
liftA2 :: (a -> b -> c)
-> LiveProgramExcept m a
-> LiveProgramExcept m b
-> LiveProgramExcept m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> LiveProgramExcept m a
-> LiveProgramExcept m b
-> LiveProgramExcept m c
<*> :: LiveProgramExcept m (a -> b)
-> LiveProgramExcept m a -> LiveProgramExcept m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
LiveProgramExcept m (a -> b)
-> LiveProgramExcept m a -> LiveProgramExcept m b
pure :: a -> LiveProgramExcept m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> LiveProgramExcept m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (LiveProgramExcept m)
Applicative, Applicative (LiveProgramExcept m)
a -> LiveProgramExcept m a
Applicative (LiveProgramExcept m)
-> (forall a b.
    LiveProgramExcept m a
    -> (a -> LiveProgramExcept m b) -> LiveProgramExcept m b)
-> (forall a b.
    LiveProgramExcept m a
    -> LiveProgramExcept m b -> LiveProgramExcept m b)
-> (forall a. a -> LiveProgramExcept m a)
-> Monad (LiveProgramExcept m)
LiveProgramExcept m a
-> (a -> LiveProgramExcept m b) -> LiveProgramExcept m b
LiveProgramExcept m a
-> LiveProgramExcept m b -> LiveProgramExcept m b
forall a. a -> LiveProgramExcept m a
forall a b.
LiveProgramExcept m a
-> LiveProgramExcept m b -> LiveProgramExcept m b
forall a b.
LiveProgramExcept m a
-> (a -> LiveProgramExcept m b) -> LiveProgramExcept m b
forall (m :: * -> *). Monad m => Applicative (LiveProgramExcept m)
forall (m :: * -> *) a. Monad m => a -> LiveProgramExcept m a
forall (m :: * -> *) a b.
Monad m =>
LiveProgramExcept m a
-> LiveProgramExcept m b -> LiveProgramExcept m b
forall (m :: * -> *) a b.
Monad m =>
LiveProgramExcept m a
-> (a -> LiveProgramExcept m b) -> LiveProgramExcept m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> LiveProgramExcept m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> LiveProgramExcept m a
>> :: LiveProgramExcept m a
-> LiveProgramExcept m b -> LiveProgramExcept m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
LiveProgramExcept m a
-> LiveProgramExcept m b -> LiveProgramExcept m b
>>= :: LiveProgramExcept m a
-> (a -> LiveProgramExcept m b) -> LiveProgramExcept m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
LiveProgramExcept m a
-> (a -> LiveProgramExcept m b) -> LiveProgramExcept m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (LiveProgramExcept m)
Monad)

-- | Execute a 'LiveProgramExcept', throwing its exceptions in the 'ExceptT' monad.
runLiveProgramExcept
  :: Monad m
  => LiveProgramExcept m e
  -> LiveProgram (ExceptT e m)
runLiveProgramExcept :: LiveProgramExcept m e -> LiveProgram (ExceptT e m)
runLiveProgramExcept LiveProgramExcept { CellExcept () () m e
unLiveProgramExcept :: CellExcept () () m e
unLiveProgramExcept :: forall (m :: * -> *) e.
LiveProgramExcept m e -> CellExcept () () m e
.. } = Cell (ExceptT e m) () () -> LiveProgram (ExceptT e m)
forall (m :: * -> *). Monad m => Cell m () () -> LiveProgram m
liveCell (Cell (ExceptT e m) () () -> LiveProgram (ExceptT e m))
-> Cell (ExceptT e m) () () -> LiveProgram (ExceptT e m)
forall a b. (a -> b) -> a -> b
$ CellExcept () () m e -> Cell (ExceptT e m) () ()
forall (m :: * -> *) a b e.
Monad m =>
CellExcept a b m e -> Cell (ExceptT e m) a b
runCellExcept CellExcept () () m e
unLiveProgramExcept

{- | Lift a 'LiveProgram' into the 'LiveProgramExcept' monad.

Similar to 'LiveProgram.CellExcept.try'.
This will execute the live program until it throws an exception.
-}
try
  :: (Data e, Finite e, Functor m)
  => LiveProgram (ExceptT e m)
  -> LiveProgramExcept m e
try :: LiveProgram (ExceptT e m) -> LiveProgramExcept m e
try = CellExcept () () m e -> LiveProgramExcept m e
forall (m :: * -> *) e.
CellExcept () () m e -> LiveProgramExcept m e
LiveProgramExcept (CellExcept () () m e -> LiveProgramExcept m e)
-> (LiveProgram (ExceptT e m) -> CellExcept () () m e)
-> LiveProgram (ExceptT e m)
-> LiveProgramExcept m e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cell (ExceptT e m) () () -> CellExcept () () m e
forall e (m :: * -> *) a b.
(Data e, Finite e) =>
Cell (ExceptT e m) a b -> CellExcept a b m e
CellExcept.try (Cell (ExceptT e m) () () -> CellExcept () () m e)
-> (LiveProgram (ExceptT e m) -> Cell (ExceptT e m) () ())
-> LiveProgram (ExceptT e m)
-> CellExcept () () m e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LiveProgram (ExceptT e m) -> Cell (ExceptT e m) () ()
forall (m :: * -> *). Functor m => LiveProgram m -> Cell m () ()
toLiveCell

{- | Safely convert to 'LiveProgram's.

If the type of possible exceptions is empty,
no exceptions can be thrown,
and thus we can safely assume that it is a 'LiveProgram' in @m@.
-}
safely
  :: Monad m
  => LiveProgramExcept m Void
  -> LiveProgram m
safely :: LiveProgramExcept m Void -> LiveProgram m
safely = Cell m () () -> LiveProgram m
forall (m :: * -> *). Monad m => Cell m () () -> LiveProgram m
liveCell (Cell m () () -> LiveProgram m)
-> (LiveProgramExcept m Void -> Cell m () ())
-> LiveProgramExcept m Void
-> LiveProgram m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellExcept () () m Void -> Cell m () ()
forall (m :: * -> *) a b.
Monad m =>
CellExcept a b m Void -> Cell m a b
CellExcept.safely (CellExcept () () m Void -> Cell m () ())
-> (LiveProgramExcept m Void -> CellExcept () () m Void)
-> LiveProgramExcept m Void
-> Cell m () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LiveProgramExcept m Void -> CellExcept () () m Void
forall (m :: * -> *) e.
LiveProgramExcept m e -> CellExcept () () m e
unLiveProgramExcept

{- | Run a 'LiveProgram' as a 'LiveProgramExcept'.

This is always safe in the sense that it has no exceptions.
-}
safe
  :: Monad m
  => LiveProgram m
  -> LiveProgramExcept m Void
safe :: LiveProgram m -> LiveProgramExcept m Void
safe = CellExcept () () m Void -> LiveProgramExcept m Void
forall (m :: * -> *) e.
CellExcept () () m e -> LiveProgramExcept m e
LiveProgramExcept (CellExcept () () m Void -> LiveProgramExcept m Void)
-> (LiveProgram m -> CellExcept () () m Void)
-> LiveProgram m
-> LiveProgramExcept m Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cell m () () -> CellExcept () () m Void
forall (m :: * -> *) a b.
Monad m =>
Cell m a b -> CellExcept a b m Void
CellExcept.safe (Cell m () () -> CellExcept () () m Void)
-> (LiveProgram m -> Cell m () ())
-> LiveProgram m
-> CellExcept () () m Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LiveProgram m -> Cell m () ()
forall (m :: * -> *). Functor m => LiveProgram m -> Cell m () ()
toLiveCell

-- | Run a monadic action and immediately raise its result as an exception.
once :: (Monad m, Data e, Finite e) => m e -> LiveProgramExcept m e
once :: m e -> LiveProgramExcept m e
once = CellExcept () () m e -> LiveProgramExcept m e
forall (m :: * -> *) e.
CellExcept () () m e -> LiveProgramExcept m e
LiveProgramExcept (CellExcept () () m e -> LiveProgramExcept m e)
-> (m e -> CellExcept () () m e) -> m e -> LiveProgramExcept m e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m e -> CellExcept () () m e
forall (m :: * -> *) e a arbitrary.
(Monad m, Data e, Finite e) =>
m e -> CellExcept a arbitrary m e
once_

{- | Run a 'LiveProgramExcept' in a loop.

In the additional 'ReaderT e' context,
you can read the last thrown exception.
(For the first iteration, 'e' is set to the first argument to 'foreverELiveProgram'.)

This way, you can create an infinite loop,
with the exception as the loop variable.
-}
foreverELiveProgram
  :: (Data e, Monad m)
  => e -- ^ The loop initialisation
  -> LiveProgramExcept (ReaderT e m) e -- ^ The live program to execute indefinitely
  -> LiveProgram                  m
foreverELiveProgram :: e -> LiveProgramExcept (ReaderT e m) e -> LiveProgram m
foreverELiveProgram e
e LiveProgramExcept { CellExcept () () (ReaderT e m) e
unLiveProgramExcept :: CellExcept () () (ReaderT e m) e
unLiveProgramExcept :: forall (m :: * -> *) e.
LiveProgramExcept m e -> CellExcept () () m e
.. } = Cell m () () -> LiveProgram m
forall (m :: * -> *). Monad m => Cell m () () -> LiveProgram m
liveCell (Cell m () () -> LiveProgram m) -> Cell m () () -> LiveProgram m
forall a b. (a -> b) -> a -> b
$ e -> Cell (ReaderT e (ExceptT e m)) () () -> Cell m () ()
forall (m :: * -> *) e a b.
(Monad m, Data e) =>
e -> Cell (ReaderT e (ExceptT e m)) a b -> Cell m a b
foreverE e
e (Cell (ReaderT e (ExceptT e m)) () () -> Cell m () ())
-> Cell (ReaderT e (ExceptT e m)) () () -> Cell m () ()
forall a b. (a -> b) -> a -> b
$ (forall x. ExceptT e (ReaderT e m) x -> ReaderT e (ExceptT e m) x)
-> Cell (ExceptT e (ReaderT e m)) () ()
-> Cell (ReaderT e (ExceptT e m)) () ()
forall (m1 :: * -> *) (m2 :: * -> *) a b.
(forall x. m1 x -> m2 x) -> Cell m1 a b -> Cell m2 a b
hoistCell forall x. ExceptT e (ReaderT e m) x -> ReaderT e (ExceptT e m) x
forall e r (m :: * -> *) a.
ExceptT e (ReaderT r m) a -> ReaderT r (ExceptT e m) a
commute (Cell (ExceptT e (ReaderT e m)) () ()
 -> Cell (ReaderT e (ExceptT e m)) () ())
-> Cell (ExceptT e (ReaderT e m)) () ()
-> Cell (ReaderT e (ExceptT e m)) () ()
forall a b. (a -> b) -> a -> b
$ CellExcept () () (ReaderT e m) e
-> Cell (ExceptT e (ReaderT e m)) () ()
forall (m :: * -> *) a b e.
Monad m =>
CellExcept a b m e -> Cell (ExceptT e m) a b
runCellExcept CellExcept () () (ReaderT e m) e
unLiveProgramExcept
  where
    commute :: ExceptT e (ReaderT r m) a -> ReaderT r (ExceptT e m) a
    commute :: ExceptT e (ReaderT r m) a -> ReaderT r (ExceptT e m) a
commute ExceptT e (ReaderT r m) a
action = (r -> ExceptT e m a) -> ReaderT r (ExceptT e m) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> ExceptT e m a) -> ReaderT r (ExceptT e m) a)
-> (r -> ExceptT e m a) -> ReaderT r (ExceptT e m) a
forall a b. (a -> b) -> a -> b
$ m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> (r -> m (Either e a)) -> r -> ExceptT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT r m (Either e a) -> r -> m (Either e a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ExceptT e (ReaderT r m) a -> ReaderT r m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e (ReaderT r m) a
action)

-- | Run a 'LiveProgramExcept' in a loop, discarding the exception.
foreverCLiveProgram
  :: (Data e, Monad m)
  => LiveProgramExcept m e
  -> LiveProgram       m
foreverCLiveProgram :: LiveProgramExcept m e -> LiveProgram m
foreverCLiveProgram LiveProgramExcept { CellExcept () () m e
unLiveProgramExcept :: CellExcept () () m e
unLiveProgramExcept :: forall (m :: * -> *) e.
LiveProgramExcept m e -> CellExcept () () m e
.. } = Cell m () () -> LiveProgram m
forall (m :: * -> *). Monad m => Cell m () () -> LiveProgram m
liveCell (Cell m () () -> LiveProgram m) -> Cell m () () -> LiveProgram m
forall a b. (a -> b) -> a -> b
$ Cell (ExceptT e m) () () -> Cell m () ()
forall e (m :: * -> *) a b.
(Data e, Monad m) =>
Cell (ExceptT e m) a b -> Cell m a b
foreverC (Cell (ExceptT e m) () () -> Cell m () ())
-> Cell (ExceptT e m) () () -> Cell m () ()
forall a b. (a -> b) -> a -> b
$ CellExcept () () m e -> Cell (ExceptT e m) () ()
forall (m :: * -> *) a b e.
Monad m =>
CellExcept a b m e -> Cell (ExceptT e m) a b
runCellExcept CellExcept () () m e
unLiveProgramExcept