\begin{comment}
\begin{code}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}

module LiveCoding.Exceptions
  ( module LiveCoding.Exceptions
  , module Control.Monad.Trans.Except
  ) where
-- TODO Don't export newtype CellExcept and Functor here and haddock mark it

-- base
import Control.Arrow
import Data.Data

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

-- essence-of-live-coding
import LiveCoding.Cell
import LiveCoding.Cell.Monad.Trans

\end{code}
\end{comment}

\paragraph{Throwing Exceptions}
No new concepts beyond the function \mintinline{haskell}{throwE :: Monad m => e -> ExceptT e m a}
from the package \texttt{transformers} \cite{jones1995functional, transformers} are needed:
\begin{code}
throwC
  :: Monad m
  => Cell (ExceptT e m) e arbitrary
throwC :: Cell (ExceptT e m) e arbitrary
throwC = (e -> ExceptT e m arbitrary) -> Cell (ExceptT e m) e arbitrary
forall a (m :: * -> *) b. (a -> m b) -> Cell m a b
arrM e -> ExceptT e m arbitrary
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE
\end{code}
The above function simply throws the incoming exception.
To do this only if a condition is satisfied,
\mintinline{haskell}{if}-constructs can be used.
For example, this cell forwards its input for a given number of seconds,
and then throws an exception:
\begin{code}
wait
  :: Monad            m
  => Double
  -> Cell (ExceptT () m) a a
wait :: Double -> Cell (ExceptT () m) a a
wait Double
tMax = proc a
a -> do
  Double
t <- Cell (ExceptT () m) () Double
forall a (m :: * -> *) b.
(Data a, Fractional a, Monad m) =>
Cell m b a
localTime -< ()
  if Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
tMax
    then Cell (ExceptT () m) () a
forall (m :: * -> *) e arbitrary.
Monad m =>
Cell (ExceptT e m) e arbitrary
throwC  -< ()
    else Cell (ExceptT () m) a a
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a
a
\end{code}

\begin{comment}
\begin{code}
throwIf :: Monad m => (a -> Bool) -> e -> Cell (ExceptT e m) a a
throwIf :: (a -> Bool) -> e -> Cell (ExceptT e m) a a
throwIf a -> Bool
condition e
e = proc a
a -> do
  if a -> Bool
condition a
a
  then Cell (ExceptT e m) e a
forall (m :: * -> *) e arbitrary.
Monad m =>
Cell (ExceptT e m) e arbitrary
throwC  -< e
e
  else Cell (ExceptT e m) a a
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a
a

throwIf_ :: Monad m => (a -> Bool) -> Cell (ExceptT () m) a a
throwIf_ :: (a -> Bool) -> Cell (ExceptT () m) a a
throwIf_ a -> Bool
condition = (a -> Bool) -> () -> Cell (ExceptT () m) a a
forall (m :: * -> *) a e.
Monad m =>
(a -> Bool) -> e -> Cell (ExceptT e m) a a
throwIf a -> Bool
condition ()

-- | When the incoming value is @'Right' a@, forward it.
--   When it is @'Left' e@, throw it as an exception.
--   Compare with 'except'.
exceptC :: Monad m => Cell (ExceptT e m) (Either e a) a
exceptC :: Cell (ExceptT e m) (Either e a) a
exceptC = proc Either e a
ea -> do
  case Either e a
ea of
    Left e
e -> Cell (ExceptT e m) e a
forall (m :: * -> *) e arbitrary.
Monad m =>
Cell (ExceptT e m) e arbitrary
throwC -< e
e
    Right a
a -> Cell (ExceptT e m) a a
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a
a
\end{code}
\end{comment}

\paragraph{Handling Exceptions}
In usual Haskell, the \mintinline{haskell}{ExceptT} monad transformer is handled by running it:
\begin{spec}
runExceptT :: ExceptT e m b -> m (Either e b)
\end{spec}
The caller can now decide how to handle the value \mintinline{haskell}{e},
should it occur.
This approach can be adapted to cells.
A function is supplied that runs the \mintinline{haskell}{ExceptT e} layer:
\begin{code}
runExceptC
  :: (Data e, Monad m)
  => Cell (ExceptT e m) a           b
  -> Cell            m  a (Either e b)
\end{code}
To appreciate its inner workings,
let us again look at the state it encapsulates:
\begin{code}
data ExceptState state e
  = NotThrown state
  | Exception e
  deriving Typeable (ExceptState state e)
