\begin{comment}
\begin{code}
{-# LANGUAGE GADTs #-}

module LiveCoding.CellExcept where

-- base
import Control.Monad
import Data.Data
import Data.Void

-- transformers
import Control.Monad.Trans.Except

-- mmorph
import Control.Monad.Morph

-- essence-of-live-coding
import LiveCoding.Cell
import LiveCoding.Exceptions
import LiveCoding.Exceptions.Finite
\end{code}
\end{comment}

We can save on boiler plate by dropping the Coyoneda embedding for an ``operational'' monad:
\fxerror{Cite operational}
\fxerror{Move the following code into appendix?}
\begin{code}
data CellExcept a b m e where
  Return :: e -> CellExcept a b m e
  Bind
    :: CellExcept a b m e1
    -> (e1 -> CellExcept a b m e2)
    -> CellExcept a b m e2
  Try
    :: (Data e, Finite e)
    => Cell (ExceptT e m) a b
    -> CellExcept a b m e
\end{code}

\begin{comment}
\begin{code}
instance Monad m => Functor (CellExcept a b m) where
  fmap :: (a -> b) -> CellExcept a b m a -> CellExcept a b m b
fmap = (a -> b) -> CellExcept a b m a -> CellExcept a b m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Monad m => Applicative (CellExcept a b m) where
  pure :: a -> CellExcept a b m a
pure = a -> CellExcept a b m a
forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: CellExcept a b m (a -> b)
-> CellExcept a b m a -> CellExcept a b m b
(<*>) = CellExcept a b m (a -> b)
-> CellExcept a b m a -> CellExcept a b m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance MFunctor (CellExcept a b) where
  hoist :: (forall a. m a -> n a) -> CellExcept a b m b -> CellExcept a b n b
hoist forall a. m a -> n a
morphism (Return b
e) = b -> CellExcept a b n b
forall e a b (m :: * -> *). e -> CellExcept a b m e
Return b
e
  hoist forall a. m a -> n a
morphism (Bind CellExcept a b m e1
action e1 -> CellExcept a b m b
cont) = CellExcept a b n e1
-> (e1 -> CellExcept a b n b) -> CellExcept a b n b
forall a b (m :: * -> *) e1 e2.
CellExcept a b m e1
-> (e1 -> CellExcept a b m e2) -> CellExcept a b m e2
Bind
    ((forall a. m a -> n a)
-> CellExcept a b m e1 -> CellExcept a b n e1
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> n a
morphism CellExcept a b m e1
action)
    ((forall a. m a -> n a) -> CellExcept a b m b -> CellExcept a b n b
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> n a
morphism (CellExcept a b m b -> CellExcept a b n b)
-> (e1 -> CellExcept a b m b) -> e1 -> CellExcept a b n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e1 -> CellExcept a b m b
cont)
  hoist forall a. m a -> n a
morphism (Try Cell (ExceptT b m) a b
cell) = Cell (ExceptT b n) a b -> CellExcept a b n b
forall e (m :: * -> *) a b.
(Data e, Finite e) =>
Cell (ExceptT e m) a b -> CellExcept a b m e
Try (Cell (ExceptT b n) a b -> CellExcept a b n b)
-> Cell (ExceptT b n) a b -> CellExcept a b n b
forall a b. (a -> b) -> a -> b
$ (forall x. ExceptT b m x -> ExceptT b n x)
-> Cell (ExceptT b m) a b -> Cell (ExceptT b n) a b
forall (m1 :: * -> *) (m2 :: * -> *) a b.
(forall x. m1 x -> m2 x) -> Cell m1 a b -> Cell m2 a b
hoistCell ((m (Either b x) -> n (Either b x))
-> ExceptT b m x -> ExceptT b n x
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT m (Either b x) -> n (Either b x)
forall a. m a -> n a
morphism) Cell (ExceptT b m) a b
cell
\end{code}
\end{comment}
The \mintinline{haskell}{Monad} instance is now trivial:
\begin{code}
instance Monad m => Monad (CellExcept a b m) where
  return :: a -> CellExcept a b m a
return = a -> CellExcept a b m a
forall e a b (m :: * -> *). e -> CellExcept a b m e
Return
  >>= :: CellExcept a b m a
-> (a -> CellExcept a b m b) -> CellExcept a b m b
(>>=) = CellExcept a b m a
-> (a -> CellExcept a b m b) -> CellExcept a b m b
forall a b (m :: * -> *) e1 e2.
CellExcept a b m e1
-> (e1 -> CellExcept a b m e2) -> CellExcept a b m e2
Bind
\end{code}
As is typical for operational monads, all of the effort now goes into the interpretation function:
\begin{code}
runCellExcept
  :: Monad m
  => CellExcept a b m e
  -> Cell (ExceptT e m) a b
\end{code}
\begin{spec}
runCellExcept (Bind (Try cell) g)
  = cell >>>= commute (runCellExcept . g)
runCellExcept ... = ...
\end{spec}
\begin{comment}
\begin{code}
runCellExcept :: CellExcept a b m e -> Cell (ExceptT e m) a b
runCellExcept (Return e
e) = ExceptT e m b -> Cell (ExceptT e m) a b
forall (m :: * -> *) b a. m b -> Cell m a b
constM (ExceptT e m b -> Cell (ExceptT e m) a b)
-> ExceptT e m b -> Cell (ExceptT e m) a b
forall a b. (a -> b) -> a -> b
$ e -> ExceptT e m b
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE e
e
runCellExcept (Try Cell (ExceptT e m) a b
cell) = Cell (ExceptT e m) a b
cell
runCellExcept (Bind (Try Cell (ExceptT e1 m) a b
cell) e1 -> CellExcept a b m e
g) = Cell (ExceptT e1 m) a b
cell Cell (ExceptT e1 m) a b
-> Cell (ReaderT e1 (ExceptT e m)) a b -> Cell (ExceptT e m) a b
forall e1 (m :: * -> *) a b e2.
(Data e1, Monad m) =>
Cell (ExceptT e1 m) a b
-> Cell (ReaderT e1 (ExceptT e2 m)) a b -> Cell (ExceptT e2 m) a b
>>>== (e1 -> Cell (ExceptT e m) a b)
-> Cell (ReaderT e1 (ExceptT e m)) a b
forall e (m :: * -> *) a b.
(Finite e, Monad m) =>
(e -> Cell m a b) -> Cell (ReaderT e m) a b
commute (CellExcept a b m e -> Cell (ExceptT e m) a b
forall (m :: * -> *) a b e.
Monad m =>
CellExcept a b m e -> Cell (ExceptT e m) a b
runCellExcept (CellExcept a b m e -> Cell (ExceptT e m) a b)
-> (e1 -> CellExcept a b m e) -> e1 -> Cell (ExceptT e m) a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e1 -> CellExcept a b m e
g)
runCellExcept (Bind (Return e1
e) e1 -> CellExcept a b m e
f) = CellExcept a b m e -> Cell (ExceptT e m) a b
forall (m :: * -> *) a b e.
Monad m =>
CellExcept a b m e -> Cell (ExceptT e m) a b
runCellExcept (CellExcept a b m e -> Cell (ExceptT e m) a b)
-> CellExcept a b m e -> Cell (ExceptT e m) a b
forall a b. (a -> b) -> a -> b
$ e1 -> CellExcept a b m e
f e1
e
runCellExcept (Bind (Bind CellExcept a b m e1
ce e1 -> CellExcept a b m e1
f) e1 -> CellExcept a b m e
g) = CellExcept a b m e -> Cell (ExceptT e m) a b
forall (m :: * -> *) a b e.
Monad m =>
CellExcept a b m e -> Cell (ExceptT e m) a b
runCellExcept (CellExcept a b m e -> Cell (ExceptT e m) a b)
-> CellExcept a b m e -> Cell (ExceptT e m) a b
forall a b. (a -> b) -> a -> b
$ CellExcept a b m e1
-> (e1 -> CellExcept a b m e) -> CellExcept a b m e
forall a b (m :: * -> *) e1 e2.
CellExcept a b m e1
-> (e1 -> CellExcept a b m e2) -> CellExcept a b m e2
Bind CellExcept a b m e1
ce ((e1 -> CellExcept a b m e) -> CellExcept a b m e)
-> (e1 -> CellExcept a b m e) -> CellExcept a b m e
forall a b. (a -> b) -> a -> b
$ \e1
e -> CellExcept a b m e1
-> (e1 -> CellExcept a b m e) -> CellExcept a b m e
forall a b (m :: * -> *) e1 e2.
CellExcept a b m e1
-> (e1 -> CellExcept a b m e2) -> CellExcept a b m e2
Bind (e1 -> CellExcept a b m e1
f e1
e) e1 -> CellExcept a b m e
g
\end{code}
\end{comment}

As a slight restriction of the framework,
throwing exceptions is now only allowed for finite types:
\begin{code}
try
  :: (Data e, Finite e)
  => Cell (ExceptT e m) a b
  -> CellExcept a b m e
try :: Cell (ExceptT e m) a b -> CellExcept a b m e
try = Cell (ExceptT e m) a b -> CellExcept a b m e
forall e (m :: * -> *) a b.
(Data e, Finite e) =>
Cell (ExceptT e m) a b -> CellExcept a b m e
Try
\end{code}
In practice however, this is less often a limitation than first assumed,
since in the monad context,
calculations with all types are allowed again.
\fxerror{But the trouble remains that builtin types like Int and Double can't be thrown.}

\fxfatal{The rest is explained in the main article differently. Merge.}
\begin{comment}
\begin{code}
safely
  :: Monad      m
  => CellExcept a b m Void
  -> Cell       m a b
safely :: CellExcept a b m Void -> Cell m a b
safely = (forall x. ExceptT Void m x -> m x)
-> Cell (ExceptT Void m) a b -> Cell m a b
forall (m1 :: * -> *) (m2 :: * -> *) a b.
(forall x. m1 x -> m2 x) -> Cell m1 a b -> Cell m2 a b
hoistCell forall x. ExceptT Void m x -> m x
forall (m :: * -> *) a. Functor m => ExceptT Void m a -> m a
discardVoid (Cell (ExceptT Void m) a b -> Cell m a b)
-> (CellExcept a b m Void -> Cell (ExceptT Void m) a b)
-> CellExcept a b m Void
-> Cell m a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellExcept a b m Void -> Cell (ExceptT Void m) a b
forall (m :: * -> *) a b e.
Monad m =>
CellExcept a b m e -> Cell (ExceptT e m) a b
runCellExcept
discardVoid
  :: Functor      m
  => ExceptT Void m a
  ->              m a
discardVoid :: ExceptT Void m a -> m a
discardVoid
  = (Either Void a -> a) -> m (Either Void a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Void -> a) -> (a -> a) -> Either Void a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Void -> a
forall a. Void -> a
absurd a -> a
forall a. a -> a
id) (m (Either Void a) -> m a)
-> (ExceptT Void m a -> m (Either Void a))
-> ExceptT Void m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT Void m a -> m (Either Void a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
safe :: Monad m => Cell m a b -> CellExcept a b m Void
safe :: Cell m a b -> CellExcept a b m Void
safe Cell m a b
cell = Cell (ExceptT Void m) a b -> CellExcept a b m Void
forall e (m :: * -> *) a b.
(Data e, Finite e) =>
Cell (ExceptT e m) a b -> CellExcept a b m e
try (Cell (ExceptT Void m) a b -> CellExcept a b m Void)
-> Cell (ExceptT Void m) a b -> CellExcept a b m Void
forall a b. (a -> b) -> a -> b
$ Cell m a b -> Cell (ExceptT Void m) a b
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a b.
(Monad m, MonadTrans t) =>
Cell m a b -> Cell (t m) a b
liftCell Cell m a b
cell

-- | Run a monadic action and immediately raise its result as an exception.
once :: (Monad m, Data e, Finite e) => (a -> m e) -> CellExcept a arbitrary m e
once :: (a -> m e) -> CellExcept a arbitrary m e
once a -> m e
kleisli = Cell (ExceptT e m) a arbitrary -> CellExcept a arbitrary m e
forall e (m :: * -> *) a b.
(Data e, Finite e) =>
Cell (ExceptT e m) a b -> CellExcept a b m e
try (Cell (ExceptT e m) a arbitrary -> CellExcept a arbitrary m e)
-> Cell (ExceptT e m) a arbitrary -> CellExcept a arbitrary m e
forall a b. (a -> b) -> a -> b
$ (a -> ExceptT e m arbitrary) -> Cell (ExceptT e m) a arbitrary
forall a (m :: * -> *) b. (a -> m b) -> Cell m a b
arrM ((a -> ExceptT e m arbitrary) -> Cell (ExceptT e m) a arbitrary)
-> (a -> ExceptT e m arbitrary) -> Cell (ExceptT e m) a arbitrary
forall a b. (a -> b) -> a -> b
$ m (Either e arbitrary) -> ExceptT e m arbitrary
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e arbitrary) -> ExceptT e m arbitrary)
-> (a -> m (Either e arbitrary)) -> a -> ExceptT e m arbitrary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> Either e arbitrary
forall a b. a -> Either a b
Left (e -> Either e arbitrary) -> m e -> m (Either e arbitrary)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m e -> m (Either e arbitrary))
-> (a -> m e) -> a -> m (Either e arbitrary)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m e
kleisli

-- | Like 'once', but the action does not have an input.
once_ :: (Monad m, Data e, Finite e) => m e -> CellExcept a arbitrary m e
once_ :: m e -> CellExcept a arbitrary m e
once_ = (a -> m e) -> CellExcept a arbitrary m e
forall (m :: * -> *) e a arbitrary.
(Monad m, Data e, Finite e) =>
(a -> m e) -> CellExcept a arbitrary m e
once ((a -> m e) -> CellExcept a arbitrary m e)
-> (m e -> a -> m e) -> m e -> CellExcept a arbitrary m e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m e -> a -> m e
forall a b. a -> b -> a
const
\end{code}
\end{comment}