WIP

lib/Patat/Eval.hs

@@ -9,8 +9,9 @@ module Patat.Eval
 --------------------------------------------------------------------------------
 import qualified Control.Concurrent.Async       as Async
 import           Control.Exception              (finally)
-import           Control.Monad.State            (StateT, runStateT)
+import           Control.Monad.State            (StateT, runStateT, state)
 import           Control.Monad.Trans            (liftIO)
+import           Control.Monad.Writer           (WriterT, runWriterT, tell)
 import qualified Data.HashMap.Strict            as HMS
 import           Data.Maybe                     (maybeToList)
 import qualified Data.Text                      as T
@@ -28,7 +29,8 @@ import qualified Text.Pandoc.Definition         as Pandoc
 --------------------------------------------------------------------------------
 eval :: Presentation -> IO Presentation
 eval presentation = do
-    (pres, varGen) <- runStateT work (pVarGen presentation)
+    ((pres, varGen), evalBlocks) <- runWriterT $
+        runStateT work (pVarGen presentation)
     pure pres {pVarGen = varGen}
   where
     work = case psEval (pSettings presentation) of
@@ -46,7 +48,18 @@ lookupSettings classes settings = do
 
 
 --------------------------------------------------------------------------------
-evalSlide :: EvalSettingsMap -> Slide -> StateT VarGen IO Slide
+-- | Block that needs to be evaluated.
+data EvalBlock = EvalBlock EvalSettings T.Text
+
+
+--------------------------------------------------------------------------------
+-- | Monad used for identifying and extracting the evaluation blocks from a
+-- presentation.
+type ExtractEvalM a = StateT VarGen (WriterT (HMS.HashMap Var EvalBlock) IO) a
+
+
+--------------------------------------------------------------------------------
+evalSlide :: EvalSettingsMap -> Slide -> ExtractEvalM Slide
 evalSlide settings slide = case slideContent slide of
     TitleSlide _ _ -> pure slide
     ContentSlide instrs0 -> do
@@ -57,7 +70,7 @@ evalSlide settings slide = case slideContent slide of
 --------------------------------------------------------------------------------
 evalInstruction
     :: EvalSettingsMap -> Instruction Pandoc.Block
-    -> StateT VarGen IO [Instruction Pandoc.Block]
+    -> ExtractEvalM [Instruction Pandoc.Block]
 evalInstruction settings instr = case instr of
     Pause         -> pure [Pause]
     ModifyLast i  -> map ModifyLast <$> evalInstruction settings i
@@ -72,11 +85,13 @@ evalInstruction settings instr = case instr of
 --------------------------------------------------------------------------------
 evalBlock
     :: EvalSettingsMap -> Pandoc.Block
-    -> StateT VarGen IO [Instruction Pandoc.Block]
+    -> ExtractEvalM [Instruction Pandoc.Block]
 evalBlock settings orig@(Pandoc.CodeBlock attr@(_, classes, _) txt)
     | [s@EvalSettings {..}] <- lookupSettings classes settings = do
+        var <- state freshVar
+        tell $ HMS.singleton var $ EvalBlock s txt
         out <- liftIO $ unsafeInterleaveIO $ do
-            EvalResult {..} <-  evalCode s txt
+            EvalResult {..} <- evalCode s txt
             pure $ case erExitCode of
                 ExitSuccess -> erStdout
                 ExitFailure i ->

lib/Patat/Presentation/Display.hs

@@ -103,11 +103,11 @@ displayPresentation :: Size -> Presentation -> Display
 displayPresentation size pres@Presentation {..} =
      case activeFragment pres of
         Nothing -> DisplayDoc $ displayWithBorders size pres mempty
-        Just (ActiveContent fragment)
+        Just (ActiveContent fragment _)
                 | Just _ <- psImages pSettings
                 , Just image <- onlyImage fragment ->
             DisplayImage $ T.unpack image
-        Just (ActiveContent fragment) -> DisplayDoc $
+        Just (ActiveContent fragment _) -> DisplayDoc $
             displayWithBorders size pres $ \theme ->
                 prettyFragment theme fragment
         Just (ActiveTitle block) -> DisplayDoc $

lib/Patat/Presentation/Instruction.hs

@@ -4,6 +4,7 @@
 --
 -- 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
@@ -23,8 +24,9 @@ module Patat.Presentation.Instruction
     , renderFragment
     ) where
 
-import           Data.List   (foldl')
-import qualified Text.Pandoc as Pandoc
+import           Data.Hashable (Hashable)
+import           Data.List     (foldl')
+import qualified Text.Pandoc   as Pandoc
 
 newtype Instructions a = Instructions {unInstructions :: [Instruction a]}
     deriving (Show)
@@ -47,7 +49,7 @@ 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 (Show)
+newtype Var = Var Int deriving (Hashable, Eq, Ord, Show)
 
 -- | Used to generate fresh variables.
 newtype VarGen = VarGen Int deriving (Show)

lib/Patat/Presentation/Internal.hs

@@ -132,7 +132,7 @@ numFragments slide = case slideContent slide of
 
 --------------------------------------------------------------------------------
 data ActiveFragment
-    = ActiveContent Instruction.Fragment
+    = ActiveContent Instruction.Fragment [Instruction.Var]
     | ActiveTitle Pandoc.Block
     deriving (Show)
 
@@ -145,9 +145,11 @@ activeFragment presentation = do
     pure $ case slideContent slide of
         TitleSlide lvl is -> ActiveTitle $
             Pandoc.Header lvl Pandoc.nullAttr is
-        ContentSlide instrs -> ActiveContent $
-            Instruction.renderFragment resolve $
-            Instruction.beforePause fidx instrs
+        ContentSlide instrs ->
+            let active = Instruction.beforePause fidx instrs in
+            ActiveContent
+                (Instruction.renderFragment resolve active)
+                (Instruction.variables active)
   where
     resolve _ = [Pandoc.Para [Pandoc.Str "implement resolve"]]