diff --git a/lib/Patat/Eval.hs b/lib/Patat/Eval.hs index 0a85915..945831b 100644 --- a/lib/Patat/Eval.hs +++ b/lib/Patat/Eval.hs @@ -4,10 +4,9 @@ module Patat.Eval ( parseEvalBlocks - , updateVar , evalVar - , evalVars - , forceEval + , evalActiveVars + , evalAllVars ) where @@ -15,7 +14,7 @@ module Patat.Eval import qualified Control.Concurrent.Async as Async import Control.Exception (IOException, catch, finally) import Control.Monad (foldM, forever) -import Control.Monad.State (StateT, evalStateT, state) +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 @@ -36,8 +35,9 @@ import qualified Text.Pandoc.Definition as Pandoc -------------------------------------------------------------------------------- parseEvalBlocks :: Presentation -> Presentation parseEvalBlocks presentation = - let (pres, evalBlocks) = runWriter $ evalStateT work zeroVarGen in - pres {pEvalBlocks = evalBlocks} + 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 @@ -108,12 +108,6 @@ evalBlock _ block = pure [Append [block]] - --------------------------------------------------------------------------------- -updateVar :: Var -> [Pandoc.Block] -> Presentation -> Presentation -updateVar var blocks pres = pres {pVars = HMS.insert var blocks $ pVars pres} - - -------------------------------------------------------------------------------- evalVar :: Var -> ([Pandoc.Block] -> IO ()) -> Presentation -> IO Presentation evalVar var writeOutput presentation = case HMS.lookup var evalBlocks of @@ -162,17 +156,17 @@ evalVar var writeOutput presentation = case HMS.lookup var evalBlocks of -------------------------------------------------------------------------------- -evalVars - :: Foldable f - => f Var -> (Var -> [Pandoc.Block] -> IO ()) -> Presentation - -> IO Presentation -evalVars vars update presentation = - foldM (\p var -> evalVar var (update var) p) presentation vars +evalActiveVars + :: (Var -> [Pandoc.Block] -> IO ()) -> Presentation -> IO Presentation +evalActiveVars update presentation = foldM + (\p var -> evalVar var (update var) p) + presentation + (activeVars presentation) -------------------------------------------------------------------------------- -forceEval :: Presentation -> IO Presentation -forceEval pres = do +evalAllVars :: Presentation -> IO Presentation +evalAllVars pres = do updates <- IORef.newIORef [] let forceEvalVar pres0 var = do diff --git a/lib/Patat/Main.hs b/lib/Patat/Main.hs index 1b351c8..d858945 100644 --- a/lib/Patat/Main.hs +++ b/lib/Patat/Main.hs @@ -161,7 +161,7 @@ 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 @@ -169,7 +169,7 @@ main = do if oDump options then EncodingFallback.withHandle IO.stdout (pEncodingFallback pres) $ do - Eval.forceEval pres >>= dumpPresentation + Eval.evalAllVars pres >>= dumpPresentation else -- (Maybe) initialize images backend. withMaybeHandle Images.withHandle (psImages settings) $ \images -> @@ -211,10 +211,8 @@ loop app@App {..} = do (activeSpeakerNotes aPresentation) -- Start necessary eval blocks - presentation <- Eval.evalVars - (activeVars aPresentation) - (\var blocks -> Chan.writeChan aCommandChan $ PresentationCommand $ - UpdateVar (pVersion aPresentation) var blocks) + presentation <- Eval.evalActiveVars + (\v -> Chan.writeChan aCommandChan . PresentationCommand . UpdateVar v) aPresentation size <- getPresentationSize presentation diff --git a/lib/Patat/Presentation.hs b/lib/Patat/Presentation.hs index d9cfd5d..ae3a60f 100644 --- a/lib/Patat/Presentation.hs +++ b/lib/Patat/Presentation.hs @@ -2,6 +2,10 @@ module Patat.Presentation ( PresentationSettings (..) , defaultPresentationSettings + , VarGen + , Var + , zeroVarGen + , Presentation (..) , readPresentation @@ -23,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 diff --git a/lib/Patat/Presentation/Display.hs b/lib/Patat/Presentation/Display.hs index c36d9de..8847d0d 100644 --- a/lib/Patat/Presentation/Display.hs +++ b/lib/Patat/Presentation/Display.hs @@ -161,7 +161,6 @@ dumpPresentation pres@Presentation {..} = dumpFragment :: Index -> [PP.Doc] dumpFragment idx = case displayPresentation (getSize idx) pres {pActiveFragment = idx} of - -- TODO: wait until everything is evaluated before dumping. DisplayDoc doc -> [doc] DisplayImage filepath -> [PP.string $ "{image: " ++ filepath ++ "}"] diff --git a/lib/Patat/Presentation/Interactive.hs b/lib/Patat/Presentation/Interactive.hs index e796f82..2c95851 100644 --- a/lib/Patat/Presentation/Interactive.hs +++ b/lib/Patat/Presentation/Interactive.hs @@ -14,7 +14,6 @@ module Patat.Presentation.Interactive -------------------------------------------------------------------------------- import Data.Char (isDigit) -import qualified Patat.Eval as Eval import Patat.Presentation.Instruction (Var) import Patat.Presentation.Internal import Patat.Presentation.Read @@ -34,7 +33,7 @@ data PresentationCommand | Last | Reload | Seek Int - | UpdateVar Version Var [Pandoc.Block] + | UpdateVar Var [Pandoc.Block] | UnknownCommand String deriving (Eq, Show) @@ -110,14 +109,11 @@ updatePresentation cmd presentation = case cmd of Seek n -> pure $ goToSlide $ \_ -> (n - 1, 0) Reload -> reloadPresentation UnknownCommand _ -> pure $ UpdatedPresentation presentation - UpdateVar v x b -> pure $ UpdatedPresentation $ - if v /= version then presentation else Eval.updateVar x b presentation + UpdateVar v b -> pure $ UpdatedPresentation $ updateVar v b presentation where numSlides :: Presentation -> Int numSlides pres = length (pSlides pres) - version = pVersion presentation - clip :: Index -> Presentation -> Index clip (slide, fragment) pres | slide >= numSlides pres = (numSlides pres - 1, lastFragments - 1) @@ -141,10 +137,9 @@ 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 - { pVersion = Version (unVersion version + 1) - , pActiveFragment = clip (pActiveFragment presentation) pres + { pActiveFragment = clip (pActiveFragment presentation) pres } diff --git a/lib/Patat/Presentation/Internal.hs b/lib/Patat/Presentation/Internal.hs index a29d871..cf469f2 100644 --- a/lib/Patat/Presentation/Internal.hs +++ b/lib/Patat/Presentation/Internal.hs @@ -3,8 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Patat.Presentation.Internal - ( Version (..) - , Breadcrumbs + ( Breadcrumbs , Presentation (..) , PresentationSettings (..) , defaultPresentationSettings @@ -39,6 +38,8 @@ module Patat.Presentation.Internal , Size , getPresentationSize + + , updateVar ) where @@ -61,10 +62,6 @@ import qualified Skylighting as Skylighting import qualified Text.Pandoc as Pandoc --------------------------------------------------------------------------------- -newtype Version = Version {unVersion :: Int} deriving (Eq, Show) - - -------------------------------------------------------------------------------- type Breadcrumbs = [(Int, [Pandoc.Inline])] @@ -72,7 +69,6 @@ type Breadcrumbs = [(Int, [Pandoc.Inline])] -------------------------------------------------------------------------------- data Presentation = Presentation { pFilePath :: !FilePath - , pVersion :: !Version , pEncodingFallback :: !EncodingFallback , pTitle :: ![Pandoc.Inline] , pAuthor :: ![Pandoc.Inline] @@ -84,6 +80,7 @@ data Presentation = Presentation , pActiveFragment :: !Index , pSyntaxMap :: !Skylighting.SyntaxMap , pEvalBlocks :: !Eval.EvalBlocks + , pVarGen :: !Instruction.VarGen , pVars :: !(HMS.HashMap Instruction.Var [Pandoc.Block]) } @@ -203,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} diff --git a/lib/Patat/Presentation/Read.hs b/lib/Patat/Presentation/Read.hs index 3405b55..bd0af50 100644 --- a/lib/Patat/Presentation/Read.hs +++ b/lib/Patat/Presentation/Read.hs @@ -32,6 +32,7 @@ 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,7 +72,7 @@ readPresentation filePath = runExceptT $ do Right x -> return x pres <- ExceptT $ pure $ - pandocToPresentation filePath enc settings syntaxMap doc + pandocToPresentation varGen filePath enc settings syntaxMap doc pure $ Eval.parseEvalBlocks pres where ext = takeExtension filePath @@ -122,12 +123,11 @@ 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 !pVersion = Version 0 - !pTitle = case Pandoc.docTitle meta of + let !pTitle = case Pandoc.docTitle meta of [] -> [Pandoc.Str . T.pack . snd $ splitFileName pFilePath] title -> title !pSlides = pandocToSlides pSettings pandoc