patat 0.12.0.1 → 0.13.0.0

raw patch · 16 files changed

+362/−136 lines, 16 filesdep +goldplatedep +hashabledep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: goldplate, hashable

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +20/−0
• README.md +5/−24
• lib/Patat/Eval.hs +112/−49
• lib/Patat/Eval/Internal.hs +40/−0
• lib/Patat/Main.hs +15/−9
• lib/Patat/Presentation.hs +6/−0
• lib/Patat/Presentation/Display.hs +2/−2
• lib/Patat/Presentation/Fragment.hs +1/−0
• lib/Patat/Presentation/Instruction.hs +79/−29
• lib/Patat/Presentation/Interactive.hs +17/−13
• lib/Patat/Presentation/Internal.hs +29/−1
• lib/Patat/Presentation/Read.hs +10/−7
• lib/Patat/Presentation/Settings.hs +2/−0
• lib/Patat/Transition/Dissolve.hs +1/−1
• patat.cabal +15/−1
• tests/golden/Main.hs +8/−0

@@ -1,5 +1,25 @@ # Changelog +## 0.13.0.0 (2024-10-30)++ *  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)

@@ -81,31 +81,11 @@  ### From source -Installation from source is very easy.  You can build from source using `stack-install` or `cabal install`.  `patat` is also available from [Hackage].--[Hackage]: https://hackage.haskell.org/package/patat--For people unfamiliar with the Haskell ecosystem, this means you can do either-of the following:--#### Using stack--1. Install [stack] for your platform.-2. Clone this repository.-3. Run `stack setup` (if you're running stack for the first time) and-   `stack install`.-4. Make sure `$HOME/.local/bin` is in your `$PATH`.--[stack]: https://docs.haskellstack.org/en/stable/README/--#### Using cabal--1. Install [cabal] for your platform.-2. Run `cabal install patat`.-3. Make sure `$HOME/.cabal/bin` is in your `$PATH`.+`patat` is also available from [Hackage].  You can install it using [cabal] by+running `cabal install patat`.  [cabal]: https://www.haskell.org/cabal/+[Hackage]: https://hackage.haskell.org/package/patat  Running -------@@ -740,7 +720,7 @@ 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`.@@ -752,6 +732,7 @@      *  `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. 

@@ -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 @@   ---------------------------------------------------------------------------------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 @@ -------------------------------------------------------------------------------- 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 @@   ---------------------------------------------------------------------------------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))

@@ -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"

@@ -24,6 +24,7 @@ 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 @@             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 @@         (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 {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 @@     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

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

@@ -161,7 +161,7 @@     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 @@         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

@@ -30,6 +30,7 @@     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 

@@ -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 @@ 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 @@     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]

@@ -13,11 +13,13 @@   ---------------------------------------------------------------------------------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 @@     | Last     | Reload     | Seek Int+    | UpdateVar Var [Pandoc.Block]     | UnknownCommand String     deriving (Eq, Show) @@ -96,16 +99,17 @@     :: 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 @@         }      reloadPresentation = do-        errOrPres <- readPresentation (pFilePath presentation)+        errOrPres <- readPresentation (pVarGen presentation) (pFilePath presentation)         return $ case errOrPres of             Left  err  -> ErroredPresentation err             Right pres -> UpdatedPresentation $ pres

@@ -31,21 +31,27 @@     , 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 @@     , 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 @@         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)   --------------------------------------------------------------------------------@@ -156,6 +168,17 @@   --------------------------------------------------------------------------------+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 =     fromMaybe mempty (Seq.safeIndex (pSlideSettings pres) sidx) <>@@ -177,3 +200,8 @@     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}

@@ -28,10 +28,11 @@ 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 @@   ---------------------------------------------------------------------------------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 @@         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 @@  -------------------------------------------------------------------------------- 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 @@         !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) .

@@ -248,6 +248,7 @@     , evalReplace   :: !Bool     , evalFragment  :: !Bool     , evalContainer :: !EvalSettingsContainer+    , evalStderr    :: !Bool     } deriving (Show)  @@ -258,6 +259,7 @@         <*> 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

@@ -39,7 +39,7 @@     -- Select the initial or final value depending on the noise.     frame :: Double -> Matrix     frame t = V.zipWith3-        (\treshold l r -> if t < treshold then l else r)+        (\threshold l r -> if t < threshold then l else r)         noise         initial         final

@@ -1,5 +1,5 @@ Name:          patat-Version:       0.12.0.1+Version:       0.13.0.0 Synopsis:      Terminal-based presentations using Pandoc Description:   Terminal-based presentations using Pandoc. License:       GPL-2@@ -43,6 +43,7 @@     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 @@     Patat.Cleanup     Patat.EncodingFallback     Patat.Eval+    Patat.Eval.Internal     Patat.Images     Patat.Images.Internal     Patat.Images.ITerm2@@ -160,3 +162,15 @@     tasty-quickcheck >= 0.10 && < 0.11,     text             >= 1.2  && < 2.2,     QuickCheck       >= 2.8  && < 2.15++Test-suite patat-goldplate+  Main-is:            Main.hs+  Ghc-options:        -Wall+  Hs-source-dirs:     tests/golden+  Type:               exitcode-stdio-1.0+  Default-language:   Haskell2010+  Build-tool-depends: patat:patat++  Build-depends:+    base      >= 4.8     && < 5,+    goldplate >= 0.2.2.1 && < 0.3

@@ -0,0 +1,8 @@+import Goldplate   (Options (..), defaultOptions, mainWith)+import System.Exit (exitWith)++main :: IO ()+main = mainWith options >>= exitWith+  where+    options = defaultOptions+        { oPrettyDiff = True, oPaths = ["tests/golden"] }