DataType
Constr
Typeable (ExceptState state e)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> ExceptState state e
    -> c (ExceptState state e))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (ExceptState state e))
-> (ExceptState state e -> Constr)
-> (ExceptState state e -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (ExceptState state e)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (ExceptState state e)))
-> ((forall b. Data b => b -> b)
    -> ExceptState state e -> ExceptState state e)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ExceptState state e -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ExceptState state e -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ExceptState state e -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ExceptState state e -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ExceptState state e -> m (ExceptState state e))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ExceptState state e -> m (ExceptState state e))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ExceptState state e -> m (ExceptState state e))
-> Data (ExceptState state e)
ExceptState state e -> DataType
ExceptState state e -> Constr
(forall b. Data b => b -> b)
-> ExceptState state e -> ExceptState state e
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ExceptState state e
-> c (ExceptState state e)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ExceptState state e)
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ExceptState state e))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ExceptState state e -> u
forall u.
(forall d. Data d => d -> u) -> ExceptState state e -> [u]
forall state e.
(Data state, Data e) =>
Typeable (ExceptState state e)
forall state e.
(Data state, Data e) =>
ExceptState state e -> DataType
forall state e.
(Data state, Data e) =>
ExceptState state e -> Constr
forall state e.
(Data state, Data e) =>
(forall b. Data b => b -> b)
-> ExceptState state e -> ExceptState state e
forall state e u.
(Data state, Data e) =>
Int -> (forall d. Data d => d -> u) -> ExceptState state e -> u
forall state e u.
(Data state, Data e) =>
(forall d. Data d => d -> u) -> ExceptState state e -> [u]
forall state e r r'.
(Data state, Data e) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExceptState state e -> r
forall state e r r'.
(Data state, Data e) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExceptState state e -> r
forall state e (m :: * -> *).
(Data state, Data e, Monad m) =>
(forall d. Data d => d -> m d)
-> ExceptState state e -> m (ExceptState state e)
forall state e (m :: * -> *).
(Data state, Data e, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ExceptState state e -> m (ExceptState state e)
forall state e (c :: * -> *).
(Data state, Data e) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ExceptState state e)
forall state e (c :: * -> *).
(Data state, Data e) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ExceptState state e
-> c (ExceptState state e)
forall state e (t :: * -> *) (c :: * -> *).
(Data state, Data e, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ExceptState state e))
forall state e (t :: * -> * -> *) (c :: * -> *).
(Data state, Data e, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ExceptState state e))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExceptState state e -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExceptState state e -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ExceptState state e -> m (ExceptState state e)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExceptState state e -> m (ExceptState state e)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ExceptState state e)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ExceptState state e
-> c (ExceptState state e)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ExceptState state e))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ExceptState state e))
$cException :: Constr
$cNotThrown :: Constr
$tExceptState :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ExceptState state e -> m (ExceptState state e)
$cgmapMo :: forall state e (m :: * -> *).
(Data state, Data e, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ExceptState state e -> m (ExceptState state e)
gmapMp :: (forall d. Data d => d -> m d)
-> ExceptState state e -> m (ExceptState state e)
$cgmapMp :: forall state e (m :: * -> *).
(Data state, Data e, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ExceptState state e -> m (ExceptState state e)
gmapM :: (forall d. Data d => d -> m d)
-> ExceptState state e -> m (ExceptState state e)
$cgmapM :: forall state e (m :: * -> *).
(Data state, Data e, Monad m) =>
(forall d. Data d => d -> m d)
-> ExceptState state e -> m (ExceptState state e)
gmapQi :: Int -> (forall d. Data d => d -> u) -> ExceptState state e -> u
$cgmapQi :: forall state e u.
(Data state, Data e) =>
Int -> (forall d. Data d => d -> u) -> ExceptState state e -> u
gmapQ :: (forall d. Data d => d -> u) -> ExceptState state e -> [u]
$cgmapQ :: forall state e u.
(Data state, Data e) =>
(forall d. Data d => d -> u) -> ExceptState state e -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExceptState state e -> r
$cgmapQr :: forall state e r r'.
(Data state, Data e) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExceptState state e -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExceptState state e -> r
$cgmapQl :: forall state e r r'.
(Data state, Data e) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExceptState state e -> r
gmapT :: (forall b. Data b => b -> b)
-> ExceptState state e -> ExceptState state e
$cgmapT :: forall state e.
(Data state, Data e) =>
(forall b. Data b => b -> b)
-> ExceptState state e -> ExceptState state e
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ExceptState state e))
$cdataCast2 :: forall state e (t :: * -> * -> *) (c :: * -> *).
(Data state, Data e, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ExceptState state e))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (ExceptState state e))
$cdataCast1 :: forall state e (t :: * -> *) (c :: * -> *).
(Data state, Data e, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ExceptState state e))
dataTypeOf :: ExceptState state e -> DataType
$cdataTypeOf :: forall state e.
(Data state, Data e) =>
ExceptState state e -> DataType
toConstr :: ExceptState state e -> Constr
$ctoConstr :: forall state e.
(Data state, Data e) =>
ExceptState state e -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ExceptState state e)
$cgunfold :: forall state e (c :: * -> *).
(Data state, Data e) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ExceptState state e)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ExceptState state e
-> c (ExceptState state e)
$cgfoldl :: forall state e (c :: * -> *).
(Data state, Data e) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ExceptState state e
-> c (ExceptState state e)
$cp1Data :: forall state e.
(Data state, Data e) =>
Typeable (ExceptState state e)
Data
\end{code}
As long as no exception occurred,
\mintinline{haskell}{runExceptC cell} simply stores the state of \mintinline{haskell}{cell},
wrapped in the constructor \mintinline{haskell}{NotThrown}.
The output value \mintinline{haskell}{b} is passed on.
As soon as the exception \mintinline{haskell}{e} is thrown,
the state switches to \mintinline{haskell}{Exception e},
and the exception is output forever.
\begin{comment}
\begin{code}
runExceptC :: Cell (ExceptT e m) a b -> Cell m a (Either e b)
runExceptC (Cell s
state s -> a -> ExceptT e m (b, s)
step) = Cell :: forall (m :: * -> *) a b s.
Data s =>
s -> (s -> a -> m (b, s)) -> Cell m a b
Cell { ExceptState s e
ExceptState s e -> a -> m (Either e b, ExceptState s e)
forall e. ExceptState s e
cellStep :: ExceptState s e -> a -> m (Either e b, ExceptState s e)
cellState :: ExceptState s e
cellStep :: ExceptState s e -> a -> m (Either e b, ExceptState s e)
cellState :: forall e. ExceptState s e
.. }
  where
    cellState :: ExceptState s e
