essence-of-live-coding 0.1.0.3 → 0.2.0.0

raw patch · 37 files changed

+1273/−215 lines, 37 filesdep +containersdep +mtldep ~foreign-storedep ~sybdep ~test-frameworknew-component:exe:TestNonBlockingPVP ok

version bump matches the API change (PVP)

Dependencies added: containers, mtl

Dependency ranges changed: foreign-store, syb, test-framework, test-framework-quickcheck2, transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−2
• app/TestExceptions.hs +2/−3
• app/TestNonBlocking.hs +46/−0
• essence-of-live-coding.cabal +41/−11
• src/LiveCoding.hs +34/−0
• src/LiveCoding.lhs +0/−30
• src/LiveCoding/Bind.lhs +4/−0
• src/LiveCoding/Cell.lhs +54/−39
• src/LiveCoding/Cell/Feedback.lhs +2/−1
• src/LiveCoding/Cell/Monad.hs +58/−0
• src/LiveCoding/Cell/Monad/Trans.hs +67/−0
• src/LiveCoding/Cell/NonBlocking.hs +67/−0
• src/LiveCoding/Cell/Resample.hs +7/−5
• src/LiveCoding/Cell/Util.hs +17/−0
• src/LiveCoding/Debugger.lhs +4/−4
• src/LiveCoding/Debugger/StatePrint.hs +2/−2
• src/LiveCoding/Exceptions.lhs +3/−8
• src/LiveCoding/Exceptions/Finite.lhs +1/−1
• src/LiveCoding/External.hs +1/−0
• src/LiveCoding/GHCi.hs +53/−0
• src/LiveCoding/Handle.hs +261/−0
• src/LiveCoding/Handle/Examples.hs +39/−0
• src/LiveCoding/LiveProgram/Monad/Trans.hs +29/−0
• src/LiveCoding/Migrate.lhs +2/−0
• src/LiveCoding/Migrate/Debugger.hs +0/−1
• src/LiveCoding/Migrate/Migration.hs +8/−0
• src/LiveCoding/Migrate/Monad/Trans.hs +38/−0
• src/LiveCoding/Preliminary/LiveProgram/LiveProgramPreliminary.lhs +1/−0
• src/LiveCoding/RuntimeIO.lhs +6/−83
• src/LiveCoding/RuntimeIO/Launch.hs +108/−0
• test/Handle.hs +107/−0
• test/Handle/LiveProgram.hs +53/−0
• test/Main.hs +8/−25
• test/Monad.hs +23/−0
• test/Monad/Trans.hs +25/−0
• test/Util.hs +52/−0
• test/Util/LiveProgramMigration.hs +41/−0

@@ -1,5 +1,12 @@ # Revision history for essence-of-live-coding -## 0.1.0.0 -- YYYY-mm-dd+## 0.2.0.0 -* First version. Released on an unsuspecting world.+* Adapted gloss backend to handles and refactored+* Added a mechanism to make cells nonblocking+* Added handles for nonserialisable values like threads, concurrent variables & device handles++## 0.1.0.3++* First version.+  As described in https://www.manuelbaerenz.de/essence-of-live-coding/EssenceOfLiveCoding.pdf.

@@ -11,8 +11,8 @@  liveProgram = liveCell   $ safely $ do-    try $   throwingCell-    safe $ arr (const (3:: Integer)) >>> sumC >>> arr (const ())+    try $ throwingCell+    safe $ arr (const (3 :: Integer)) >>> sumC >>> arr (const ())  throwingCell = proc _ -> do   n <- sumC -< (1 :: Integer)@@ -20,7 +20,6 @@     then throwC -< ()     else returnA -< ()   arrM $ lift . print -< n-  main = do   (debugger, observer) <- countDebugger

