\begin{comment}
\begin{code}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards #-}

module LiveCoding.Forever where
-- base
import Control.Arrow
import Control.Concurrent (threadDelay)
import Control.Monad.Fix
import Data.Data
import Data.Void

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

-- essence-of-live-coding
import LiveCoding.Bind
import LiveCoding.Cell
import LiveCoding.Exceptions
import LiveCoding.CellExcept
import LiveCoding.LiveProgram

\end{code}
\end{comment}

\subsection{Exceptions Forever}

\fxwarning{Opportunity to call this an SF here (and elsewhere)}
What if we want to change between the oscillator and a waiting period indefinitely?
In other words, how do we repeatedly execute this action:
\begin{code}
sinesWaitAndTry
  :: MonadFix m
  => CellExcept () String m ()
sinesWaitAndTry :: forall (m :: * -> *). MonadFix m => CellExcept () String m ()
sinesWaitAndTry = do
  forall e (m :: * -> *) a b.
(Data e, Finite e) =>
Cell (ExceptT e m) a b -> CellExcept a b m e
try forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a b. a -> b -> a
const String
"Waiting...") forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (m :: * -> *) a.
Monad m =>
Double -> Cell (ExceptT () m) a a
wait Double
1
  forall e (m :: * -> *) a b.
(Data e, Finite e) =>
Cell (ExceptT e m) a b -> CellExcept a b m e
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadFix m => Double -> Cell m () Double
sine Double
5 forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Double -> String
asciiArt  forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (m :: * -> *) a.
Monad m =>
Double -> Cell (ExceptT () m) a a
wait Double
5
\end{code}
\fxwarning{wait is an unintuitive name. Sounds blocking. "forwardFor"?}
The one temptation we have to resist is to recurse in the \mintinline{haskell}{CellExcept} context to prove the absence of exceptions:
\begin{code}
sinesForever'
  :: MonadFix m
  => CellExcept () String m Void
sinesForever' :: forall (m :: * -> *). MonadFix m => CellExcept () String m Void
sinesForever' = do
  forall (m :: * -> *). MonadFix m => CellExcept () String m ()
sinesWaitAndTry
  forall (m :: * -> *). MonadFix m => CellExcept () String m Void
sinesForever'
\end{code}
It typechecks, but it does \emph{not} execute correctly.
\fxerror{Why does it hang? Does it really hang?}
As the initial state is built up,
this definition inquires about the initial state of all cells in the \mintinline{haskell}{do}-expression,
but the last one is again \mintinline{haskell}{sinesForever'},
and thus already initialising such a cell hangs in an infinite loop.
Using the standard function \mintinline{haskell}{forever :: Applicative f => f a -> f ()} has the same deficiency,
\fxerror{Have we tested that?}
as it is defined in the same way.

The resolution is an explicit loop operator,
and faith in the library user to remember to employ it.
\begin{code}
foreverE
  :: (Monad m, Data e)
  =>                e
  -> Cell (ReaderT  e (ExceptT e m)) a b
  -> Cell                        m   a b
\end{code}
The loop function receives as arguments an initial exception,
and a cell that is to be executed forever.
Of course, the monad \mintinline{haskell}{m} may again contain exceptions that can be used to break from this loop.
\begin{comment}
\begin{code}
foreverE :: 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 s
state s -> a -> ReaderT e (ExceptT e m) (b, s)
step) = Cell { ForeverE e s
ForeverE e s -> a -> m (b, ForeverE e s)
cellStep :: ForeverE e s -> a -> m (b, ForeverE e s)
cellState :: ForeverE e s
cellStep :: ForeverE e s -> a -> m (b, ForeverE e s)
cellState :: ForeverE e s
.. }
  where
    cellState :: ForeverE e s
cellState = ForeverE
      { lastException :: e
lastException = e
e
      , initState :: s
initState     = s
state
      , currentState :: s
currentState  = s
state
      }
    cellStep :: ForeverE e s -> a -> m (b, ForeverE e s)
cellStep f :: ForeverE e s
f@ForeverE { e
s
currentState :: s
initState :: s
lastException :: e
currentState :: forall e s. ForeverE e s -> s
initState :: forall e s. ForeverE e s -> s
lastException :: forall e s. ForeverE e s -> e
.. } a
a = do
      Either e (b, s)