cellState = s -> ExceptState s e
forall state e. state -> ExceptState state e
NotThrown s
state
    cellStep :: ExceptState s e -> a -> m (Either e b, ExceptState s e)
cellStep (NotThrown s
s) a
a = do
      Either e (b, s)
stateExcept <- ExceptT e m (b, s) -> m (Either e (b, s))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e m (b, s) -> m (Either e (b, s)))
-> ExceptT e m (b, s) -> m (Either e (b, s))
forall a b. (a -> b) -> a -> b
$ s -> a -> ExceptT e m (b, s)
step s
s a
a
      case Either e (b, s)
stateExcept of
        Right (!b
b, s
s')
          -> (Either e b, ExceptState s e) -> m (Either e b, ExceptState s e)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either e b
forall a b. b -> Either a b
Right b
b, s -> ExceptState s e
forall state e. state -> ExceptState state e
NotThrown s
s')
        Left e
e
          -> ExceptState s e -> a -> m (Either e b, ExceptState s e)
cellStep (e -> ExceptState s e
forall state e. e -> ExceptState state e
Exception e
e) a
a
    cellStep (Exception e
e) a
_
      = (Either e b, ExceptState s e) -> m (Either e b, ExceptState s e)
forall (m :: * -> *) a. Monad m => a -> m a
return (e -> Either e b
forall a b. a -> Either a b
Left e
e, e -> ExceptState s e
forall state e. e -> ExceptState state e
Exception e
e)
runExceptC Cell (ExceptT e m) a b
cell = Cell (ExceptT e m) a b -> Cell m a (Either e b)
forall e (m :: * -> *) a b.
(Data e, Monad m) =>
Cell (ExceptT e m) a b -> Cell m a (Either e b)
runExceptC (Cell (ExceptT e m) a b -> Cell m a (Either e b))
-> Cell (ExceptT e m) a b -> Cell m a (Either e b)
forall a b. (a -> b) -> a -> b
$ Cell (ExceptT e m) a b -> Cell (ExceptT e m) a b
forall (m :: * -> *) a b. Functor m => Cell m a b -> Cell m a b
toCell Cell (ExceptT e m) a b
cell
\end{code}
\end{comment}

As soon as the exception is thrown,
we can ``live bind'' it to further cells as an extra input:
\begin{code}
(>>>=) :: (Data e1, Monad m)
  => Cell (ExceptT e1    m)      a  b
  -> Cell (ExceptT    e2 m) (e1, a) b
  -> Cell (ExceptT    e2 m)      a  b
>>>= :: Cell (ExceptT e1 m) a b
-> Cell (ExceptT e2 m) (e1, a) b -> Cell (ExceptT e2 m) a b
(>>>=) Cell (ExceptT e1 m) a b
cell1 Cell (ExceptT e2 m) (e1, a) b
cell2 = proc a
a -> do
  Either e1 b
eb <- Cell m a (Either e1 b) -> Cell (ExceptT e2 m) a (Either e1 b)
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a b.
(Monad m, MonadTrans t) =>
Cell m a b -> Cell (t m) a b
liftCell (Cell m a (Either e1 b) -> Cell (ExceptT e2 m) a (Either e1 b))
-> Cell m a (Either e1 b) -> Cell (ExceptT e2 m) a (Either e1 b)
forall a b. (a -> b) -> a -> b
$ Cell (ExceptT e1 m) a b -> Cell m a (Either e1 b)
forall e (m :: * -> *) a b.
(Data e, Monad m) =>
Cell (ExceptT e m) a b -> Cell m a (Either e b)
runExceptC Cell (ExceptT e1 m) a b
cell1 -< a
a
  case Either e1 b
eb of
    Right b
b -> Cell (ExceptT e2 m) b b
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< b
b
    Left e1
e  -> Cell (ExceptT e2 m) (e1, a) b
cell2   -< (e1
e, a
a)
\end{code}
\fxwarning{If we don't do reader here, why do it with foreverE?}
We run the exception effect of the first cell.
Before it has thrown an exception, its output is simply forwarded.
As soon as the exception is thrown, the second cell is activated and fed with the input and the thrown exception.

\begin{comment}
\begin{code}
(>>>==) :: (Data e1, Monad m)
  => Cell (ExceptT e1             m)  a b
  -> Cell (ReaderT e1 (ExceptT e2 m)) a b
  -> Cell             (ExceptT e2 m)  a b
>>>== :: Cell (ExceptT e1 m) a b
-> Cell (ReaderT e1 (ExceptT e2 m)) a b -> Cell (ExceptT e2 m) a b
(>>>==) Cell (ExceptT e1 m) a b
cell1 Cell (ReaderT e1 (ExceptT e2 m)) a b
cell2 = proc a
a -> do
  Either e1 b
eb <- Cell m a (Either e1 b) -> Cell (ExceptT e2 m) a (Either e1 b)
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a b.
(Monad m, MonadTrans t) =>
Cell m a b -> Cell (t m) a b
liftCell (Cell m a (Either e1 b) -> Cell (ExceptT e2 m) a (Either e1 b))
-> Cell m a (Either e1 b) -> Cell (ExceptT e2 m) a (Either e1 b)
forall a b. (a -> b) -> a -> b
$ Cell (ExceptT e1 m) a b -> Cell m a (Either e1 b)
forall e (m :: * -> *) a b.
(Data e, Monad m) =>
Cell (ExceptT e m) a b -> Cell m a (Either e b)
runExceptC Cell (ExceptT e1 m) a b
cell1 -< a
a
  case Either e1 b
eb of
    Left e1
e -> Cell (ReaderT e1 (ExceptT e2 m)) a b
-> Cell (ExceptT e2 m) (e1, a) b
forall (m :: * -> *) r a b.
Monad m =>
Cell (ReaderT r m) a b -> Cell m (r, a) b
runReaderC' Cell (ReaderT e1 (ExceptT e2 m)) a b
cell2 -< (e1
e, a
a)
    Right b
b -> Cell (ExceptT e2 m) b b
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< b
b
\end{code}
\end{comment}

\input{../essence-of-live-coding/src/LiveCoding/Preliminary/CellExcept/Newtype.lhs}