\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 m () String ()
sinesWaitAndTry :: CellExcept m () String ()
sinesWaitAndTry = do
  Cell (ExceptT () m) () String -> CellExcept m () String ()
forall e (m :: * -> *) a b.
(Data e, Finite e) =>
Cell (ExceptT e m) a b -> CellExcept m a b e
try (Cell (ExceptT () m) () String -> CellExcept m () String ())
-> Cell (ExceptT () m) () String -> CellExcept m () String ()
forall a b. (a -> b) -> a -> b
$ (() -> String) -> Cell (ExceptT () m) () String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (String -> () -> String
forall a b. a -> b -> a
const String
"Waiting...") Cell (ExceptT () m) () String
-> Cell (ExceptT () m) String String
-> Cell (ExceptT () m) () String
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Double -> Cell (ExceptT () m) String String
forall (m :: * -> *) a.
Monad m =>
Double -> Cell (ExceptT () m) a a
wait Double
1
  Cell (ExceptT () m) () String -> CellExcept m () String ()
forall e (m :: * -> *) a b.
(Data e, Finite e) =>
Cell (ExceptT e m) a b -> CellExcept m a b e
try (Cell (ExceptT () m) () String -> CellExcept m () String ())
-> Cell (ExceptT () m) () String -> CellExcept m () String ()
forall a b. (a -> b) -> a -> b
$ Double -> Cell (ExceptT () m) () Double
forall (m :: * -> *). MonadFix m => Double -> Cell m () Double
sine Double
5 Cell (ExceptT () m) () Double
-> Cell (ExceptT () m) Double String
-> Cell (ExceptT () m) () String
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Double -> String) -> Cell (ExceptT () m) Double String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Double -> String
asciiArt  Cell (ExceptT () m) Double String
-> Cell (ExceptT () m) String String
-> Cell (ExceptT () m) Double String
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Double -> Cell (ExceptT () m) String String
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 m () String Void
sinesForever' :: CellExcept m () String Void
sinesForever' = do
  CellExcept m () String ()
forall (m :: * -> *). MonadFix m => CellExcept m () String ()
sinesWaitAndTry
  CellExcept m () String Void
forall (m :: * -> *). MonadFix m => CellExcept m () String 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 :: 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 :: forall (m :: * -> *) a b s.
Data s =>
s -> (s -> a -> m (b, s)) -> Cell m a b
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 :: forall e s. e -> s -> s -> ForeverE e s
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 <- 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
$ ReaderT e (ExceptT e m) (b, s) -> e -> ExceptT e m (b, s)
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') -> (b, ForeverE e s) -> m (b, ForeverE e s)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, ForeverE e s
f { currentState :: s
currentState = s
state' })
\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
  { ForeverE e s -> e
lastException :: e
  , ForeverE e s -> s
initState     :: s
  , ForeverE e s -> s
currentState  :: s
  }
  deriving Typeable (ForeverE e s)
DataType
Constr
Typeable (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 (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (ForeverE e s))
-> (ForeverE e s -> Constr)
-> (ForeverE e s -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (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)))
-> ((forall b. Data b => b -> b) -> ForeverE e s -> ForeverE e s)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ForeverE e s -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ForeverE e s -> r)
-> (forall u. (forall d. Data d => d -> u) -> ForeverE e s -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ForeverE e s -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ForeverE e s -> m (ForeverE e s))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ForeverE e s -> m (ForeverE e s))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ForeverE e s -> m (ForeverE e s))
-> Data (ForeverE e s)
ForeverE e s -> DataType
ForeverE e s -> Constr
(forall b. Data b => b -> b) -> ForeverE e s -> ForeverE e 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 b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ForeverE e s)
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ForeverE e s))
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) -> ForeverE e s -> u
forall u. (forall d. Data d => d -> u) -> ForeverE e s -> [u]
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 r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ForeverE e s -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ForeverE e s -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ForeverE e s -> m (ForeverE e s)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ForeverE e s -> m (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. Data d => c (t d)) -> Maybe (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))
$cForeverE :: Constr
$tForeverE :: DataType
gmapMo :: (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 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 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 :: 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 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 :: (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 :: (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 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 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 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 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)
$cp1Data :: forall e s. (Data e, Data s) => Typeable (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 :: Cell (ExceptT e m) a b -> Cell m a b
foreverC = () -> Cell (ReaderT () (ExceptT () m)) a b -> Cell m a b
forall (m :: * -> *) e a b.
(Monad m, Data e) =>
e -> Cell (ReaderT e (ExceptT e m)) a b -> Cell m a b
foreverE () (Cell (ReaderT () (ExceptT () m)) a b -> Cell m a b)
-> (Cell (ExceptT e m) a b -> Cell (ReaderT () (ExceptT () m)) a b)
-> Cell (ExceptT e m) a b
-> Cell m a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cell (ExceptT () m) a b -> Cell (ReaderT () (ExceptT () m)) a b
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a b.
(Monad m, MonadTrans t) =>
Cell m a b -> Cell (t m) a b
liftCell
  (Cell (ExceptT () m) a b -> Cell (ReaderT () (ExceptT () m)) a b)
-> (Cell (ExceptT e m) a b -> Cell (ExceptT () m) a b)
-> Cell (ExceptT e m) a b
-> Cell (ReaderT () (ExceptT () m)) a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. ExceptT e m x -> ExceptT () m x)
-> Cell (ExceptT e m) a b -> Cell (ExceptT () m) a b
forall (m1 :: * -> *) (m2 :: * -> *) a b.
(forall x. m1 x -> m2 x) -> Cell m1 a b -> Cell m2 a b
hoistCell ((e -> ()) -> ExceptT e m x -> ExceptT () m x
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ((e -> ()) -> ExceptT e m x -> ExceptT () m x)
-> (e -> ()) -> ExceptT e m x -> ExceptT () m x
forall a b. (a -> b) -> a -> b
$ () -> e -> ()
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 :: Cell m () String
sinesForever = Cell (ExceptT () m) () String -> Cell m () String
forall e (m :: * -> *) a b.
(Data e, Monad m) =>
Cell (ExceptT e m) a b -> Cell m a b
foreverC
  (Cell (ExceptT () m) () String -> Cell m () String)
-> Cell (ExceptT () m) () String -> Cell m () String
forall a b. (a -> b) -> a -> b
$ CellExcept m () String () -> Cell (ExceptT () m) () String
forall (m :: * -> *) a b e.
Monad m =>
CellExcept m a b e -> Cell (ExceptT e m) a b
runCellExcept
  (CellExcept m () String () -> Cell (ExceptT () m) () String)
-> CellExcept m () String () -> Cell (ExceptT () m) () String
forall a b. (a -> b) -> a -> b
$ CellExcept m () String ()
forall (m :: * -> *). MonadFix m => CellExcept m () String ()
sinesWaitAndTry
\end{code}
\begin{code}
printSinesForever :: LiveProgram IO
printSinesForever :: LiveProgram IO
printSinesForever = Cell IO () () -> LiveProgram IO
forall (m :: * -> *). Monad m => Cell m () () -> LiveProgram m
liveCell
  (Cell IO () () -> LiveProgram IO)
-> Cell IO () () -> LiveProgram IO
forall a b. (a -> b) -> a -> b
$   Cell IO () String
forall (m :: * -> *). MonadFix m => Cell m () String
sinesForever
  Cell IO () String -> Cell IO String () -> Cell IO () ()
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!}