continueExcept <- forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (s -> a -> ReaderT e (ExceptT e m) (b, s)
step s
currentState a
a) e
lastException
      case Either e (b, s)
continueExcept of
        Left e
e' -> ForeverE e s -> a -> m (b, ForeverE e s)
cellStep ForeverE e s
f { lastException :: e
lastException = e
e', currentState :: s
currentState = s
initState } a
a
        Right (b
b, s
state') -> forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, ForeverE e s
f { currentState :: s
currentState = s
state' })
foreverE e
e Cell (ReaderT e (ExceptT e m)) a b
cell = 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 forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b. Functor m => Cell m a b -> Cell m a b
toCell Cell (ReaderT e (ExceptT e m)) a b
cell
\end{code}
\end{comment}
Again, it is instructive to look at the internal state of the looped cell:
\begin{code}
data ForeverE e s = ForeverE
  { forall e s. ForeverE e s -> e
lastException :: e
  , forall e s. ForeverE e s -> s
initState     :: s
  , forall e s. ForeverE e s -> s
currentState  :: s
  }
  deriving ForeverE e s -> DataType
ForeverE e s -> Constr
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 {e} {s}. (Data e, Data s) => Typeable (ForeverE e s)
forall e s. (Data e, Data s) => ForeverE e s -> DataType
forall e s. (Data e, Data s) => ForeverE e s -> Constr
forall e s.
(Data e, Data s) =>
(forall b. Data b => b -> b) -> ForeverE e s -> ForeverE e s
forall e s u.
(Data e, Data s) =>
Int -> (forall d. Data d => d -> u) -> ForeverE e s -> u
forall e s u.
(Data e, Data s) =>
(forall d. Data d => d -> u) -> ForeverE e s -> [u]
forall e s r r'.
(Data e, Data s) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ForeverE e s -> r
forall e s r r'.
(Data e, Data s) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ForeverE e s -> r
forall e s (m :: * -> *).
(Data e, Data s, Monad m) =>
(forall d. Data d => d -> m d) -> ForeverE e s -> m (ForeverE e s)
forall e s (m :: * -> *).
(Data e, Data s, MonadPlus m) =>
(forall d. Data d => d -> m d) -> ForeverE e s -> m (ForeverE e s)
forall e s (c :: * -> *).
(Data e, Data s) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ForeverE e s)
forall e s (c :: * -> *).
(Data e, Data s) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForeverE e s -> c (ForeverE e s)
forall e s (t :: * -> *) (c :: * -> *).
(Data e, Data s, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ForeverE e s))
forall e s (t :: * -> * -> *) (c :: * -> *).
(Data e, Data s, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ForeverE e s))
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ForeverE e s)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForeverE e s -> c (ForeverE e s)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ForeverE e s))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ForeverE e s -> m (ForeverE e s)
$cgmapMo :: forall e s (m :: * -> *).
(Data e, Data s, MonadPlus m) =>
(forall d. Data d => d -> m d) -> ForeverE e s -> m (ForeverE e s)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ForeverE e s -> m (ForeverE e s)
$cgmapMp :: forall e s (m :: * -> *).
(Data e, Data s, MonadPlus m) =>
(forall d. Data d => d -> m d) -> ForeverE e s -> m (ForeverE e s)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ForeverE e s -> m (ForeverE e s)
$cgmapM :: forall e s (m :: * -> *).
(Data e, Data s, Monad m) =>
(forall d. Data d => d -> m d) -> ForeverE e s -> m (ForeverE e s)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ForeverE e s -> u
$cgmapQi :: forall e s u.
(Data e, Data s) =>
Int -> (forall d. Data d => d -> u) -> ForeverE e s -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ForeverE e s -> [u]
$cgmapQ :: forall e s u.
(Data e, Data s) =>
(forall d. Data d => d -> u) -> ForeverE e s -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ForeverE e s -> r
$cgmapQr :: forall e s r r'.
(Data e, Data s) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ForeverE e s -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ForeverE e s -> r
$cgmapQl :: forall e s r r'.
(Data e, Data s) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ForeverE e s -> r
gmapT :: (forall b. Data b => b -> b) -> ForeverE e s -> ForeverE e s
$cgmapT :: forall e s.
(Data e, Data s) =>
(forall b. Data b => b -> b) -> ForeverE e s -> ForeverE e s
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ForeverE e s))
$cdataCast2 :: forall e s (t :: * -> * -> *) (c :: * -> *).
(Data e, Data s, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ForeverE e s))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ForeverE e s))
$cdataCast1 :: forall e s (t :: * -> *) (c :: * -> *).
(Data e, Data s, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ForeverE e s))
dataTypeOf :: ForeverE e s -> DataType
$cdataTypeOf :: forall e s. (Data e, Data s) => ForeverE e s -> DataType
toConstr :: ForeverE e s -> Constr
$ctoConstr :: forall e s. (Data e, Data s) => ForeverE e s -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ForeverE e s)
$cgunfold :: forall e s (c :: * -> *).
(Data e, Data s) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ForeverE e s)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForeverE e s -> c (ForeverE e s)
$cgfoldl :: forall e s (c :: * -> *).
(Data e, Data s) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForeverE e s -> c (ForeverE e s)
Data
\end{code}
\mintinline{haskell}{foreverE e cell} starts with the initial state of \mintinline{haskell}{cell},
and a given value \mintinline{haskell}{e}.
Then \mintinline{haskell}{cell} is stepped,
mutating \mintinline{haskell}{currentState},
until it encounters an exception.
This new exception is stored,
and the cell is restarted with the original initial state.
The cell may use the additional input \mintinline{haskell}{e}
to ask for the last thrown exception
(or the initial value, if none was thrown yet).
The exception is thus the only method of passing on data to the next loop iteration.\footnote{%
It is the user's responsibility to ensure that it does not introduce a space leak,
for example through a lazy calculation that builds up bigger and bigger thunks.
}
In our example, we need not pass on any data,
so a simpler version of the loop operator is defined:
\begin{code}
foreverC
  :: (Data e, Monad m)
  => Cell (ExceptT e m) a b
  -> Cell            m  a b