@@ -0,0 +1,46 @@+{-# LANGUAGE Arrows #-}++module Main+  ( module Main+  , module X+  ) where++-- base+import Control.Arrow+import Control.Concurrent++-- transformers+import Control.Monad.Trans.Class++-- essence-of-live-coding+import LiveCoding+import LiveCoding.GHCi as X++-- | An identity function that takes a long time to pass on its value.+slowId :: Cell IO a a+slowId = proc a -> do+  arrM threadDelay -< 1000000+  returnA -< a++main :: IO ()+main = do+  putStrLn "Push return to start a slow calculation."+  runHandlingStateT $ foreground $ liveCell mainCell++-- | Constantly count the number of ticks passed since program start.+--   Whenever the keyboard return key is pressed,+--   this number is printed, and passed into a slow "computation" in a separate thread,+--   while the foreground thread is not blocked.+--   When the background thread returns, the number is printed again.+mainCell :: Cell (HandlingStateT IO) () ()+mainCell =+  let keyboard = nonBlocking False $ constM getLine -- Only poll, never abort+      mySlowId = nonBlocking True slowId -- Abort and restart when new data arrives+  in proc _ -> do+    n <- count                             -< ()+    lineMaybe <- keyboard                  -< Just ()+    let nString = show n <$ lineMaybe+    resampleMaybe (arrM $ lift . putStrLn) -< ("Calculating " ++) <$> nString+    resultMaybe <- mySlowId                -< nString+    resampleMaybe (arrM $ lift . putStrLn) -< ("Calculated "  ++) <$> resultMaybe+    arrM $ lift .threadDelay               -< 1000 -- Don't hog CPU

@@ -1,5 +1,5 @@ name:                essence-of-live-coding-version:             0.1.0.3+version:             0.2.0.0 synopsis: General purpose live coding framework description:   essence-of-live-coding is a general purpose and type safe live coding framework.@@ -30,7 +30,7 @@ source-repository this   type:     git   location: git@github.com:turion/essence-of-live-coding.git-  tag:      v0.1.0.3+  tag:      v0.2.0.0   library@@ -40,7 +40,11 @@     , LiveCoding.Cell     , LiveCoding.Cell.Feedback     , LiveCoding.Cell.HotCodeSwap+    , LiveCoding.Cell.Monad+    , LiveCoding.Cell.Monad.Trans+    , LiveCoding.Cell.NonBlocking     , LiveCoding.Cell.Resample+    , LiveCoding.Cell.Util     , LiveCoding.CellExcept     , LiveCoding.Coalgebra     , LiveCoding.Debugger@@ -49,13 +53,19 @@     , LiveCoding.Exceptions.Finite     , LiveCoding.External     , LiveCoding.Forever+    , LiveCoding.GHCi+    , LiveCoding.Handle+    , LiveCoding.Handle.Examples     , LiveCoding.LiveProgram     , LiveCoding.LiveProgram.HotCodeSwap+    , LiveCoding.LiveProgram.Monad.Trans     , LiveCoding.Migrate     , LiveCoding.Migrate.Cell     , LiveCoding.Migrate.Migration+    , LiveCoding.Migrate.Monad.Trans     , LiveCoding.Migrate.Debugger     , LiveCoding.RuntimeIO+    , LiveCoding.RuntimeIO.Launch    other-modules:       LiveCoding.Preliminary.CellExcept@@ -69,26 +79,37 @@   other-extensions:    DeriveDataTypeable   build-depends:       base >= 4.11 && < 5-    , transformers == 0.5.*-    , syb == 0.7.*+    , transformers >= 0.5+    , containers >= 0.6+    , syb >= 0.7     , vector-sized >= 1.2-    , foreign-store+    , foreign-store >= 0.2   hs-source-dirs:      src   default-language:    Haskell2010+  default-extensions: StrictData -test-suite essence-of-live-coding+test-suite test   type: exitcode-stdio-1.0   main-is: Main.hs   other-modules:-      TestData.Foo1+      Handle+    , Handle.LiveProgram+    , Monad+    , Monad.Trans+    , TestData.Foo1     , TestData.Foo2+    , Util+    , Util.LiveProgramMigration   hs-source-dirs: test   build-depends:       base >= 4.11 && < 5-    , syb == 0.7.*+    , syb >= 0.7+    , transformers >= 0.5+    , containers >= 0.6+    , mtl >= 2.2     , essence-of-live-coding-    , test-framework == 0.8.*-    , test-framework-quickcheck2 == 0.3.*+    , test-framework >= 0.8+    , test-framework-quickcheck2 >= 0.3     , QuickCheck >= 2.12   default-language:    Haskell2010 @@ -98,5 +119,14 @@   build-depends:       base >= 4.11 && < 5     , essence-of-live-coding-    , transformers == 0.5.*+    , transformers >= 0.5+  default-language:    Haskell2010++executable TestNonBlocking+  main-is: TestNonBlocking.hs+  hs-source-dirs: app+  build-depends:+      base >= 4.11 && < 5+    , transformers >= 0.5+    , essence-of-live-coding   default-language:    Haskell2010

@@ -0,0 +1,34 @@+module LiveCoding+  (module X)+  where++-- base+import Data.Data as X++-- essence-of-live-coding+import LiveCoding.Bind as X+import LiveCoding.Cell as X+import LiveCoding.Cell.Feedback as X+import LiveCoding.Cell.HotCodeSwap as X+import LiveCoding.Cell.Monad as X+import LiveCoding.Cell.Monad.Trans as X hiding (State)+import LiveCoding.Cell.NonBlocking as X+import LiveCoding.Cell.Resample as X+import LiveCoding.Cell.Util as X+import LiveCoding.CellExcept as X+import LiveCoding.Coalgebra as X+import LiveCoding.Debugger as X+import LiveCoding.Debugger.StatePrint as X+import LiveCoding.Exceptions as X+import LiveCoding.Exceptions.Finite as X+import LiveCoding.Forever as X+import LiveCoding.Handle as X+import LiveCoding.Handle.Examples as X+import LiveCoding.LiveProgram as X+import LiveCoding.LiveProgram.HotCodeSwap as X+import LiveCoding.LiveProgram.Monad.Trans as X+import LiveCoding.Migrate as X+import LiveCoding.Migrate.Debugger as X+import LiveCoding.Migrate.Migration as X+import LiveCoding.RuntimeIO as X hiding (update)+import LiveCoding.RuntimeIO.Launch as X

@@ -1,30 +0,0 @@-\begin{comment}-\begin{code}-module LiveCoding-  (module X)-  where---- base-import Data.Data as X---- essence-of-live-coding-import LiveCoding.Bind as X-import LiveCoding.Cell as X-import LiveCoding.Cell.Feedback as X-import LiveCoding.Cell.HotCodeSwap as X-import LiveCoding.Cell.Resample as X-import LiveCoding.CellExcept as X-import LiveCoding.Coalgebra as X-import LiveCoding.Debugger as X-import LiveCoding.Debugger.StatePrint as X-import LiveCoding.Exceptions as X-import LiveCoding.Exceptions.Finite as X-import LiveCoding.Forever as X-import LiveCoding.LiveProgram as X-import LiveCoding.LiveProgram.HotCodeSwap as X-import LiveCoding.Migrate as X-import LiveCoding.Migrate.Debugger as X-import LiveCoding.Migrate.Migration as X-import LiveCoding.RuntimeIO as X-\end{code}-\end{comment}

@@ -87,3 +87,7 @@ but remembered to immediately continue executing the sine generator from the same phase as before. This is in contrast to simplistic approaches to live coding in which the control flow state is forgotten upon reload, and restarted each time.++In most other programming languages where control flow is builtin,+this would typically require reworking the compiler or interpreter,+but in Haskell, we succeed entirely within the language.

@@ -81,9 +81,24 @@   { cellState :: s   , cellStep  :: s -> a -> m (b, s)   }+\end{code}+\begin{comment}+\begin{code}   | ArrM { runArrM :: a -> m b }+  -- ^ Added to improve performance and keep state types simpler \end{code}-\fxfatal{I've added, to improve performance and migration, the ArrM constructor. Add to LiveProgram as well and explain in both places.}+\end{comment}+\begin{comment}+\begin{code}+-- | Converts every 'Cell' to the 'Cell' constructor.+toCell :: Functor m => Cell m a b -> Cell m a b+toCell cell@Cell {} = cell+toCell ArrM { .. } = Cell+  { cellState = ()+  , cellStep  = const $ fmap (, ()) . runArrM+  }+\end{code}+\end{comment} Such a cell may progress by one step, consuming an \mintinline{haskell}{a} as input, and producing, by means of an effect in some monad \mintinline{haskell}{m},@@ -98,8 +113,12 @@ step Cell { .. } a = do   (b, cellState') <- cellStep cellState a   return (b, Cell { cellState = cellState', .. })+\end{code}+\begin{comment}+\begin{code} step cell@ArrM { .. } a = ( , cell) <$> runArrM a \end{code}+\end{comment}  \begin{comment} \begin{code}@@ -135,11 +154,15 @@   { liveState = cellState   , liveStep  = fmap snd . flip cellStep ()   }+\end{code}+\begin{comment}+\begin{code} liveCell ArrM { .. } = LiveProgram   { liveState = ()   , liveStep  = runArrM   } \end{code}+\end{comment} \begin{comment} \begin{code} toLiveCell@@ -208,14 +231,14 @@     , ..     }   ArrM { .. } . Cell { .. } = Cell-    { cellStep = \state -> (runKleisli $ first $ Kleisli runArrM) <=< cellStep state -- first runArrM <=< +    { cellStep = \state -> (runKleisli $ first $ Kleisli runArrM) <=< cellStep state     , ..     }   Cell state2 step2 . Cell state1 step1 = Cell { .. }     where       cellState = Composition (state1, state2)       cellStep (Composition (state1, state2)) a = do-        (b, state1') <- step1 state1 a+        (!b, state1') <- step1 state1 a         (!c, state2') <- step2 state2 b         return (c, Composition (state1', state2')) -- {-# RULES@@ -253,10 +276,14 @@ buildLiveProg sensor sf actuator = liveCell   $ sensor >>> sf >>> actuator \end{code}-This will conveniently allow us to build a whole live program from smaller components.+This (optional) division of the reactive program into three such parts is inspired by Yampa \cite{Yampa}.+We conveniently build a whole live program from smaller components. It is never necessary to specify a big state type manually, it will be composed from basic building blocks like \mintinline{haskell}{Composition}. +The migration function is easily extended such that it correctly handles the common cases where we extend a cell \mintinline{haskell}{cellMiddle} to the composition \mintinline{haskell}{cellLeft >>> cellMiddle},+or to \mintinline{haskell}{cellMiddle >>> cellRight}.+ \paragraph{Arrowized FRP} \mintinline{haskell}{Cell}s can be made an instance of the \mintinline{haskell}{Arrow} type class, which allows us to lift pure functions to \mintinline{haskell}{Cell}s:@@ -276,10 +303,11 @@ An essential aspect of an FRP framework is some notion of \emph{time}. \fxwarning{Citation?} As this approach essentially uses the \texttt{dunai} API,-a detailed treatment of time domains and clocks as in \cite{Rhine} can be readily applied here.-But let us, for simplicity and explicitness,+a detailed treatment of time domains and clocks as in \texttt{rhine} \cite{Rhine} could be readily applied here,+but this will be deferred to future work.+For simplicity and explicitness, assume that we will execute all \mintinline{haskell}{Cell}s at a certain fixed step rate,-say a thousand steps per second.+say, twenty five steps per second. Then an Euler integration cell can be defined: \begin{code} stepRate :: Num a => a@@ -329,16 +357,7 @@ \end{code} For example, we may eliminate a \mintinline{haskell}{ReaderT r} context by supplying the environment through the \mintinline{haskell}{runReaderT} monad morphism, or lift into a monad transformer:-\begin{comment} \begin{code}-runReaderC-  ::               r-  -> Cell (ReaderT r m) a b-  -> Cell            m  a b-runReaderC r = hoistCell $ flip runReaderT r-\end{code}-\end{comment}-\begin{code} liftCell   :: (Monad m, MonadTrans t)   => Cell         m  a b@@ -351,19 +370,8 @@ until we arrive at \mintinline{haskell}{IO}. Then we can execute the live program in the same way as before. -\fxerror{Talk about this more general transformation in the comments?} \begin{comment} \begin{code}-transformOutput-  :: (Monad m1, Monad m2)-  => (forall s . m1 (b1, s) -> m2 (b2, s))-  -> Cell m1 a b1-  -> Cell m2 a b2-transformOutput morph Cell { .. } = Cell-  { cellState = cellState-  , cellStep  = (morph .) . cellStep-  }- --data Parallel s1 s2 = Parallel s1 s2 newtype Parallel s1 s2 = Parallel (s1, s2)   deriving Data@@ -371,18 +379,25 @@ instance Monad m => Arrow (Cell m) where   arr = arrM . (return .) +  -- For efficiency because Arrow desugaring favours 'first'+  first ArrM { .. } = ArrM { runArrM = \(a, c) -> ( , c) <$> runArrM a }+  first Cell { .. } = Cell+    { cellStep = \s (a, c) -> first ((, c) $!) <$> cellStep s a+    , ..+    }+   ArrM f *** ArrM g = ArrM $ runKleisli $ Kleisli f *** Kleisli g   ArrM { .. } *** Cell { .. } = Cell     { cellStep = \state (a, c) -> do-      b <- runArrM a-      (d, state') <- cellStep state c+      !b <- runArrM a+      (!d, state') <- cellStep state c       return ((b, d), state')     , ..     }   Cell { .. } *** ArrM { .. } = Cell     { cellStep = \state (a, c) -> do-      (b, state') <- cellStep state a-      d <- runArrM c+      (!b, state') <- cellStep state a+      !d <- runArrM c       return ((b, d), state')     , ..     }@@ -390,8 +405,8 @@     where       cellState = Parallel (state1, state2)       cellStep (Parallel (state1, state2)) (a, c) = do-        (b, state1') <- step1 state1 a-        (d, state2') <- step2 state2 c+        (!b, state1') <- step1 state1 a+        (!d, state2') <- step2 state2 c         return ((b, d), Parallel (state1', state2'))  arrM :: (a -> m b) -> Cell m a b@@ -546,20 +561,20 @@   ArrM { .. } +++ Cell { .. } = Cell     { cellStep = \state -> \case         Left a -> do-          b <- runArrM a+          !b <- runArrM a           return (Left b, state)         Right c -> do-          (d, state') <- cellStep state c+          (!d, state') <- cellStep state c           return (Right d, state')     , ..     }   Cell { .. } +++ ArrM { .. } = Cell     { cellStep = \state -> \case         Left a -> do-          (b, state') <- cellStep state a+          (!b, state') <- cellStep state a           return (Left b, state')         Right c -> do-          d <- runArrM c+          !d <- runArrM c           return (Right d, state)     , ..     }@@ -567,10 +582,10 @@     where       cellState = Choice stateL stateR       cellStep (Choice stateL stateR) (Left a) = do-        (b, stateL') <- stepL stateL a+        (!b, stateL') <- stepL stateL a         return (Left b, (Choice stateL' stateR))       cellStep (Choice stateL stateR) (Right c) = do-        (d, stateR') <- stepR stateR c+        (!d, stateR') <- stepR stateR c         return (Right d, (Choice stateL stateR')) \end{code} \end{comment}

@@ -1,6 +1,7 @@ \begin{comment} \begin{code} {-# LANGUAGE Arrows #-}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RecordWildCards #-} @@ -56,7 +57,7 @@   where     cellState = Feedback (state, s)     cellStep (Feedback (state, s)) a = do-      ((b, s'), state') <- step state (a, s)+      ((!b, !s'), state') <- step state (a, s)       return (b, Feedback (state', s')) feedback cellState (ArrM f) = Cell { .. }   where

@@ -0,0 +1,58 @@+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RankNTypes #-}+{- |+Handling monad morphisms.+-}+module LiveCoding.Cell.Monad where++-- essence-of-live-coding+import LiveCoding.Cell+import Control.Arrow ((>>>), Arrow(arr))+import Data.Data (Data)++-- | Apply a monad morphism that also transforms the output to a cell.+hoistCellOutput+  :: (Monad m1, Monad m2)+  => (forall s . m1 (b1, s) -> m2 (b2, s))+  -> Cell m1 a b1+  -> Cell m2 a b2+hoistCellOutput morph = hoistCellKleisli_ (morph .)++-- | Apply a transformation of Kleisli morphisms to a cell.+hoistCellKleisli_+  :: (Monad m1, Monad m2)+  => (forall s . (a1 -> m1 (b1, s)) -> (a2 -> m2 (b2, s)))+  -> Cell m1 a1 b1+  -> Cell m2 a2 b2+hoistCellKleisli_ morph = hoistCellKleisli (morph .)++-- | Apply a transformation of stateful Kleisli morphisms to a cell.+hoistCellKleisli+  :: (Monad m1, Monad m2)+  => (forall s . (s -> a1 -> m1 (b1, s)) -> (s -> a2 -> m2 (b2, s)))+  -> Cell m1 a1 b1+  -> Cell m2 a2 b2+hoistCellKleisli morph ArrM { .. } = ArrM+  { runArrM = (fmap fst .) $ ($ ()) $ morph $ const $ runArrM >>> fmap ( , ())+  }+hoistCellKleisli morph Cell { .. } = Cell+  { cellStep = morph cellStep+  , ..+  }++-- | Apply a transformation of stateful Kleisli morphisms to a cell,+--   changing the state type.+hoistCellKleisliStateChange+  :: (Monad m1, Monad m2, (forall s . Data s => Data (t s)))+  => (forall s . (  s -> a1 -> m1 (b1,   s))+              -> (t s -> a2 -> m2 (b2, t s)))+  -> (forall s . (s -> t s))+  -> Cell m1 a1 b1+  -> Cell m2 a2 b2+hoistCellKleisliStateChange morph init Cell { .. } = Cell+  { cellStep  = morph cellStep+  , cellState = init cellState+  }+hoistCellKleisliStateChange morph init cell = hoistCellKleisliStateChange morph init $ toCell cell

@@ -0,0 +1,67 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DeriveDataTypeable #-}+{- |+Handling monad transformers.+-}+module LiveCoding.Cell.Monad.Trans where++-- base+import Control.Arrow (arr, (>>>))+import Data.Data (Data)++-- transformers+import Control.Monad.Trans.Reader (runReaderT, ReaderT)+import Control.Monad.Trans.State.Strict (StateT (..), runStateT, evalStateT)++-- essence-of-live-coding+import LiveCoding.Cell+import LiveCoding.Cell.Monad++-- | Push effectful state into the internal state of a cell+runStateC+  :: (Data stateT, Monad m)+  => Cell (StateT stateT m) a  b+  -- ^ A cell with a state effect+  -> stateT+  -- ^ The initial state+  -> Cell                m  a (b, stateT)+  -- ^ The cell, returning its current state+runStateC cell stateT = hoistCellKleisliStateChange morph init cell+  where+    morph step State { .. } a = do+      ((b, stateInternal), stateT) <- runStateT (step stateInternal a) stateT+      return ((b, stateT), State { .. })+    init stateInternal = State { .. }++-- | Like 'runStateC', but does not return the current state.+runStateC_+  :: (Data stateT, Monad m)+  => Cell (StateT stateT m) a b+  -- ^ A cell with a state effect+  -> stateT+  -- ^ The initial state+  -> Cell                m  a b+runStateC_ cell stateT = runStateC cell stateT >>> arr fst++-- | The internal state of a cell to which 'runStateC' or 'runStateL' has been applied.+data State stateT stateInternal = State+  { stateT :: stateT+  , stateInternal :: stateInternal+  }+  deriving (Data, Eq, Show)++-- | Supply a 'ReaderT' environment before running the cell+runReaderC+  ::               r+  -> Cell (ReaderT r m) a b+  -> Cell            m  a b+runReaderC r = hoistCell $ flip runReaderT r++-- | Supply a 'ReaderT' environment live+runReaderC'+  :: Cell (ReaderT r m) a b+  -> Cell m (r, a) b+runReaderC' Cell { .. } = Cell+  { cellStep = \state (r, a) -> runReaderT (cellStep state a) r+  , ..+  }

@@ -0,0 +1,67 @@+{-# LANGUAGE Arrows #-}+{-# LANGUAGE RecordWildCards #-}++module LiveCoding.Cell.NonBlocking+  ( nonBlocking+  )+  where++-- base+import Control.Concurrent+import Control.Monad ((>=>), void, when)+import Data.Data++-- essence-of-live-coding+import LiveCoding.Cell+import LiveCoding.Handle+import LiveCoding.Handle.Examples++threadVarHandle :: Handle IO (MVar ThreadId)+threadVarHandle = Handle+  { create = newEmptyMVar+  , destroy = tryTakeMVar >=> mapM_ killThread+  }++{- | Wrap a cell in a non-blocking way.+Every incoming sample of @nonBlocking cell@ results in an immediate output,+either @Just b@ if the value was computed since the last poll,+or @Nothing@ if no new value was computed yet.+The resulting cell can be polled by sending 'Nothing'.+The boolean flag controls whether the current computation is aborted and restarted when new data arrives.+-}+nonBlocking+  :: Typeable b+  => Bool+  -- ^ Pass 'True' to abort the computation when new data arrives. 'False' discards new data.+  -> Cell IO a b+  -> Cell (HandlingStateT IO) (Maybe a) (Maybe b)+nonBlocking abort Cell { .. } = proc aMaybe -> do+  threadVar <- handling threadVarHandle            -< ()+  resultVar <- handling emptyMVarHandle            -< ()+  liftCell Cell { cellStep = nonBlockingStep, .. } -< (aMaybe, threadVar, resultVar)+    where+      nonBlockingStep s (Nothing, threadVar, resultVar) = do+        bsMaybe <- tryTakeMVar resultVar+        case bsMaybe of+          Just (b, s') -> do+            threadId <- takeMVar threadVar+            killThread threadId+            return (Just b, s')+          Nothing -> return (Nothing, s)+      nonBlockingStep s (Just a, threadVar, resultVar) = do+        noThreadRunning <- if abort+            -- Abort the current computation if it is still running+          then do+            maybeThreadId <- tryTakeMVar threadVar+            mapM_ killThread maybeThreadId+            return True+          -- No computation currently running+          else isEmptyMVar threadVar+        when noThreadRunning $ do+          threadId <- forkIO $ putMVar resultVar =<< cellStep s a+          putMVar threadVar threadId+        nonBlockingStep s (Nothing, threadVar, resultVar)++-- It would have been nice to refactor this with 'hoistCellKleisli',+-- but that would expose the existential state type to the handle.+nonBlocking abort noCell = nonBlocking abort $ toCell noCell

@@ -5,6 +5,7 @@ The inner cell is stepped for each input. -} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} module LiveCoding.Cell.Resample where@@ -19,6 +20,7 @@  -- essence-of-live-coding import LiveCoding.Cell+import LiveCoding.Cell.Monad  -- | Execute the inner cell for n steps per outer step. resample :: (Monad m, KnownNat n) => Cell m a b -> Cell m (Vector n a) (Vector n b)@@ -26,12 +28,12 @@  -- | Execute the cell for as many steps as the input list is long. resampleList :: Monad m => Cell m a b -> Cell m [a] [b]-resampleList Cell { cellState, cellStep = singleStep } = Cell { .. }+resampleList cell = hoistCellKleisli morph cell   where-    cellStep s [] = return ([], s)-    cellStep s (a : as) = do-      (b , s' ) <- singleStep s  a-      (bs, s'') <- cellStep   s' as+    morph _ s [] = return ([], s)+    morph singleStep s (a : as) = do+      (!b , s' ) <- singleStep s a+      (!bs, s'') <- morph singleStep s' as       return (b : bs, s'')  resampleMaybe :: Monad m => Cell m a b -> Cell m (Maybe a) (Maybe b)

@@ -0,0 +1,17 @@+{-# LANGUAGE Arrows #-}+module LiveCoding.Cell.Util where++-- base+import Control.Arrow++-- essence-of-live-coding+import LiveCoding.Cell+import LiveCoding.Cell.Feedback++-- | Sum all past inputs, starting by the given number+sumFrom :: Monad m => Integer -> Cell m Integer Integer+sumFrom n0 = feedback n0 $ proc (n, acc) -> returnA -< (acc, acc + n)++-- | Count the number of ticks, starting at 0+count :: Monad m => Cell m a Integer+count = arr (const 1) >>> sumC

@@ -16,7 +16,7 @@  -- transformers import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.State+import Control.Monad.Trans.State.Strict  -- syb import Data.Generics.Text@@ -126,9 +126,9 @@ Inspecting the state of the example \mintinline{haskell}{printSineWait} from Section \ref{sec:control flow context} is daunting, though: \begin{verbatim} Waiting...-(Composition ((,) (Composition ((,) (()) -(Composition ((,) (()) (Composition ((,) -(Composition ((,) (()) (Composition ((,) +(Composition ((,) (Composition ((,) (())+(Composition ((,) (()) (Composition ((,)+(Composition ((,) (()) (Composition ((,) [...] \end{verbatim} \fxerror{I still have the tuples here!}

@@ -15,7 +15,7 @@  -- transformers import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.State+import Control.Monad.Trans.State.Strict  -- syb import Data.Generics.Aliases@@ -126,7 +126,7 @@   :: (Typeable t, Data a)   => (forall b c d. (Data b, Data c, Data d) => f (t b c d))   -> Maybe (f a)-dataCast3 x =   r +dataCast3 x =   r   where     r = if typeRepFingerprint (typeOf (getArg x)) == typeRepFingerprint (typeOf (getArg (fromJust r)))        then Just $ unsafeCoerce x

@@ -1,6 +1,7 @@ \begin{comment} \begin{code} {-# LANGUAGE Arrows #-}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StrictData #-}@@ -22,6 +23,7 @@  -- essence-of-live-coding import LiveCoding.Cell+import LiveCoding.Cell.Monad.Trans  \end{code} \end{comment}@@ -103,7 +105,7 @@     cellStep (NotThrown s) a = do       stateExcept <- runExceptT $ step s a       case stateExcept of-        Right (b, s')+        Right (!b, s')           -> return (Right b, NotThrown s')         Left e           -> cellStep (Exception e) a@@ -141,14 +143,7 @@   case eb of     Left e -> runReaderC' cell2 -< (e, a)     Right b -> returnA -< b--runReaderC' :: Cell (ReaderT r m) a b -> Cell m (r, a) b-runReaderC' Cell { .. } = Cell-  { cellStep = \state (r, a) -> runReaderT (cellStep state a) r-  , ..-  } \end{code} \end{comment}  \input{../essence-of-live-coding/src/LiveCoding/Preliminary/CellExcept/Newtype.lhs}-

@@ -23,7 +23,7 @@  -- essence-of-live-coding import LiveCoding.Cell-import LiveCoding.Exceptions (runReaderC')+import LiveCoding.Cell.Monad.Trans -- import LiveCoding.CellExcept \end{code} \end{comment}

@@ -18,6 +18,7 @@  -- essence-of-live-coding import LiveCoding.Cell+import LiveCoding.Cell.Monad.Trans import LiveCoding.Exceptions  type ExternalCell m eIn eOut a b = Cell (ReaderT eIn (WriterT eOut m)) a b

@@ -0,0 +1,53 @@+{- | Support functions to call common live coding functionalities like launching and reloading+from a @ghci@ or @cabal repl@ session.++You typically don't need to import this module in your code,+but you should load it in your interactive session,+ideally by copying the file `essence-of-live-coding/.ghci` to your project,+adjusting it to your needs and launching @cabal repl@.+-}+module LiveCoding.GHCi where++-- base+import Control.Concurrent++-- foreign-store+import Foreign.Store++-- essence-of-live-coding+import LiveCoding.LiveProgram+import LiveCoding.RuntimeIO+import LiveCoding.RuntimeIO.Launch++livelaunch _ = return $ unlines+  [ "launchedProgram <- launch liveProgram"+  , "save launchedProgram"+  ]++livestop _ = return "stop launchedProgram"++-- | Load a 'LiveProgram' of a given type from the store.+--   The value of the given 'LiveProgram' is not used,+--   it only serves as a proxy for m.+load :: Launchable m => LiveProgram m -> IO (LaunchedProgram m)+load _ = readStore $ Store 0++-- | Save a 'LiveProgram' to the store.+save :: Launchable m => LaunchedProgram m -> IO ()+save = writeStore $ Store 0++-- TODO Could also parametrise this and all other commands by the 'liveProgram'++liveinit _ = return $ unlines+  [ "programVar <- newMVar liveProgram"+  , "threadId <- myThreadId"+  , "save LaunchedProgram { .. }"+  ]++livereload _ = return $ unlines+  [ ":reload"+  , "launchedProgram <- load liveProgram"+  , "update launchedProgram liveProgram"+  ]++livestep _ = return "stepLaunchedProgram launchedProgram"

@@ -0,0 +1,261 @@+{-# LANGUAGE Arrows #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++module LiveCoding.Handle+  ( Handle (..)+  , handling+  , HandlingState (..)+  , HandlingStateT+  , isRegistered+  , runHandlingState+  , runHandlingStateC+  , runHandlingStateT+  )+  where++-- base+import Control.Arrow (returnA, arr, (>>>))+import Data.Data++-- containers+import Data.IntMap+import qualified Data.IntMap as IntMap++-- transformers+import Control.Monad.Trans.Class (MonadTrans(lift))+import Control.Monad.Trans.State.Strict++-- essence-of-live-coding+import LiveCoding.Cell+import LiveCoding.Cell.Monad+import LiveCoding.Cell.Monad.Trans+import LiveCoding.LiveProgram+import LiveCoding.LiveProgram.Monad.Trans++{- | Container for unserialisable values,+such as 'IORef's, threads, 'MVar's, pointers, and device handles.++In a 'Handle', you can store a mechanism to create and destroy a value that survives live coding even if does not have a 'Data' instance.+Using the function 'handling', you can create a cell that will+automatically initialise your value,+and register it in the 'HandlingStateT' monad transformer,+which takes care of automatically destroying it (if necessary) when it does not occur anymore in a later revision of your live program.++Have a look at 'LiveCoding.Handle.Examples' for some ready-to-use implementations.++In short, 'Handle' is an opaque, automatically constructing and garbage collecting container for arbitrary values in the live coding environment.+-}+data Handle m h = Handle+  { create :: m h+  , destroy :: h -> m ()+  }++{- | Combine two handles to one.++'Handle's are not quite 'Monoid's because of the extra type parameter,+but it is possible to combine them.+In the combined handle, the first handle is created first and destroyed last.++Note: 'Handle' is not an 'Applicative' because it is not a 'Functor'+(because the destructor is contravariant in @h@).+-}+combineHandles :: Applicative m => Handle m h1 -> Handle m h2 -> Handle m (h1, h2)+combineHandles handle1 handle2 = Handle+  { create = ( , ) <$> create handle1 <*> create handle2+  , destroy = \(h1, h2) -> destroy handle2 h2 *> destroy handle1 h1+  }++data Handling h where+  Handling+    :: { id     :: Key+       , handle :: h+       }+    -> Handling h+  Uninitialized :: Handling h++type Destructors m = IntMap (Destructor m)++-- | Hold a map of registered handle keys and destructors+data HandlingState m = HandlingState+  { nHandles    :: Key+  , destructors :: Destructors m+  }+  deriving Data++-- | In this monad, handles can be registered,+--   and their destructors automatically executed.+--   It is basically a monad in which handles are automatically garbage collected.+type HandlingStateT m = StateT (HandlingState m) m++initHandlingState :: HandlingState m+initHandlingState = HandlingState+  { nHandles = 0+  , destructors = IntMap.empty+  }++-- | Handle the 'HandlingStateT' effect _without_ garbage collection.+--   Apply this to your main loop after calling 'foreground'.+--   Since there is no garbage collection, don't use this function for live coding.+runHandlingStateT+  :: Monad m+  => HandlingStateT m a+  -> m a+runHandlingStateT = flip evalStateT initHandlingState++{- | Apply this to your main live cell before passing it to the runtime.++On the first tick, it initialises the 'HandlingState' at "no handles".++On every step, it does:++1. Unregister all handles+2. Register currently present handles+3. Destroy all still unregistered handles+   (i.e. those that were removed in the last tick)+-}+runHandlingStateC+  :: forall m a b .+     (Monad m, Typeable m)+  => Cell (HandlingStateT m) a b+  -> Cell                 m  a b+runHandlingStateC cell = flip runStateC_ initHandlingState+  $ hoistCellOutput garbageCollected cell++-- | Like 'runHandlingStateC', but for whole live programs.+runHandlingState+  :: (Monad m, Typeable m)+  => LiveProgram (HandlingStateT m)+  -> LiveProgram                 m+runHandlingState LiveProgram { .. } = flip runStateL initHandlingState LiveProgram+  { liveStep = garbageCollected . liveStep+  , ..+  }++garbageCollected+  :: Monad m+  => HandlingStateT m a+  -> HandlingStateT m a+garbageCollected action = unregisterAll >> action <* destroyUnregistered++data Destructor m = Destructor+  { isRegistered :: Bool+  , action       :: m ()+  }++{- | Hide a handle in a cell,+taking care of initialisation and destruction.++Upon the first tick (or directly after migration),+the 'create' method of the 'Handle' is called,+and the result stored.+This result is then not changed anymore until the cell is removed again.+Once it is removed, the destructor will be called on the next tick.++Migrations will by default not inspect the interior of a 'handling' cell.+This means that handles are only migrated if they have exactly the same type.+-}+handling+  :: ( Typeable h+     , Monad m+    --  , MonadBase m m+    --  , MonadState (HandlingState m) n+    --  , MonadBase m n+     )+  => Handle m h+  -> Cell (HandlingStateT m) arbitrary h+handling handleImpl@Handle { .. } = Cell+  { cellState = Uninitialized+  , cellStep = \state input -> case state of+      handling@Handling { .. } -> do+        reregister handleImpl handling+        return (handle, state)+      Uninitialized -> do+        handle <- lift create+        id <- register handleImpl handle+        return (handle, Handling { .. })+  }++register+  :: Monad m+  => Handle m h+  -> h+  -> HandlingStateT m Key+register handleImpl handle = do+  HandlingState { .. } <- get+  let id = nHandles + 1+  put HandlingState+    { nHandles = id+    , destructors = insertDestructor handleImpl id handle destructors+    }+  return id++reregister+  :: Monad m+  => Handle m h+  -> Handling h+  -> HandlingStateT m ()+reregister handleImpl Handling { .. } = do+  HandlingState { .. } <- get+  put HandlingState { destructors = insertDestructor handleImpl id handle destructors, .. }++insertDestructor+  :: Handle m h+  -> Key+  -> h+  -> Destructors m+  -> Destructors m+insertDestructor Handle { .. } id handle destructors =+  let destructor = Destructor { isRegistered = True, action = destroy handle }+  in  insert id destructor destructors++unregisterAll+  :: Monad m+  => HandlingStateT m ()+unregisterAll = do+  HandlingState { .. } <- get+  let newDestructors = IntMap.map (\destructor -> destructor { isRegistered = False }) destructors+  put HandlingState { destructors = newDestructors, .. }++destroyUnregistered+  :: Monad m+  => HandlingStateT m ()+destroyUnregistered = do+  HandlingState { .. } <- get+  let+      (registered, unregistered) = partition isRegistered destructors+  traverse (lift . action) unregistered+  put HandlingState { destructors = registered, .. }++-- * 'Data' instances++dataTypeHandling :: DataType+dataTypeHandling = mkDataType "Handling" [handlingConstr, uninitializedConstr]++handlingConstr :: Constr+handlingConstr = mkConstr dataTypeHandling "Handling" [] Prefix++uninitializedConstr :: Constr+uninitializedConstr = mkConstr dataTypeHandling "Uninitialized" [] Prefix++instance (Typeable h) => Data (Handling h) where+  dataTypeOf _ = dataTypeHandling+  toConstr Handling { .. } = handlingConstr+  toConstr Uninitialized = uninitializedConstr+  gunfold _cons nil constructor = nil Uninitialized++dataTypeDestructor :: DataType+dataTypeDestructor = mkDataType "Destructor" [ destructorConstr ]++destructorConstr :: Constr+destructorConstr = mkConstr dataTypeDestructor "Destructor" [] Prefix++instance Typeable m => Data (Destructor m) where+  dataTypeOf _ = dataTypeDestructor+  toConstr Destructor { .. } = destructorConstr+  gunfold _ _ = error "Destructor.gunfold"

@@ -0,0 +1,39 @@+module LiveCoding.Handle.Examples where++-- base+import Control.Concurrent+import Data.Data+import Data.IORef++-- essence-of-live-coding+import LiveCoding.Handle++-- | Create an 'IORef', with no special cleanup action.+ioRefHandle :: a -> Handle IO (IORef a)+ioRefHandle a = Handle+  { create = newIORef a+  , destroy = const $ return () -- IORefs are garbage collected+  }++-- | Create an uninitialised 'MVar', with no special cleanup action.+emptyMVarHandle :: Handle IO (MVar a)+emptyMVarHandle = Handle+  { create = newEmptyMVar+  , destroy = const $ return () -- MVars are garbage collected+  }++-- | Create an 'MVar' initialised to some value @a@,+--   with no special cleanup action.+newMVarHandle :: a -> Handle IO (MVar a)+newMVarHandle a = Handle+  { create = newMVar a+  , destroy = const $ return () -- MVars are garbage collected+  }++-- | Launch a thread executing the given action+--   and kill it when the handle is removed.+threadHandle :: IO () -> Handle IO ThreadId+threadHandle action = Handle+  { create  = forkIO action+  , destroy = killThread+  }

@@ -0,0 +1,29 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RecordWildCards #-}+module LiveCoding.LiveProgram.Monad.Trans where++-- base+import Data.Data++-- transformers+import Control.Monad.Trans.State.Strict++-- essence-of-live-coding+import LiveCoding.LiveProgram+import LiveCoding.Cell.Monad.Trans++-- | Remove a stateful effect from the monad stack by supplying the initial state.+--   This state then becomes part of the internal live program state,+--   and is subject to migration as any other state.+--   Live programs are automatically migrated to and from applications of 'runStateL'.+runStateL+  :: (Data stateT, Monad m)+  => LiveProgram (StateT stateT m)+  ->                     stateT+  -> LiveProgram                m+runStateL LiveProgram { .. } stateT = LiveProgram+  { liveState = State { stateInternal = liveState, .. }+  , liveStep = \State { .. } -> do+      (stateInternal, stateT) <- runStateT (liveStep stateInternal) stateT+      return State { .. }+  }

@@ -24,6 +24,7 @@ -- essence-of-live-coding import LiveCoding.Migrate.Debugger import LiveCoding.Migrate.Cell+import LiveCoding.Migrate.Monad.Trans import LiveCoding.Migrate.Migration \end{code} \end{comment}@@ -45,6 +46,7 @@   <> migrationDebugging   <> migrationCell   <> newtypeMigration+  <> migrationState  -- | The standard migration working horse. --   Tries to apply the given migration,

@@ -19,7 +19,6 @@   return Debugging { .. }  -- | Tries to cast the current state into the joint state of debugger and program.---   Will cast to the program state if possible, or else try to cast to the debugger state. migrationToDebugging :: Migration migrationToDebugging = migrationTo2 maybeMigrateToDebugging 

@@ -31,9 +31,11 @@ instance Monoid Migration where   mempty = Migration $ const $ const Nothing +-- | Try to migrate by casting the first type into the second castMigration :: Migration castMigration = Migration $ const cast +-- | Migrate a value into a newtype wrapping newtypeMigration :: Migration newtypeMigration = Migration $ \a b -> do   -- Is it an algebraic datatype with a single constructor?@@ -63,3 +65,9 @@   => (forall a b c . (Typeable a, Typeable b, Typeable c) => t b c -> Maybe a)   -> Migration constMigrationFrom2 f = Migration $ \_ t -> ext2Q (const Nothing) f t++migrationTo1+  :: Typeable t+  => (forall a b . (Typeable a, Typeable b) => t b -> a -> Maybe (t b))+  -> Migration+migrationTo1 f = Migration $ \t a -> ext1M (const Nothing) (flip f a) t

@@ -0,0 +1,38 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+module LiveCoding.Migrate.Monad.Trans where++-- base+import Data.Data++-- essence-of-live-coding+import LiveCoding.Cell.Monad.Trans+import LiveCoding.Migrate.Migration++maybeMigrateToState+  :: (Typeable stateInternal', Typeable stateInternal)+  => State stateT stateInternal+  -> stateInternal'+  -> Maybe (State stateT stateInternal)+maybeMigrateToState State { stateT } stateInternal' = do+  stateInternal <- cast stateInternal'+  return State { .. }++-- | Tries to cast the current state into the joint state of a program+--   where a state effect has been absorbed into the internal state with 'runStateL' or 'runStateC'.+migrationToState :: Migration+migrationToState = migrationTo2 maybeMigrateToState++maybeMigrateFromState+  :: (Typeable stateInternal', Typeable stateInternal)+  => State stateT stateInternal+  -> Maybe              stateInternal'+maybeMigrateFromState State { stateInternal } = cast stateInternal++-- | Try to extract a state from the current joint state of a program wrapped with 'runStateL' or 'runStateC'.+migrationFromState :: Migration+migrationFromState = constMigrationFrom2 maybeMigrateFromState++-- | Combines 'migrationToState' and 'migrationFromState'.+migrationState :: Migration+migrationState = migrationToState <> migrationFromState

@@ -25,6 +25,7 @@   liveState' <- liveStep liveState   return liveProgram { liveState = liveState' } \end{code}+\fxerror{Maybe I should use modifyMVar here?} \begin{code} stepProgramMVar   :: MVar (LiveProgram IO s)

@@ -17,19 +17,7 @@ import LiveCoding.LiveProgram.HotCodeSwap import LiveCoding.Debugger import LiveCoding.Migrate--stepProgram :: Monad m => LiveProgram m -> m (LiveProgram m)-stepProgram LiveProgram {..} = do-  liveState' <- liveStep liveState-  return LiveProgram { liveState = liveState', .. }--stepProgramMVar-  :: MVar (LiveProgram IO)-  -> IO ()-stepProgramMVar var = do-  currentProgram <- takeMVar var-  nextProgram <- stepProgram currentProgram-  putMVar var nextProgram+import LiveCoding.RuntimeIO.Launch \end{code} \end{comment} @@ -98,81 +86,16 @@ the local binding \mintinline{haskell}{var} is lost. The package \texttt{foreign-store} \cite{foreign-store} offers a remedy: \mintinline{haskell}{var} can be stored persistently across reloads.-To facilitate its usage, GHCi macros are defined for the initialisation and reload operations (Figure \ref{fig:ghci}).-\input{../essence-of-live-coding/src/LiveCoding/GHCi.lhs}-They assume the main live program and the \mintinline{haskell}{MVar} to be called \mintinline{haskell}{liveProgram} and \mintinline{haskell}{var},-respectively,-but this can of course be generalised.-With the macros loaded, the session simplifies to:-\begin{verbatim}- > :liveinit- > :livestep-0- > :livestep-1- > :livereload-[1 of 1] Compiling Main ( ... )-Ok, one module loaded.- > :livestep-2- > :livestep-1- > :livestep-0-\end{verbatim}-Before entering \texttt{:livereload},-the main file was edited in place and reloaded.-\begin{comment}-\begin{code}-launch :: LiveProgram IO -> IO (MVar (LiveProgram IO))-launch liveProg = do-  var <- newMVar liveProg-  forkIO $ background var-  return var--launchWithDebugger :: LiveProgram IO -> Debugger IO -> IO (MVar (LiveProgram IO))-launchWithDebugger liveProg debugger = launch $ liveProg `withDebugger` debugger-{--  var <- newMVar liveProg-  forkIO $ backgroundWithDebugger var debugger-  return var--}--{--debug :: Debugger_ -> LiveProgram IO -> IO (LiveProgram IO)-debug Debugger_ { .. } LiveProgram { .. } = do-  liveState' <- debugState liveState-  return LiveProgram { liveState = liveState', .. }--backgroundWithDebugger :: MVar (LiveProgram IO) -> Debugger_ -> IO ()-backgroundWithDebugger var debugger = forever $ do-  liveProg   <- takeMVar var-  liveProg'  <- stepProgram liveProg-  liveProg'' <- debug debugger liveProg'-  putMVar var liveProg''--}--background :: MVar (LiveProgram IO) -> IO ()-background var = forever $ do-  liveProg   <- takeMVar var-  liveProg'  <- stepProgram liveProg-  putMVar var liveProg'+To facilitate its usage, GHCi macros are defined for the initialisation and reload operations. -{---- Old version where combine was called from background-combine :: MVar (LiveProgram IO) -> LiveProgram IO -> IO ()-combine var prog = do-  success <- tryPutMVar var prog-  unless success $ do-    newProg <- takeMVar var-    combine var $ hotCodeSwap prog newProg--}-\end{code}-\end{comment} Of course, it is not intended to enter \texttt{:livestep} repeatedly when coding. We want to launch a separate thread which executes the steps in the background. Again, we can reuse the function \mintinline{haskell}{launch}. (Only the type signature needs updating.)+Using \texttt{ghcid} (``GHCi as a daemon'' \cite{ghcid}),+the launching and reloading operations can be automatically triggered upon starting \texttt{ghcid} and editing the code,+allowing for a smooth live coding experience without any manual intervention.+ In the next subsection, a full example is shown.

@@ -0,0 +1,108 @@+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RecordWildCards #-}+module LiveCoding.RuntimeIO.Launch where++-- base+import Control.Concurrent+import Control.Monad++-- transformers+import Control.Monad.Trans.State.Strict++-- essence-of-live-coding+import LiveCoding.Debugger+import LiveCoding.Handle+import LiveCoding.LiveProgram+import LiveCoding.LiveProgram.HotCodeSwap+import LiveCoding.Cell.Monad.Trans+import Data.Data (Typeable)++{- | Monads in which live programs can be launched in 'IO',+for example when you have special effects that have to be handled on every reload.++The only thing necessary is to transform the 'LiveProgram'+into one in the 'IO' monad, and the rest is taken care of in the framework.+-}+class Monad m => Launchable m where+  runIO :: LiveProgram m -> LiveProgram IO++instance Launchable IO where+  runIO = id++instance Launchable (StateT (HandlingState IO) IO) where+  runIO = runHandlingState++data LaunchedProgram (m :: * -> *) = LaunchedProgram+  { programVar :: MVar (LiveProgram IO)+  , threadId   :: ThreadId+  }++{- | Launch a 'LiveProgram' in a separate thread.++The 'MVar' can be used to 'update' the program while automatically migrating it.+The 'ThreadId' represents the thread where the program runs in.+You're advised not to kill it directly, but to run 'stop' instead.+-}+launch+  :: Launchable m+  => LiveProgram m+  -> IO (LaunchedProgram m)+launch liveProg = do+  programVar <- newMVar $ runIO liveProg+  threadId <- forkIO $ background programVar+  return LaunchedProgram { .. }++-- | Migrate (using 'hotCodeSwap') the 'LiveProgram' to a new version.+update+  :: Launchable m+  => LaunchedProgram m+  -> LiveProgram     m+  -> IO ()+update LaunchedProgram { .. } newProg = do+  oldProg <- takeMVar programVar+  putMVar programVar $ hotCodeSwap (runIO newProg) oldProg++{- | Stops a thread where a 'LiveProgram' is being executed.++Before the thread is killed, an empty program (in the monad @m@) is first inserted and stepped.+This can be used to call cleanup actions encoded in the monad.+-}+stop+  :: Launchable m+  => LaunchedProgram m+  -> IO ()+stop launchedProgram@LaunchedProgram { .. } = do+  update launchedProgram mempty+  stepLaunchedProgram launchedProgram+  killThread threadId++-- | Launch a 'LiveProgram', but first attach a debugger to it.+launchWithDebugger+  :: (Monad m, Launchable m)+  => LiveProgram m+  -> Debugger m+  -> IO (LaunchedProgram m)+launchWithDebugger liveProg debugger = launch $ liveProg `withDebugger` debugger++-- | This is the background task executed by 'launch'.+background :: MVar (LiveProgram IO) -> IO ()+background var = forever $ do+  liveProg   <- takeMVar var+  liveProg'  <- stepProgram liveProg+  putMVar var liveProg'++-- | Advance a 'LiveProgram' by a single step.+stepProgram :: Monad m => LiveProgram m -> m (LiveProgram m)+stepProgram LiveProgram {..} = do+  liveState' <- liveStep liveState+  return LiveProgram { liveState = liveState', .. }++-- | Advance a launched 'LiveProgram' by a single step and store the result.+stepLaunchedProgram+  :: (Monad m, Launchable m)+  => LaunchedProgram m+  -> IO ()+stepLaunchedProgram LaunchedProgram { .. } = modifyMVar_ programVar stepProgram

@@ -0,0 +1,107 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-}+module Handle where++-- base+import Control.Arrow+import Data.Functor+import Data.Functor.Identity++-- transformers+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.State.Strict++-- test-framework+import Test.Framework++-- test-framework+import Test.Framework++-- test-framework-quickcheck2+import Test.Framework.Providers.QuickCheck2++-- QuickCheck+import Test.QuickCheck++-- essence-of-live-coding+import qualified Handle.LiveProgram+import LiveCoding+import Util++testHandle :: Handle (State Int) String+testHandle = Handle+  { create = do+      n <- get+      return $ "Handle #" ++ show n+  , destroy = const $ put 10000+  }++testUnitHandle :: Handle (State Int) ()+testUnitHandle = Handle+  { create = return ()+  , destroy = const $ put 20000+  }++cellWithAction+  :: forall a b . (State Int b)+  -> Cell Identity a (String, Int)+cellWithAction action = flip runStateC 0 $ runHandlingStateC $ handling testHandle >>> arrM (<$ lift action)++test = testGroup "Handle"+  [ testProperty "Preserve Handles" CellMigrationSimulation+    { cell1 = cellWithAction $ modify (+ 1)+    , cell2 = cellWithAction $ return ()+    , input1 = replicate 3 ()+    , input2 = replicate 3 ()+    , output1 = ("Handle #0", ) <$> [1, 2, 3]+    , output2 = ("Handle #0", ) <$> [3, 3, 3]+    }+  , testProperty "Initialise Handles upon migration" CellMigrationSimulation+    { cell1 = flip runStateC 0 $ constM $ modify (+ 1) >> return ""+    , cell2 = cellWithAction $ return ()+    , input1 = replicate 3 ()+    , input2 = replicate 3 ()+    , output1 = ("", ) <$> [1, 2, 3]+    , output2 = ("Handle #3", ) <$> [3, 3, 3]+    }+  , testProperty "Preserve Handles in more complex migration" CellMigrationSimulation+    { cell1 = flip runStateC 22+        $ constM (modify (+ 1)) >>> runHandlingStateC (handling testHandle)+    , cell2 = cellWithAction $ return ()+    , input1 = replicate 3 ()+    , input2 = replicate 3 ()+    , output1 = ("Handle #23", ) <$> [23, 24, 25]+    , output2 = ("Handle #23", ) <$> replicate 3 25+    }+  , testProperty "Reinitialise Handles in too complex migration" CellMigrationSimulation+    { cell1 = flip runStateC 22+        $   constM (modify (+ 1))+        >>> constM get >>> sumC >>> sumC+        >>> runHandlingStateC (handling testHandle)+    , cell2 = cellWithAction $ return ()+    , input1 = replicate 3 ()+    , input2 = replicate 3 ()+    , output1 = ("Handle #23", ) <$> [23, 24, 25]+    , output2 = ("Handle #25", ) <$> replicate 3 25+    }+  , testProperty "Doesn't crash when handle is introspected by migration" CellMigrationSimulation+    { cell1 = cellWithAction $ return ()+    , cell2 = flip runStateC 0 $ runHandlingStateC+        $ handling testUnitHandle >>> arr (const "")+    , input1 = replicate 3 ()+    , input2 = replicate 3 ()+    , output1 = ("Handle #0", ) <$> replicate 3 0+    , output2 = ("", ) <$> replicate 3 10000+    }+  , testProperty "Trigger destructors" CellMigrationSimulation+    { cell1 = cellWithAction $ return ()+    , cell2 = flip runStateC 23+        $ runHandlingStateC $ arr $ const "Done"+    , input1 = replicate 3 ()+    , input2 = replicate 3 ()+    , output1 = ("Handle #0", ) <$> replicate 3 0+    , output2 = ("Done", ) <$> replicate 3 10000+    }+  , Handle.LiveProgram.test+  ]

@@ -0,0 +1,53 @@+{-# LANGUAGE RecordWildCards #-}+module Handle.LiveProgram where++-- base+import Control.Arrow++-- containers+import qualified Data.IntMap as IntMap++-- transformers+import Control.Monad.Trans.RWS.Strict (RWS, tell)+import qualified Control.Monad.Trans.RWS.Strict as RWS+import Control.Monad.Trans.State.Strict++-- test-framework+import Test.Framework++-- test-framework-quickcheck2+import Test.Framework.Providers.QuickCheck2++-- essence-of-live-coding+import LiveCoding+import LiveCoding.Handle+import Util.LiveProgramMigration+import Control.Monad.Trans.Class (MonadTrans(lift))++testHandle :: Handle (RWS () [String] Int) String+testHandle = Handle+  { create = do+      n <- RWS.get+      return $ "Handle #" ++ show n+  , destroy = const $ tell ["Destroyed handle"]+  }++test = testGroup "Handle.LiveProgram"+  [ testProperty "Trigger destructors in live program" LiveProgramMigration+    { liveProgram1 = runHandlingState $ liveCell+        $ handling testHandle >>> arrM (lift . tell . return) >>> constM inspectHandlingState+    , liveProgram2 = runHandlingState mempty+    , input1 = replicate 3 ()+    , input2 = replicate 3 ()+    , output1 = replicate 3 ["Handle #0", "Handles: 1", "Destructors: (1,True)"]+    , output2 = [["Destroyed handle"], [], []]+    , initialState = 0+    }+  ]+    where+      inspectHandlingState = do+        HandlingState { .. } <- get+        lift $ tell+          [ "Handles: " ++ show nHandles+          , "Destructors: " ++ unwords ((show . second isRegistered) <$> IntMap.toList destructors)+          ]

@@ -6,7 +6,6 @@ -- base import Control.Arrow import Data.Functor.Identity-import System.IO.Unsafe (unsafePerformIO)  -- test-framework import Test.Framework@@ -18,9 +17,14 @@ import Test.QuickCheck  -- essence-of-live-coding+import qualified Handle+import qualified Monad import LiveCoding++import qualified Monad.Trans import qualified TestData.Foo1 as Foo1 import qualified TestData.Foo2 as Foo2+import Util  intToInteger :: Int -> Integer intToInteger = toInteger@@ -102,35 +106,14 @@         , output2 = [23, 24, 25]         }       ]+    , Handle.test+    , Monad.test     ]+    , Monad.Trans.test   ] -withEvilDebugger :: Cell IO a b -> Cell Identity a b-withEvilDebugger cell = hoistCell (Identity . unsafePerformIO) $ withDebuggerC cell statePrint- countFrom :: Monad m => Int -> Cell m () Int countFrom n = arr (const 1) >>> sumC >>> arr (+ n)  fromEither (Left  a) = a fromEither (Right a) = a--data CellMigrationSimulation a b = CellMigrationSimulation-  { cell1 :: Cell Identity a b-  , cell2 :: Cell Identity a b-  , input1 :: [a]-  , input2 :: [a]-  , output1 :: [b]-  , output2 :: [b]-  }--instance (Eq b, Show b) => Testable (CellMigrationSimulation a b) where-  property CellMigrationSimulation { .. }-    = let Identity (output1', output2') = simulateCellMigration cell1 cell2 input1 input2-      in output1 === output1' .&&. output2 === output2'--simulateCellMigration :: Monad m => Cell m a b -> Cell m a b -> [a] -> [a] -> m ([b], [b])-simulateCellMigration cell1 cell2 as1 as2 = do-  (bs1, cell1') <- steps cell1 as1-  let cell2' = hotCodeSwapCell cell2 cell1'-  (bs2, _) <- steps cell2' as2-  return (bs1, bs2)

@@ -0,0 +1,23 @@+module Monad where++-- transformers+import Control.Monad.Trans.State.Strict++-- essence-of-live-coding+import LiveCoding+import LiveCoding.Cell.Monad.Trans+import Util++import Data.Functor.Identity (Identity)++-- test-framework-quickcheck2+import Test.Framework.Providers.QuickCheck2++test = testProperty "State effect" CellMigrationSimulation+  { cell1 = flip runStateC (0 :: Int) $ constM (modify (+ 1))+  , cell2 = flip runStateC 23 $ constM (modify (+ 2))+  , input1 = [(), (), ()]+  , input2 = [(), (), ()]+  , output1 = [((), 1), ((), 2), ((), 3)]+  , output2 = [((), 5), ((), 7), ((), 9)]+  }

@@ -0,0 +1,25 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Monad.Trans where++-- test-framework+import Test.Framework++-- test-framework-quickcheck2+import Test.Framework.Providers.QuickCheck2++-- QuickCheck+import Test.QuickCheck++-- essence-of-live-coding+import LiveCoding+import LiveCoding.Cell.Monad.Trans (State(State))++test = testGroup "Monad.Trans"+  [ testProperty "Migrates into runStateL"+    $ \(stateT :: Int) (stateInternal :: Int)+      -> State { .. } === migrate State { stateInternal = 23, .. } stateInternal+  , testProperty "Migrates from runStateL"+  $ \(stateT :: Int) (stateInternal :: Int)+    -> stateInternal === migrate 42 State { .. }+  ]

@@ -0,0 +1,52 @@+{-# LANGUAGE RecordWildCards #-}+module Util where++-- base+import Data.Functor.Identity+import System.IO.Unsafe (unsafePerformIO)++-- QuickCheck+import Test.QuickCheck++-- essence-of-live-coding+import LiveCoding++{- | A quickcheckable unit test for migrations of cells.++You have to specify a cell which will then receive some input,+is fed each input element in a step, and produces some output.+Then the cell is migrated to a second cell, which again consumes input and produces output.++The test is passed if the same input produces the same output.++* 'cell1': The cell before the migration+* 'cell2': The cell after the migration+* 'input1': All input the cell before the migration receives+* 'input2': All input the cell after the migration receives+* 'output1': The expected output before the migration+* 'output2': The expected output after the migration+-}+data CellMigrationSimulation a b = CellMigrationSimulation+  { cell1 :: Cell Identity a b+  , cell2 :: Cell Identity a b+  , input1 :: [a]+  , input2 :: [a]+  , output1 :: [b]+  , output2 :: [b]+  }++instance (Eq b, Show b) => Testable (CellMigrationSimulation a b) where+  property CellMigrationSimulation { .. }+    = let Identity (output1', output2') = simulateCellMigration cell1 cell2 input1 input2+      in output1 === output1' .&&. output2 === output2'++-- | Step the first cell with the first input,+--   migrate it to the second cell,+--   and step the migration result with the second input.+--   Return both outputs.+simulateCellMigration :: Monad m => Cell m a b -> Cell m a b -> [a] -> [a] -> m ([b], [b])+simulateCellMigration cell1 cell2 as1 as2 = do+  (bs1, cell1') <- steps cell1 as1+  let cell2' = hotCodeSwapCell cell2 cell1'+  (bs2, _) <- steps cell2' as2+  return (bs1, bs2)

@@ -0,0 +1,41 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ExistentialQuantification #-}+module Util.LiveProgramMigration where++-- transformers+import Control.Monad.Trans.RWS.Strict (runRWS, RWS)++-- QuickCheck+import Test.QuickCheck++-- essence-of-live-coding+import LiveCoding++data LiveProgramMigration a b = forall s . LiveProgramMigration+  { liveProgram1 :: LiveProgram (RWS a b s)+  , liveProgram2 :: LiveProgram (RWS a b s)+  , initialState :: s+  , input1 :: [a]+  , input2 :: [a]+  , output1 :: [b]+  , output2 :: [b]+  }++stepLiveProgramRWS :: Monoid b => LiveProgram (RWS a b s) -> a -> s -> (LiveProgram (RWS a b s), s, b)+stepLiveProgramRWS liveProg = runRWS (stepProgram liveProg)++stepsLiveProgramRWS :: Monoid b => LiveProgram (RWS a b s) -> s -> [a] -> (LiveProgram (RWS a b s), s, [b])+stepsLiveProgramRWS liveProg s [] = (liveProg, s, [])+stepsLiveProgramRWS liveProg s (a : as) =+  let (liveProg', s', b) = stepLiveProgramRWS liveProg a s+  in (liveProg', s', b : third (stepsLiveProgramRWS liveProg' s' as))++third :: (a, b, c) -> c+third (a, b, c) = c++instance (Monoid b, Eq b, Show b) => Testable (LiveProgramMigration a b) where+  property LiveProgramMigration { .. } =+    let (liveProg', s', output1') = stepsLiveProgramRWS liveProgram1 initialState input1+        liveProg2 = hotCodeSwap liveProgram2 liveProg'+        (_, _, output2') = stepsLiveProgramRWS liveProg2 s' input2+    in output1 === output1' .&&. output2 === output2'