Incrementally display output of eval commands

Rather than waiting for the process to complete and then displaying its
output, `patat` now fetches the `stdout` and `stderr` as it becomes
available and refreshes the display.

This means that by default, **stderr is now displayed as well**.
To disable displaying `stderr`, you can add `stderr: false` to the eval
configuration, e.g.:

```yaml
patat:
  eval:
    bash:
      command: bash
      stderr: false
```

CHANGELOG.md

@@ -1,5 +1,25 @@
 # Changelog
 
+## 0.13.0.0 (unreleased)
+
+ *  Incrementally display output of `eval` commands (#132)
+
+    Rather than waiting for the process to complete and then displaying its
+    output, `patat` now fetches the `stdout` and `stderr` as it becomes
+    available and refreshes the display.
+
+    This means that by default, **stderr is now displayed as well**.
+    To disable displaying `stderr`, you can add `stderr: false` to the eval
+    configuration, e.g.:
+
+    ```yaml
+    patat:
+      eval:
+        bash:
+          command: bash
+          stderr: false
+    ```
+
 ## 0.12.0.1 (2024-09-28)
 
  *  Fix width of code blocks when using wide characters (#171)

README.md

@@ -720,7 +720,7 @@ attribute on a code block matches the evaluator, it will be used.
 code of presentations downloaded from the internet before running them if they
 contain `eval` settings.
 
-Aside from the command, there are three more options:
+Aside from the command, there are four more options:
 
  -  `fragment`: Introduce a pause (see [fragments](#fragmented-slides)) in
     between showing the original code block and the output.  Defaults to `true`.
@@ -732,6 +732,7 @@ Aside from the command, there are three more options:
      *  `code`: the default setting.
      *  `none`: no formatting applied.
      *  `inline`: no formatting applied and no trailing newline.
+ -  `stderr`: Include output from standard error.  Defaults to `true`.
  -  `wrap`: this is a deprecated name for `container`, used in version 0.11 and
     earlier.
 

lib/Patat/Eval.hs

@@ -2,34 +2,48 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
 module Patat.Eval
-    ( eval
+    ( parseEvalBlocks
+
+    , evalVar
+    , evalActiveVars
+    , evalAllVars
     ) where
 
 
 --------------------------------------------------------------------------------
 import qualified Control.Concurrent.Async       as Async
-import           Control.Exception              (finally)
+import           Control.Exception              (IOException, catch, finally)
+import           Control.Monad                  (foldM, when)
+import           Control.Monad.State            (StateT, runStateT, state)
+import           Control.Monad.Writer           (Writer, runWriter, tell)
+import           Data.Foldable                  (for_)
 import qualified Data.HashMap.Strict            as HMS
+import qualified Data.IORef                     as IORef
+import           Data.List                      (foldl')
 import           Data.Maybe                     (maybeToList)
 import qualified Data.Text                      as T
 import qualified Data.Text.IO                   as T
+import           Patat.Eval.Internal
 import           Patat.Presentation.Instruction
 import           Patat.Presentation.Internal
-import           Patat.Presentation.Settings
 import           System.Exit                    (ExitCode (..))
 import qualified System.IO                      as IO
-import           System.IO.Unsafe               (unsafeInterleaveIO)
 import qualified System.Process                 as Process
 import qualified Text.Pandoc.Definition         as Pandoc
 
 
 --------------------------------------------------------------------------------
-eval :: Presentation -> IO Presentation
-eval presentation = case psEval (pSettings presentation) of
-    Nothing -> pure presentation
-    Just settings -> do
-        slides <- traverse (evalSlide settings) (pSlides presentation)
-        pure presentation {pSlides = slides}
+parseEvalBlocks :: Presentation -> Presentation
+parseEvalBlocks presentation =
+    let ((pres, varGen), evalBlocks) = runWriter $
+            runStateT work (pVarGen presentation) in
+    pres {pEvalBlocks = evalBlocks, pVarGen = varGen}
+  where
+    work = case psEval (pSettings presentation) of
+        Nothing -> pure presentation
+        Just settings -> do
+            slides <- traverse (evalSlide settings) (pSlides presentation)
+            pure presentation {pSlides = slides}
 
 
 --------------------------------------------------------------------------------
@@ -40,7 +54,13 @@ lookupSettings classes settings = do
 
 
 --------------------------------------------------------------------------------
-evalSlide :: EvalSettingsMap -> Slide -> IO Slide
+-- | Monad used for identifying and extracting the evaluation blocks from a
+-- presentation.
+type ExtractEvalM a = StateT VarGen (Writer (HMS.HashMap Var EvalBlock)) a
+
+
+--------------------------------------------------------------------------------
+evalSlide :: EvalSettingsMap -> Slide -> ExtractEvalM Slide
 evalSlide settings slide = case slideContent slide of
     TitleSlide _ _ -> pure slide
     ContentSlide instrs0 -> do
@@ -51,40 +71,35 @@ evalSlide settings slide = case slideContent slide of
 --------------------------------------------------------------------------------
 evalInstruction
     :: EvalSettingsMap -> Instruction Pandoc.Block
-    -> IO [Instruction Pandoc.Block]
+    -> ExtractEvalM [Instruction Pandoc.Block]
 evalInstruction settings instr = case instr of
     Pause         -> pure [Pause]
     ModifyLast i  -> map ModifyLast <$> evalInstruction settings i
     Append []     -> pure [Append []]
     Append blocks -> concat <$> traverse (evalBlock settings) blocks
+    AppendVar v   ->
+        -- Should not happen since we don't do recursive evaluation.
+        pure [AppendVar v]
     Delete        -> pure [Delete]
 
 
 --------------------------------------------------------------------------------
-evalBlock :: EvalSettingsMap -> Pandoc.Block -> IO [Instruction Pandoc.Block]
+evalBlock
+    :: EvalSettingsMap -> Pandoc.Block
+    -> ExtractEvalM [Instruction Pandoc.Block]
 evalBlock settings orig@(Pandoc.CodeBlock attr@(_, classes, _) txt)
     | [s@EvalSettings {..}] <- lookupSettings classes settings = do
-        out <- unsafeInterleaveIO $ do
-            EvalResult {..} <-  evalCode s txt
-            pure $ case erExitCode of
-                ExitSuccess -> erStdout
-                ExitFailure i ->
-                    evalCommand <> ": exit code " <> T.pack (show i) <> "\n" <>
-                    erStderr
-        let fmt = "eval"
-            blocks = case evalContainer of
-                EvalContainerCode   -> [Pandoc.CodeBlock attr out]
-                EvalContainerNone   -> [Pandoc.RawBlock fmt out]
-                EvalContainerInline -> [Pandoc.Plain [Pandoc.RawInline fmt out]]
+        var <- state freshVar
+        tell $ HMS.singleton var $ EvalBlock s attr txt Nothing
         pure $ case (evalFragment, evalReplace) of
-            (False, True) -> [Append blocks]
-            (False, False) -> [Append (orig : blocks)]
+            (False, True) -> [AppendVar var]
+            (False, False) -> [Append [orig], AppendVar var]
             (True, True) ->
                 [ Append [orig], Pause
-                , Delete, Append blocks
+                , Delete, AppendVar var
                 ]
             (True, False) ->
-                [Append [orig], Pause, Append blocks]
+                [Append [orig], Pause, AppendVar var]
     | _ : _ : _ <- lookupSettings classes settings =
         let msg = "patat eval matched multiple settings for " <>
                 T.intercalate "," classes in
@@ -94,30 +109,78 @@ evalBlock _ block =
 
 
 --------------------------------------------------------------------------------
-data EvalResult = EvalResult
-    { erExitCode :: !ExitCode
-    , erStdout   :: !T.Text
-    , erStderr   :: !T.Text
-    } deriving (Show)
+newAccum :: Monoid m => (m -> IO ()) -> IO (m -> IO ())
+newAccum f = do
+    ref <- IORef.newIORef mempty
+    pure $ \x ->
+        IORef.atomicModifyIORef' ref (\y -> let z = y <> x in (z, z)) >>= f
 
 
 --------------------------------------------------------------------------------
-evalCode :: EvalSettings -> T.Text -> IO EvalResult
-evalCode EvalSettings {..} input = do
-    let proc = (Process.shell $ T.unpack evalCommand)
-            { Process.std_in  = Process.CreatePipe
-            , Process.std_out = Process.CreatePipe
-            , Process.std_err = Process.CreatePipe
+evalVar :: Var -> ([Pandoc.Block] -> IO ()) -> Presentation -> IO Presentation
+evalVar var writeOutput presentation = case HMS.lookup var evalBlocks of
+    Nothing -> pure presentation
+    Just EvalBlock {..} | Just _ <- ebAsync -> pure presentation
+    Just eb@EvalBlock {..} -> do
+        let EvalSettings {..} = ebSettings
+
+        writeChunk <- newAccum (writeOutput . renderEvalBlock eb)
+        let drainLines copy h = do
+                c <- catch (T.hGetChunk h) ((\_ -> pure "") :: IOException -> IO T.Text)
+                when (c /= "") $ do
+                    when copy $ writeChunk c
+                    drainLines copy h
+
+        let proc = (Process.shell $ T.unpack evalCommand)
+                { Process.std_in  = Process.CreatePipe
+                , Process.std_out = Process.CreatePipe
+                , Process.std_err = Process.CreatePipe
+                }
+        (Just hIn, Just hOut, Just hErr, hProc) <- Process.createProcess proc
+        async <- Async.async $
+            Async.withAsync (T.hPutStr hIn ebInput `finally` IO.hClose hIn) $ \_ ->
+            Async.withAsync (drainLines True hOut) $ \outAsync ->
+            Async.withAsync (drainLines evalStderr hErr) $ \errAsync ->
+            Async.withAsync (Process.waitForProcess hProc) $ \exitCodeAsync -> do
+            erExitCode <- Async.wait exitCodeAsync
+            _ <- Async.wait outAsync
+            _ <- Async.wait errAsync
+            case erExitCode of
+                ExitSuccess -> pure ()
+                ExitFailure i -> writeChunk $
+                    evalCommand <> ": exit code " <> T.pack (show i) <> "\n"
+        pure presentation
+            { pEvalBlocks = HMS.insert var eb {ebAsync = Just async} evalBlocks
             }
+  where
+    evalBlocks = pEvalBlocks presentation
 
-    (Just hIn, Just hOut, Just hErr, hProc) <- Process.createProcess proc
 
-    Async.withAsync (T.hPutStr hIn input `finally` IO.hClose hIn) $ \_ ->
-        Async.withAsync (T.hGetContents hOut) $ \outAsync ->
-        Async.withAsync (T.hGetContents hErr) $ \errAsync ->
-        Async.withAsync (Process.waitForProcess hProc) $ \exitCodeAsync -> do
 
-        erExitCode <- Async.wait exitCodeAsync
-        erStdout <- Async.wait outAsync
-        erStderr <- Async.wait errAsync
-        pure $ EvalResult {..}
+--------------------------------------------------------------------------------
+evalActiveVars
+    :: (Var -> [Pandoc.Block] -> IO ()) -> Presentation -> IO Presentation
+evalActiveVars update presentation = foldM
+    (\p var -> evalVar var (update var) p)
+    presentation
+    (activeVars presentation)
+
+
+--------------------------------------------------------------------------------
+evalAllVars :: Presentation -> IO Presentation
+evalAllVars pres = do
+    updates <- IORef.newIORef []
+
+    let forceEvalVar pres0 var = do
+            pres1 <- evalVar
+                var
+                (\u -> IORef.atomicModifyIORef' updates (\l -> (l ++ [u], ())))
+                pres0
+            case HMS.lookup var (pEvalBlocks pres1) of
+                Nothing -> pure pres1
+                Just eb -> do
+                    for_ (ebAsync eb) Async.wait
+                    IORef.atomicModifyIORef' updates $ \l ->
+                        ([], foldl' (\p u -> updateVar var u p) pres1 l)
+
+    foldM forceEvalVar pres (HMS.keys (pEvalBlocks pres))

lib/Patat/Eval/Internal.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+module Patat.Eval.Internal
+    ( EvalBlocks
+    , EvalBlock (..)
+    , renderEvalBlock
+    ) where
+
+
+--------------------------------------------------------------------------------
+import qualified Control.Concurrent.Async       as Async
+import qualified Data.HashMap.Strict            as HMS
+import qualified Data.Text                      as T
+import           Patat.Presentation.Instruction
+import           Patat.Presentation.Settings
+import qualified Text.Pandoc                    as Pandoc
+
+
+--------------------------------------------------------------------------------
+type EvalBlocks = HMS.HashMap Var EvalBlock
+
+
+--------------------------------------------------------------------------------
+-- | Block that needs to be evaluated.
+data EvalBlock = EvalBlock
+    { ebSettings :: !EvalSettings
+    , ebAttr     :: !Pandoc.Attr
+    , ebInput    :: !T.Text
+    , ebAsync    :: !(Maybe (Async.Async ()))
+    }
+
+
+--------------------------------------------------------------------------------
+renderEvalBlock :: EvalBlock -> T.Text -> [Pandoc.Block]
+renderEvalBlock EvalBlock {..} out = case evalContainer ebSettings of
+    EvalContainerCode   -> [Pandoc.CodeBlock ebAttr out]
+    EvalContainerNone   -> [Pandoc.RawBlock fmt out]
+    EvalContainerInline -> [Pandoc.Plain [Pandoc.RawInline fmt out]]
+  where
+    fmt = "eval"

lib/Patat/Main.hs

@@ -24,6 +24,7 @@ import qualified Options.Applicative              as OA
 import qualified Options.Applicative.Help.Pretty  as OA.PP
 import           Patat.AutoAdvance
 import qualified Patat.EncodingFallback           as EncodingFallback
+import qualified Patat.Eval                       as Eval
 import qualified Patat.Images                     as Images
 import           Patat.Presentation
 import qualified Patat.Presentation.Comments      as Comments
@@ -160,15 +161,15 @@ main = do
             OA.parserFailure parserPrefs parserInfo
             (OA.ShowHelpText Nothing) mempty
 
-    errOrPres <- readPresentation filePath
+    errOrPres <- readPresentation zeroVarGen filePath
     pres      <- either (errorAndExit . return) return errOrPres
     let settings = pSettings pres
 
     unless (oForce options) assertAnsiFeatures
 
     if oDump options then
-        EncodingFallback.withHandle IO.stdout (pEncodingFallback pres) $
-        dumpPresentation pres
+        EncodingFallback.withHandle IO.stdout (pEncodingFallback pres) $ do
+        Eval.evalAllVars pres >>= dumpPresentation
     else
         -- (Maybe) initialize images backend.
         withMaybeHandle Images.withHandle (psImages settings) $ \images ->
@@ -209,15 +210,20 @@ loop app@App {..} = do
         (pEncodingFallback aPresentation)
         (activeSpeakerNotes aPresentation)
 
-    size <- getPresentationSize aPresentation
+    -- Start necessary eval blocks
+    presentation <- Eval.evalActiveVars
+        (\v -> Chan.writeChan aCommandChan . PresentationCommand . UpdateVar v)
+        aPresentation
+
+    size <- getPresentationSize presentation
     Ansi.clearScreen
     Ansi.setCursorPosition 0 0
     cleanup <- case aView of
-        PresentationView -> case displayPresentation size aPresentation of
+        PresentationView -> case displayPresentation size presentation of
             DisplayDoc doc    -> drawDoc doc
             DisplayImage path -> drawImg size path
         ErrorView err -> drawDoc $
-                displayPresentationError size aPresentation err
+                displayPresentationError size presentation err
         TransitionView tr -> do
             drawMatrix (tiSize tr) . fst . NonEmpty.head $ tiFrames tr
             pure mempty
@@ -234,11 +240,11 @@ loop app@App {..} = do
                     loop app {aView = TransitionView tr1}
                 Nothing -> loop app {aView = PresentationView}
         PresentationCommand c -> do
-            update <- updatePresentation c aPresentation
+            update <- updatePresentation c presentation
             case update of
                 ExitedPresentation       -> return ()
                 UpdatedPresentation pres
-                    | Just tgen <- mbTransition c size aPresentation pres -> do
+                    | Just tgen <- mbTransition c size presentation pres -> do
                         tr <- tgen
                         scheduleTransitionTick tr
                         loop app
@@ -251,7 +257,7 @@ loop app@App {..} = do
     drawDoc doc = EncodingFallback.withHandle
         IO.stdout (pEncodingFallback aPresentation) $
         PP.putDoc doc $> mempty
-    drawImg size path =case aImages of
+    drawImg size path = case aImages of
         Nothing -> drawDoc $ displayPresentationError
             size aPresentation "image backend not initialized"
         Just img -> do

lib/Patat/Presentation.hs

@@ -2,10 +2,15 @@ module Patat.Presentation
     ( PresentationSettings (..)
     , defaultPresentationSettings
 
+    , VarGen
+    , Var
+    , zeroVarGen
+
     , Presentation (..)
     , readPresentation
 
     , activeSpeakerNotes
+    , activeVars
 
     , Size
     , getPresentationSize
@@ -22,6 +27,7 @@ module Patat.Presentation
     ) where
 
 import           Patat.Presentation.Display
+import           Patat.Presentation.Instruction
 import           Patat.Presentation.Interactive
 import           Patat.Presentation.Internal
 import           Patat.Presentation.Read

lib/Patat/Presentation/Display.hs

@@ -161,7 +161,7 @@ dumpPresentation pres@Presentation {..} =
     dumpFragment :: Index -> [PP.Doc]
     dumpFragment idx =
         case displayPresentation (getSize idx) pres {pActiveFragment = idx} of
-            DisplayDoc doc        -> [doc]
+            DisplayDoc   doc      -> [doc]
             DisplayImage filepath -> [PP.string $ "{image: " ++ filepath ++ "}"]
 
     getSize :: Index -> Size
@@ -187,7 +187,7 @@ prettyFragment ds (Fragment blocks) = vertical $
         mconcat (replicate top PP.hardline) <> doc0
       where
         top = case mTop of
-            Auto -> let (r, _) = PP.dimensions doc0 in (rows - r) `div` 2
+            Auto      -> let (r, _) = PP.dimensions doc0 in (rows - r) `div` 2
             NotAuto x -> x
 
     horizontal = horizontalIndent . horizontalWrap

lib/Patat/Presentation/Fragment.hs

@@ -30,6 +30,7 @@ fragmentInstructions fs = fromList . concatMap fragmentInstruction . toList
     fragmentInstruction Pause = [Pause]
     fragmentInstruction (Append []) = [Append []]
     fragmentInstruction (Append xs) = fragmentBlocks fs xs
+    fragmentInstruction (AppendVar v) = [AppendVar v]
     fragmentInstruction Delete = [Delete]
     fragmentInstruction (ModifyLast f) = map ModifyLast $ fragmentInstruction f
 

lib/Patat/Presentation/Instruction.hs

@@ -4,21 +4,33 @@
 --
 -- We do this by modelling a slide as a list of instructions, that manipulate
 -- the contents on a slide in a (for now) very basic way.
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Patat.Presentation.Instruction
     ( Instructions
     , fromList
     , toList
 
+    , Var
+    , VarGen
+    , zeroVarGen
+    , freshVar
+
     , Instruction (..)
+    , beforePause
     , numFragments
+    , variables
 
     , Fragment (..)
     , renderFragment
     ) where
 
-import qualified Text.Pandoc as Pandoc
+import           Data.Hashable (Hashable)
+import qualified Data.HashSet as HS
+import           Data.List     (foldl')
+import qualified Text.Pandoc   as Pandoc
 
-newtype Instructions a = Instructions [Instruction a] deriving (Show)
+newtype Instructions a = Instructions {unInstructions :: [Instruction a]}
+    deriving (Show)
 
 -- A smart constructor that guarantees some invariants:
 --
@@ -36,11 +48,26 @@ fromList = Instructions . go
 toList :: Instructions a -> [Instruction a]
 toList (Instructions xs) = xs
 
+-- | A variable is like a placeholder in the instructions, something we don't
+-- know yet, dynamic content.  Currently this is only used for code evaluation.
+newtype Var = Var Int deriving (Hashable, Eq, Ord, Show)
+
+-- | Used to generate fresh variables.
+newtype VarGen = VarGen Int deriving (Show)
+
+zeroVarGen :: VarGen
+zeroVarGen = VarGen 0
+
+freshVar :: VarGen -> (Var, VarGen)
+freshVar (VarGen x) = (Var x, VarGen (x + 1))
+
 data Instruction a
     -- Pause.
     = Pause
     -- Append items.
     | Append [a]
+    -- Append the content of a variable.
+    | AppendVar Var
     -- Remove the last item.
     | Delete
     -- Modify the last block with the provided instruction.
@@ -48,52 +75,75 @@ data Instruction a
     deriving (Show)
 
 isPause :: Instruction a -> Bool
-isPause Pause = True
-isPause (Append _) = False
-isPause Delete = False
+isPause Pause          = True
+isPause (Append _)     = False
+isPause (AppendVar _)  = False
+isPause Delete         = False
 isPause (ModifyLast i) = isPause i
 
 numPauses :: Instructions a -> Int
 numPauses (Instructions xs) = length $ filter isPause xs
 
+beforePause :: Int -> Instructions a -> Instructions a
+beforePause n = Instructions . go 0 . unInstructions
+  where
+    go _ []          = []
+    go i (Pause : t) = if i >= n then [] else go (i + 1) t
+    go i (h     : t) = h : go i t
+
+variables :: Instructions a -> HS.HashSet Var
+variables (Instructions []               )  = mempty
+variables (Instructions (AppendVar v : t))  = HS.insert v (variables (Instructions t))
+variables (Instructions (ModifyLast i : t)) = variables (Instructions t) <> variables (Instructions [i])
+variables (Instructions (_           : t))  = variables (Instructions t)
+
 numFragments :: Instructions a -> Int
 numFragments = succ . numPauses
 
 newtype Fragment = Fragment [Pandoc.Block] deriving (Show)
 
-renderFragment :: Int -> Instructions Pandoc.Block -> Fragment
-renderFragment = \n (Instructions instrs) -> Fragment $ go [] n instrs
-  where
-    go acc _ []         = acc
-    go acc n (Pause : instrs) = if n <= 0 then acc else go acc (n - 1) instrs
-    go acc n (instr : instrs) = go (goBlocks instr acc) n instrs
+renderFragment
+    :: (Var -> [Pandoc.Block]) -> Instructions Pandoc.Block -> Fragment
+renderFragment resolve = \instrs -> Fragment $ foldl'
+    (\acc instr -> goBlocks resolve instr acc) [] (unInstructions instrs)
 
-goBlocks :: Instruction Pandoc.Block -> [Pandoc.Block] -> [Pandoc.Block]
-goBlocks Pause xs = xs
-goBlocks (Append ys) xs = xs ++ ys
-goBlocks Delete xs = sinit xs
-goBlocks (ModifyLast f) xs
+goBlocks
+    :: (Var -> [Pandoc.Block]) -> Instruction Pandoc.Block -> [Pandoc.Block]
+    -> [Pandoc.Block]
+goBlocks _ Pause xs = xs
+goBlocks _ (Append ys) xs = xs ++ ys
+goBlocks resolve (AppendVar v) xs = xs ++ resolve v
+goBlocks _ Delete xs = sinit xs
+goBlocks resolve (ModifyLast f) xs
     | null xs   = xs  -- Shouldn't happen unless instructions are malformed.
-    | otherwise = modifyLast (goBlock f) xs
+    | otherwise = modifyLast (goBlock resolve f) xs
 
-goBlock :: Instruction Pandoc.Block -> Pandoc.Block -> Pandoc.Block
-goBlock Pause x = x
-goBlock (Append ys) block = case block of
+goBlock
+    :: (Var -> [Pandoc.Block]) -> Instruction Pandoc.Block -> Pandoc.Block
+    -> Pandoc.Block
+goBlock _ Pause x = x
+goBlock _ (Append ys) block = case block of
     -- We can only append to a few specific block types for now.
-    Pandoc.BulletList xs -> Pandoc.BulletList $ xs ++ [ys]
+    Pandoc.BulletList xs       -> Pandoc.BulletList $ xs ++ [ys]
     Pandoc.OrderedList attr xs -> Pandoc.OrderedList attr $ xs ++ [ys]
-    _ -> block
-goBlock Delete block = case block of
+    _                          -> block
+goBlock resolve (AppendVar v) block = case block of
     -- We can only append to a few specific block types for now.
-    Pandoc.BulletList xs -> Pandoc.BulletList $ sinit xs
+    Pandoc.BulletList xs       -> Pandoc.BulletList $ xs ++ [resolve v]
+    Pandoc.OrderedList attr xs -> Pandoc.OrderedList attr $ xs ++ [resolve v]
+    _                          -> block
+goBlock _ Delete block = case block of
+    -- We can only delete from a few specific block types for now.
+    Pandoc.BulletList xs       -> Pandoc.BulletList $ sinit xs
     Pandoc.OrderedList attr xs -> Pandoc.OrderedList attr $ sinit xs
-    _ -> block
-goBlock (ModifyLast f) block = case block of
+    _                          -> block
+goBlock resolve (ModifyLast f) block = case block of
     -- We can only modify the last content of a few specific block types for
     -- now.
-    Pandoc.BulletList xs -> Pandoc.BulletList $ modifyLast (goBlocks f) xs
-    Pandoc.OrderedList attr xs ->
-        Pandoc.OrderedList attr $ modifyLast (goBlocks f) xs
+    Pandoc.BulletList xs -> Pandoc.BulletList $
+        modifyLast (goBlocks resolve f) xs
+    Pandoc.OrderedList attr xs -> Pandoc.OrderedList attr $
+        modifyLast (goBlocks resolve f) xs
     _ -> block
 
 modifyLast :: (a -> a) -> [a] -> [a]

lib/Patat/Presentation/Interactive.hs

@@ -13,11 +13,13 @@ module Patat.Presentation.Interactive
 
 
 --------------------------------------------------------------------------------
-import           Data.Char                   (isDigit)
+import           Data.Char                      (isDigit)
+import           Patat.Presentation.Instruction (Var)
 import           Patat.Presentation.Internal
 import           Patat.Presentation.Read
-import qualified System.IO                   as IO
-import           Text.Read                   (readMaybe)
+import qualified System.IO                      as IO
+import qualified Text.Pandoc                    as Pandoc
+import           Text.Read                      (readMaybe)
 
 
 --------------------------------------------------------------------------------
@@ -31,6 +33,7 @@ data PresentationCommand
     | Last
     | Reload
     | Seek Int
+    | UpdateVar Var [Pandoc.Block]
     | UnknownCommand String
     deriving (Eq, Show)
 
@@ -96,16 +99,17 @@ updatePresentation
     :: PresentationCommand -> Presentation -> IO UpdatedPresentation
 
 updatePresentation cmd presentation = case cmd of
-    Exit             -> return ExitedPresentation
-    Forward          -> return $ goToSlide $ \(s, f) -> (s, f + 1)
-    Backward         -> return $ goToSlide $ \(s, f) -> (s, f - 1)
-    SkipForward      -> return $ goToSlide $ \(s, _) -> (s + 10, 0)
-    SkipBackward     -> return $ goToSlide $ \(s, _) -> (s - 10, 0)
-    First            -> return $ goToSlide $ \_ -> (0, 0)
-    Last             -> return $ goToSlide $ \_ -> (numSlides presentation, 0)
-    Seek n           -> return $ goToSlide $ \_ -> (n - 1, 0)
+    Exit             -> pure ExitedPresentation
+    Forward          -> pure $ goToSlide $ \(s, f) -> (s, f + 1)
+    Backward         -> pure $ goToSlide $ \(s, f) -> (s, f - 1)
+    SkipForward      -> pure $ goToSlide $ \(s, _) -> (s + 10, 0)
+    SkipBackward     -> pure $ goToSlide $ \(s, _) -> (s - 10, 0)
+    First            -> pure $ goToSlide $ \_ -> (0, 0)
+    Last             -> pure $ goToSlide $ \_ -> (numSlides presentation, 0)
+    Seek n           -> pure $ goToSlide $ \_ -> (n - 1, 0)
     Reload           -> reloadPresentation
-    UnknownCommand _ -> return (UpdatedPresentation presentation)
+    UnknownCommand _ -> pure $ UpdatedPresentation presentation
+    UpdateVar v b    -> pure $ UpdatedPresentation $ updateVar v b presentation
   where
     numSlides :: Presentation -> Int
     numSlides pres = length (pSlides pres)
@@ -133,7 +137,7 @@ updatePresentation cmd presentation = case cmd of
         }
 
     reloadPresentation = do
-        errOrPres <- readPresentation (pFilePath presentation)
+        errOrPres <- readPresentation (pVarGen presentation) (pFilePath presentation)
         return $ case errOrPres of
             Left  err  -> ErroredPresentation err
             Right pres -> UpdatedPresentation $ pres

lib/Patat/Presentation/Internal.hs

@@ -31,21 +31,27 @@ module Patat.Presentation.Internal
     , ActiveFragment (..)
     , activeFragment
     , activeSpeakerNotes
+    , activeVars
 
     , getSettings
     , activeSettings
 
     , Size
     , getPresentationSize
+
+    , updateVar
     ) where
 
 
 --------------------------------------------------------------------------------
 import qualified Data.Aeson.Extended            as A
+import qualified Data.HashMap.Strict            as HMS
+import qualified Data.HashSet                   as HS
 import           Data.Maybe                     (fromMaybe)
 import           Data.Sequence.Extended         (Seq)
 import qualified Data.Sequence.Extended         as Seq
 import           Patat.EncodingFallback         (EncodingFallback)
+import qualified Patat.Eval.Internal            as Eval
 import qualified Patat.Presentation.Comments    as Comments
 import qualified Patat.Presentation.Instruction as Instruction
 import           Patat.Presentation.Settings
@@ -73,6 +79,9 @@ data Presentation = Presentation
     , pTransitionGens   :: !(Seq (Maybe TransitionGen))  -- One for each slide.
     , pActiveFragment   :: !Index
     , pSyntaxMap        :: !Skylighting.SyntaxMap
+    , pEvalBlocks       :: !Eval.EvalBlocks
+    , pVarGen           :: !Instruction.VarGen
+    , pVars             :: !(HMS.HashMap Instruction.Var [Pandoc.Block])
     }
 
 
@@ -144,7 +153,10 @@ activeFragment presentation = do
         TitleSlide lvl is -> ActiveTitle $
             Pandoc.Header lvl Pandoc.nullAttr is
         ContentSlide instrs -> ActiveContent $
-            Instruction.renderFragment fidx instrs
+            Instruction.renderFragment resolve $
+            Instruction.beforePause fidx instrs
+  where
+    resolve var = fromMaybe [] $ HMS.lookup var (pVars presentation)
 
 
 --------------------------------------------------------------------------------
@@ -155,6 +167,17 @@ activeSpeakerNotes presentation = fromMaybe mempty $ do
     pure . Comments.cSpeakerNotes $ slideComment slide
 
 
+--------------------------------------------------------------------------------
+activeVars :: Presentation -> HS.HashSet Instruction.Var
+activeVars presentation = fromMaybe HS.empty $ do
+    let (sidx, fidx) = pActiveFragment presentation
+    slide <- getSlide sidx presentation
+    case slideContent slide of
+        TitleSlide _ _ -> Nothing
+        ContentSlide instrs -> pure $ Instruction.variables $
+            Instruction.beforePause fidx instrs
+
+
 --------------------------------------------------------------------------------
 getSettings :: Int -> Presentation -> PresentationSettings
 getSettings sidx pres =
@@ -177,3 +200,8 @@ getPresentationSize pres = do
     pure $ Size {sRows = rows, sCols = cols}
   where
     settings = activeSettings pres
+
+
+--------------------------------------------------------------------------------
+updateVar :: Instruction.Var -> [Pandoc.Block] -> Presentation -> Presentation
+updateVar var blocks pres = pres {pVars = HMS.insert var blocks $ pVars pres}

lib/Patat/Presentation/Read.hs

@@ -28,10 +28,11 @@ import           Data.Traversable               (for)
 import qualified Data.Yaml                      as Yaml
 import           Patat.EncodingFallback         (EncodingFallback)
 import qualified Patat.EncodingFallback         as EncodingFallback
-import           Patat.Eval                     (eval)
+import qualified Patat.Eval                     as Eval
 import qualified Patat.Presentation.Comments    as Comments
 import           Patat.Presentation.Fragment
 import qualified Patat.Presentation.Instruction as Instruction
+import           Patat.Presentation.Instruction (VarGen)
 import           Patat.Presentation.Internal
 import           Patat.Transition               (parseTransitionSettings)
 import           Prelude
@@ -47,8 +48,8 @@ import qualified Text.Pandoc.Extended           as Pandoc
 
 
 --------------------------------------------------------------------------------
-readPresentation :: FilePath -> IO (Either String Presentation)
-readPresentation filePath = runExceptT $ do
+readPresentation :: VarGen -> FilePath -> IO (Either String Presentation)
+readPresentation varGen filePath = runExceptT $ do
     -- We need to read the settings first.
     (enc, src)   <- liftIO $ EncodingFallback.readFile filePath
     homeSettings <- ExceptT readHomeSettings
@@ -71,8 +72,8 @@ readPresentation filePath = runExceptT $ do
         Right x -> return x
 
     pres <- ExceptT $ pure $
-        pandocToPresentation filePath enc settings syntaxMap doc
-    liftIO $ eval pres
+        pandocToPresentation varGen filePath enc settings syntaxMap doc
+    pure $ Eval.parseEvalBlocks pres
   where
     ext = takeExtension filePath
 
@@ -122,9 +123,9 @@ readExtension (ExtensionList extensions) fileExt = case fileExt of
 
 --------------------------------------------------------------------------------
 pandocToPresentation
-    :: FilePath -> EncodingFallback -> PresentationSettings
+    :: VarGen -> FilePath -> EncodingFallback -> PresentationSettings
     -> Skylighting.SyntaxMap -> Pandoc.Pandoc -> Either String Presentation
-pandocToPresentation pFilePath pEncodingFallback pSettings pSyntaxMap
+pandocToPresentation pVarGen pFilePath pEncodingFallback pSettings pSyntaxMap
         pandoc@(Pandoc.Pandoc meta _) = do
     let !pTitle          = case Pandoc.docTitle meta of
             []    -> [Pandoc.Str . T.pack . snd $ splitFileName pFilePath]
@@ -133,6 +134,8 @@ pandocToPresentation pFilePath pEncodingFallback pSettings pSyntaxMap
         !pBreadcrumbs    = collectBreadcrumbs pSlides
         !pActiveFragment = (0, 0)
         !pAuthor         = concat (Pandoc.docAuthors meta)
+        !pEvalBlocks     = mempty
+        !pVars           = mempty
     pSlideSettings <- Seq.traverseWithIndex
         (\i ->
             first (\err -> "on slide " ++ show (i + 1) ++ ": " ++ err) .

lib/Patat/Presentation/Settings.hs

@@ -248,6 +248,7 @@ data EvalSettings = EvalSettings
     , evalReplace   :: !Bool
     , evalFragment  :: !Bool
     , evalContainer :: !EvalSettingsContainer
+    , evalStderr    :: !Bool
     } deriving (Show)
 
 
@@ -258,6 +259,7 @@ instance A.FromJSON EvalSettings where
         <*> o A..:? "replace"  A..!= False
         <*> o A..:? "fragment" A..!= True
         <*> deprecated "wrap" "container" EvalContainerCode o
+        <*> o A..:? "stderr" A..!= True
       where
         deprecated old new def obj = do
             mo <- obj A..:? old

patat.cabal

@@ -43,6 +43,7 @@ Library
     containers           >= 0.5  && < 0.7,
     directory            >= 1.2  && < 1.4,
     filepath             >= 1.4  && < 1.6,
+    hashable             >= 1.4  && < 1.5,
     mtl                  >= 2.2  && < 2.4,
     optparse-applicative >= 0.16 && < 0.19,
     pandoc               >= 3.1  && < 3.3,
@@ -71,6 +72,7 @@ Library
     Patat.Cleanup
     Patat.EncodingFallback
     Patat.Eval
+    Patat.Eval.Internal
     Patat.Images
     Patat.Images.Internal
     Patat.Images.ITerm2

tests/golden/inputs/eval08.md

@@ -0,0 +1,38 @@
+---
+patat:
+  eval:
+    implicitStderr:
+      command: sh
+      replace: true
+      fragment: false
+    withStderr:
+      command: sh
+      replace: true
+      fragment: false
+      stderr: true
+    withoutStderr:
+      command: sh
+      replace: true
+      fragment: false
+      stderr: false
+...
+
+# Slide
+
+~~~{.implicitStderr}
+echo "Hello stdout"
+sleep 0.1
+echo "Hello stderr" >&2
+~~~
+
+~~~{.withStderr}
+echo "Hello stdout"
+sleep 0.1
+echo "Hello stderr" >&2
+~~~
+
+~~~{.withoutStderr}
+echo "Hello stdout"
+sleep 0.1
+echo "Hello stderr" >&2
+~~~

tests/golden/outputs/eval08.md.dump

@@ -0,0 +1,19 @@
+                               eval08.md                                
+
+# Slide
+
+                 
+    Hello stdout 
+    Hello stderr 
+                 
+
+                 
+    Hello stdout 
+    Hello stderr 
+                 
+
+                 
+    Hello stdout 
+                 
+
+                                                                  1 / 1