foreverC :: forall e (m :: * -> *) a b.
(Data e, Monad m) =>
Cell (ExceptT e m) a b -> Cell m a b
foreverC = forall (m :: * -> *) e a b.
(Monad m, Data e) =>
e -> Cell (ReaderT e (ExceptT e m)) a b -> Cell m a b
foreverE () forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (t :: (* -> *) -> * -> *) a b.
(Monad m, MonadTrans t) =>
Cell m a b -> Cell (t m) a b
liftCell
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m1 :: * -> *) (m2 :: * -> *) a b.
(forall x. m1 x -> m2 x) -> Cell m1 a b -> Cell m2 a b
hoistCell (forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const ())
\end{code}
Now we can finally implement our cell:
\fxwarning{Not an SF. Add MonadFix to SF defintiion?}
\begin{code}
sinesForever :: MonadFix m => Cell m () String
sinesForever :: forall (m :: * -> *). MonadFix m => Cell m () String
sinesForever = forall e (m :: * -> *) a b.
(Data e, Monad m) =>
Cell (ExceptT e m) a b -> Cell m a b
foreverC
  forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b e.
Monad m =>
CellExcept a b m e -> Cell (ExceptT e m) a b
runCellExcept
  forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadFix m => CellExcept () String m ()
sinesWaitAndTry
\end{code}
\begin{code}
printSinesForever :: LiveProgram IO
printSinesForever :: LiveProgram IO
printSinesForever = forall (m :: * -> *). Monad m => Cell m () () -> LiveProgram m
liveCell
  forall a b. (a -> b) -> a -> b
$   forall (m :: * -> *). MonadFix m => Cell m () String
sinesForever
  forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Cell IO String ()
printEverySecond
\end{code}
Let us run it:
\verbatiminput{../demos/DemoSinesForever.txt}
\fxwarning{Is the [...] good or not? (Here and elsewhere)}
\fxerror{What's the advantage of forever? How to livecode with it?}

\fxerror{``Forever and ever?'' Show graceful shutdown with ExceptT. Have to change the runtime slightly for this.}
\fxnote{Awesome idea: Electrical circuits simulation where we can change the circuits live!}