--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
module Patat.Eval
    ( parseEvalBlocks

    , evalVar
    , evalActiveVars
    , evalAllVars
    ) where


--------------------------------------------------------------------------------
import qualified Control.Concurrent.Async       as Async
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           System.Exit                    (ExitCode (..))
import qualified System.IO                      as IO
import qualified System.Process                 as Process
import qualified Text.Pandoc.Definition         as Pandoc


--------------------------------------------------------------------------------
parseEvalBlocks :: Presentation -> Presentation
parseEvalBlocks :: Presentation -> Presentation
parseEvalBlocks Presentation
presentation =
    let ((Presentation
pres, VarGen
varGen), HashMap Var EvalBlock
evalBlocks) = Writer (HashMap Var EvalBlock) (Presentation, VarGen)
-> ((Presentation, VarGen), HashMap Var EvalBlock)
forall w a. Writer w a -> (a, w)
runWriter (Writer (HashMap Var EvalBlock) (Presentation, VarGen)
 -> ((Presentation, VarGen), HashMap Var EvalBlock))
-> Writer (HashMap Var EvalBlock) (Presentation, VarGen)
-> ((Presentation, VarGen), HashMap Var EvalBlock)
forall a b. (a -> b) -> a -> b
$
            StateT VarGen (Writer (HashMap Var EvalBlock)) Presentation
-> VarGen -> Writer (HashMap Var EvalBlock) (Presentation, VarGen)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT VarGen (Writer (HashMap Var EvalBlock)) Presentation
work (Presentation -> VarGen
pVarGen Presentation
presentation) in
    Presentation
pres {pEvalBlocks = evalBlocks, pVarGen = varGen}
  where
    work :: StateT VarGen (Writer (HashMap Var EvalBlock)) Presentation
work = case PresentationSettings -> Maybe EvalSettingsMap
psEval (Presentation -> PresentationSettings
pSettings Presentation
presentation) of
        Maybe EvalSettingsMap
Nothing -> Presentation
-> StateT VarGen (Writer (HashMap Var EvalBlock)) Presentation
forall a. a -> StateT VarGen (Writer (HashMap Var EvalBlock)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Presentation
presentation
        Just EvalSettingsMap
settings -> do
            Seq Slide
slides <- (Slide -> StateT VarGen (Writer (HashMap Var EvalBlock)) Slide)
-> Seq Slide
-> StateT VarGen (Writer (HashMap Var EvalBlock)) (Seq Slide)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse (EvalSettingsMap
-> Slide -> StateT VarGen (Writer (HashMap Var EvalBlock)) Slide
evalSlide EvalSettingsMap
settings) (Presentation -> Seq Slide
pSlides Presentation
presentation)
            Presentation
-> StateT VarGen (Writer (HashMap Var EvalBlock)) Presentation
forall a. a -> StateT VarGen (Writer (HashMap Var EvalBlock)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Presentation
presentation {pSlides = slides}


--------------------------------------------------------------------------------
lookupSettings :: [T.Text] -> EvalSettingsMap -> [EvalSettings]
lookupSettings :: [Text] -> EvalSettingsMap -> [EvalSettings]
lookupSettings [Text]
classes EvalSettingsMap
settings = do
    Text
c <- [Text]
classes
    Maybe EvalSettings -> [EvalSettings]
forall a. Maybe a -> [a]
maybeToList (Maybe EvalSettings -> [EvalSettings])
-> Maybe EvalSettings -> [EvalSettings]
forall a b. (a -> b) -> a -> b
$ Text -> EvalSettingsMap -> Maybe EvalSettings
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMS.lookup Text
c EvalSettingsMap
settings


--------------------------------------------------------------------------------
-- | 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 :: EvalSettingsMap
-> Slide -> StateT VarGen (Writer (HashMap Var EvalBlock)) Slide
evalSlide EvalSettingsMap
settings Slide
slide = case Slide -> SlideContent
slideContent Slide
slide of
    TitleSlide Int
_ [Inline]
_ -> Slide -> StateT VarGen (Writer (HashMap Var EvalBlock)) Slide
forall a. a -> StateT VarGen (Writer (HashMap Var EvalBlock)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Slide
slide
    ContentSlide Instructions Block
instrs0 -> do
        [[Instruction Block]]
instrs1 <- (Instruction Block
 -> StateT
      VarGen (Writer (HashMap Var EvalBlock)) [Instruction Block])
-> [Instruction Block]
-> StateT
     VarGen (Writer (HashMap Var EvalBlock)) [[Instruction Block]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (EvalSettingsMap
-> Instruction Block
-> StateT
     VarGen (Writer (HashMap Var EvalBlock)) [Instruction Block]
evalInstruction EvalSettingsMap
settings) (Instructions Block -> [Instruction Block]
forall a. Instructions a -> [Instruction a]
toList Instructions Block
instrs0)
        Slide -> StateT VarGen (Writer (HashMap Var EvalBlock)) Slide
forall a. a -> StateT VarGen (Writer (HashMap Var EvalBlock)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Slide
slide {slideContent = ContentSlide . fromList $ concat instrs1}


--------------------------------------------------------------------------------
evalInstruction
    :: EvalSettingsMap -> Instruction Pandoc.Block
    -> ExtractEvalM [Instruction Pandoc.Block]
evalInstruction :: EvalSettingsMap
-> Instruction Block
-> StateT
     VarGen (Writer (HashMap Var EvalBlock)) [Instruction Block]
evalInstruction EvalSettingsMap
settings Instruction Block
instr = case Instruction Block
instr of
    Instruction Block
Pause         -> [Instruction Block]
-> StateT
     VarGen (Writer (HashMap Var EvalBlock)) [Instruction Block]
forall a. a -> StateT VarGen (Writer (HashMap Var EvalBlock)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Instruction Block
forall a. Instruction a
Pause]
    ModifyLast Instruction Block
i  -> (Instruction Block -> Instruction Block)
-> [Instruction Block] -> [Instruction Block]
forall a b. (a -> b) -> [a] -> [b]
map Instruction Block -> Instruction Block
forall a. Instruction a -> Instruction a
ModifyLast ([Instruction Block] -> [Instruction Block])
-> StateT
     VarGen (Writer (HashMap Var EvalBlock)) [Instruction Block]
-> StateT
     VarGen (Writer (HashMap Var EvalBlock)) [Instruction Block]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EvalSettingsMap
-> Instruction Block
-> StateT
     VarGen (Writer (HashMap Var EvalBlock)) [Instruction Block]
evalInstruction EvalSettingsMap
settings Instruction Block
i
    Append []     -> [Instruction Block]
-> StateT
     VarGen (Writer (HashMap Var EvalBlock)) [Instruction Block]
forall a. a -> StateT VarGen (Writer (HashMap Var EvalBlock)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append []]
    Append [Block]
blocks -> [[Instruction Block]] -> [Instruction Block]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Instruction Block]] -> [Instruction Block])
-> StateT
     VarGen (Writer (HashMap Var EvalBlock)) [[Instruction Block]]
-> StateT
     VarGen (Writer (HashMap Var EvalBlock)) [Instruction Block]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block
 -> StateT
      VarGen (Writer (HashMap Var EvalBlock)) [Instruction Block])
-> [Block]
-> StateT
     VarGen (Writer (HashMap Var EvalBlock)) [[Instruction Block]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (EvalSettingsMap
-> Block
-> StateT
     VarGen (Writer (HashMap Var EvalBlock)) [Instruction Block]
evalBlock EvalSettingsMap
settings) [Block]
blocks
    AppendVar Var
v   ->
        -- Should not happen since we don't do recursive evaluation.
        [Instruction Block]
-> StateT
     VarGen (Writer (HashMap Var EvalBlock)) [Instruction Block]
forall a. a -> StateT VarGen (Writer (HashMap Var EvalBlock)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Var -> Instruction Block
forall a. Var -> Instruction a
AppendVar Var
v]
    Instruction Block
Delete        -> [Instruction Block]
-> StateT
     VarGen (Writer (HashMap Var EvalBlock)) [Instruction Block]
forall a. a -> StateT VarGen (Writer (HashMap Var EvalBlock)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Instruction Block
forall a. Instruction a
Delete]


--------------------------------------------------------------------------------
evalBlock
    :: EvalSettingsMap -> Pandoc.Block
    -> ExtractEvalM [Instruction Pandoc.Block]
evalBlock :: EvalSettingsMap
-> Block
-> StateT
     VarGen (Writer (HashMap Var EvalBlock)) [Instruction Block]
evalBlock EvalSettingsMap
settings orig :: Block
orig@(Pandoc.CodeBlock attr :: Attr
attr@(Text
_, [Text]
classes, [(Text, Text)]
_) Text
txt)
    | [s :: EvalSettings
s@EvalSettings {Bool
Text
EvalSettingsContainer
evalCommand :: Text
evalReplace :: Bool
evalFragment :: Bool
evalContainer :: EvalSettingsContainer
evalStderr :: Bool
evalCommand :: EvalSettings -> Text
evalReplace :: EvalSettings -> Bool
evalFragment :: EvalSettings -> Bool
evalContainer :: EvalSettings -> EvalSettingsContainer
evalStderr :: EvalSettings -> Bool
..}] <- [Text] -> EvalSettingsMap -> [EvalSettings]
lookupSettings [Text]
classes EvalSettingsMap
settings = do
        Var
var <- (VarGen -> (Var, VarGen))
-> StateT VarGen (Writer (HashMap Var EvalBlock)) Var
forall a.
(VarGen -> (a, VarGen))
-> StateT VarGen (Writer (HashMap Var EvalBlock)) a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state VarGen -> (Var, VarGen)
freshVar
        HashMap Var EvalBlock
-> StateT VarGen (Writer (HashMap Var EvalBlock)) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (HashMap Var EvalBlock
 -> StateT VarGen (Writer (HashMap Var EvalBlock)) ())
-> HashMap Var EvalBlock
-> StateT VarGen (Writer (HashMap Var EvalBlock)) ()
forall a b. (a -> b) -> a -> b
$ Var -> EvalBlock -> HashMap Var EvalBlock
forall k v. Hashable k => k -> v -> HashMap k v
HMS.singleton Var
var (EvalBlock -> HashMap Var EvalBlock)
-> EvalBlock -> HashMap Var EvalBlock
forall a b. (a -> b) -> a -> b
$ EvalSettings -> Attr -> Text -> Maybe (Async ()) -> EvalBlock
EvalBlock EvalSettings
s Attr
attr Text
txt Maybe (Async ())
forall a. Maybe a
Nothing
        [Instruction Block]
-> StateT
     VarGen (Writer (HashMap Var EvalBlock)) [Instruction Block]
forall a. a -> StateT VarGen (Writer (HashMap Var EvalBlock)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Instruction Block]
 -> StateT
      VarGen (Writer (HashMap Var EvalBlock)) [Instruction Block])
-> [Instruction Block]
-> StateT
     VarGen (Writer (HashMap Var EvalBlock)) [Instruction Block]
forall a b. (a -> b) -> a -> b
$ case (Bool
evalFragment, Bool
evalReplace) of
            (Bool
False, Bool
True) -> [Var -> Instruction Block
forall a. Var -> Instruction a
AppendVar Var
var]
            (Bool
False, Bool
False) -> [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
orig], Var -> Instruction Block
forall a. Var -> Instruction a
AppendVar Var
var]
            (Bool
True, Bool
True) ->
                [ [Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
orig], Instruction Block
forall a. Instruction a
Pause
                , Instruction Block
forall a. Instruction a
Delete, Var -> Instruction Block
forall a. Var -> Instruction a
AppendVar Var
var
                ]
            (Bool
True, Bool
False) ->
                [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
orig], Instruction Block
forall a. Instruction a
Pause, Var -> Instruction Block
forall a. Var -> Instruction a
AppendVar Var
var]
    | EvalSettings
_ : EvalSettings
_ : [EvalSettings]
_ <- [Text] -> EvalSettingsMap -> [EvalSettings]
lookupSettings [Text]
classes EvalSettingsMap
settings =
        let msg :: Text
msg = Text
"patat eval matched multiple settings for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                Text -> [Text] -> Text
T.intercalate Text
"," [Text]
classes in
        [Instruction Block]
-> StateT
     VarGen (Writer (HashMap Var EvalBlock)) [Instruction Block]
forall a. a -> StateT VarGen (Writer (HashMap Var EvalBlock)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Attr -> Text -> Block
Pandoc.CodeBlock Attr
attr Text
msg]]
evalBlock EvalSettingsMap
_ Block
block =
    [Instruction Block]
-> StateT
     VarGen (Writer (HashMap Var EvalBlock)) [Instruction Block]
forall a. a -> StateT VarGen (Writer (HashMap Var EvalBlock)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]


--------------------------------------------------------------------------------
newAccum :: Monoid m => (m -> IO ()) -> IO (m -> IO ())
newAccum :: forall m. Monoid m => (m -> IO ()) -> IO (m -> IO ())
newAccum m -> IO ()
f = do
    IORef m
ref <- m -> IO (IORef m)
forall a. a -> IO (IORef a)
IORef.newIORef m
forall a. Monoid a => a
mempty
    (m -> IO ()) -> IO (m -> IO ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((m -> IO ()) -> IO (m -> IO ()))
-> (m -> IO ()) -> IO (m -> IO ())
forall a b. (a -> b) -> a -> b
$ \m
x ->
        IORef m -> (m -> (m, m)) -> IO m
forall a b. IORef a -> (a -> (a, b)) -> IO b
IORef.atomicModifyIORef' IORef m
ref (\m
y -> let z :: m
z = m
y m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
x in (m
z, m
z)) IO m -> (m -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m -> IO ()
f


--------------------------------------------------------------------------------
evalVar :: Var -> ([Pandoc.Block] -> IO ()) -> Presentation -> IO Presentation
evalVar :: Var -> ([Block] -> IO ()) -> Presentation -> IO Presentation
evalVar Var
var [Block] -> IO ()
writeOutput Presentation
presentation = case Var -> HashMap Var EvalBlock -> Maybe EvalBlock
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMS.lookup Var
var HashMap Var EvalBlock
evalBlocks of
    Maybe EvalBlock
Nothing -> Presentation -> IO Presentation
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Presentation
presentation
    Just EvalBlock {Maybe (Async ())
Attr
Text
EvalSettings
ebSettings :: EvalSettings
ebAttr :: Attr
ebInput :: Text
ebAsync :: Maybe (Async ())
ebSettings :: EvalBlock -> EvalSettings
ebAttr :: EvalBlock -> Attr
ebInput :: EvalBlock -> Text
ebAsync :: EvalBlock -> Maybe (Async ())
..} | Just Async ()
_ <- Maybe (Async ())
ebAsync -> Presentation -> IO Presentation
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Presentation
presentation
    Just eb :: EvalBlock
eb@EvalBlock {Maybe (Async ())
Attr
Text
EvalSettings
ebSettings :: EvalBlock -> EvalSettings
ebAttr :: EvalBlock -> Attr
ebInput :: EvalBlock -> Text
ebAsync :: EvalBlock -> Maybe (Async ())
ebSettings :: EvalSettings
ebAttr :: Attr
ebInput :: Text
ebAsync :: Maybe (Async ())
..} -> do
        let EvalSettings {Bool
Text
EvalSettingsContainer
evalCommand :: EvalSettings -> Text
evalReplace :: EvalSettings -> Bool
evalFragment :: EvalSettings -> Bool
evalContainer :: EvalSettings -> EvalSettingsContainer
evalStderr :: EvalSettings -> Bool
evalCommand :: Text
evalReplace :: Bool
evalFragment :: Bool
evalContainer :: EvalSettingsContainer
evalStderr :: Bool
..} = EvalSettings
ebSettings

        Text -> IO ()
writeChunk <- (Text -> IO ()) -> IO (Text -> IO ())
forall m. Monoid m => (m -> IO ()) -> IO (m -> IO ())
newAccum ([Block] -> IO ()
writeOutput ([Block] -> IO ()) -> (Text -> [Block]) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalBlock -> Text -> [Block]
renderEvalBlock EvalBlock
eb)
        let drainLines :: Bool -> Handle -> IO ()
drainLines Bool
copy Handle
h = do
                Text
c <- IO Text -> (IOException -> IO Text) -> IO Text
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Handle -> IO Text
T.hGetChunk Handle
h) ((\IOException
_ -> Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"") :: IOException -> IO T.Text)
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
copy (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
writeChunk Text
c
                    Bool -> Handle -> IO ()
drainLines Bool
copy Handle
h

        let proc :: CreateProcess
proc = (String -> CreateProcess
Process.shell (String -> CreateProcess) -> String -> CreateProcess
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
evalCommand)
                { Process.std_in  = Process.CreatePipe
                , Process.std_out = Process.CreatePipe
                , Process.std_err = Process.CreatePipe
                }
        (Just Handle
hIn, Just Handle
hOut, Just Handle
hErr, ProcessHandle
hProc) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
proc
        Async ()
async <- IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
Async.async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$
            IO () -> (Async () -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync (Handle -> Text -> IO ()
T.hPutStr Handle
hIn Text
ebInput IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
IO.hClose Handle
hIn) ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async ()
_ ->
            IO () -> (Async () -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync (Bool -> Handle -> IO ()
drainLines Bool
True Handle
hOut) ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async ()
outAsync ->
            IO () -> (Async () -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync (Bool -> Handle -> IO ()
drainLines Bool
evalStderr Handle
hErr) ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async ()
errAsync ->
            IO ExitCode -> (Async ExitCode -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync (ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
hProc) ((Async ExitCode -> IO ()) -> IO ())
-> (Async ExitCode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async ExitCode
exitCodeAsync -> do
            ExitCode
erExitCode <- Async ExitCode -> IO ExitCode
forall a. Async a -> IO a
Async.wait Async ExitCode
exitCodeAsync
            ()
_ <- Async () -> IO ()
forall a. Async a -> IO a
Async.wait Async ()
outAsync
            ()
_ <- Async () -> IO ()
forall a. Async a -> IO a
Async.wait Async ()
errAsync
            case ExitCode
erExitCode of
                ExitCode
ExitSuccess -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                ExitFailure Int
i -> Text -> IO ()
writeChunk (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
                    Text
evalCommand Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": exit code " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        Presentation -> IO Presentation
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Presentation
presentation
            { pEvalBlocks = HMS.insert var eb {ebAsync = Just async} evalBlocks
            }
  where
    evalBlocks :: HashMap Var EvalBlock
evalBlocks = Presentation -> HashMap Var EvalBlock
pEvalBlocks Presentation
presentation



--------------------------------------------------------------------------------
evalActiveVars
    :: (Var -> [Pandoc.Block] -> IO ()) -> Presentation -> IO Presentation
evalActiveVars :: (Var -> [Block] -> IO ()) -> Presentation -> IO Presentation
evalActiveVars Var -> [Block] -> IO ()
update Presentation
presentation = (Presentation -> Var -> IO Presentation)
-> Presentation -> HashSet Var -> IO Presentation
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
    (\Presentation
p Var
var -> Var -> ([Block] -> IO ()) -> Presentation -> IO Presentation
evalVar Var
var (Var -> [Block] -> IO ()
update Var
var) Presentation
p)
    Presentation
presentation
    (Presentation -> HashSet Var
activeVars Presentation
presentation)


--------------------------------------------------------------------------------
evalAllVars :: Presentation -> IO Presentation
evalAllVars :: Presentation -> IO Presentation
evalAllVars Presentation
pres = do
    IORef [[Block]]
updates <- [[Block]] -> IO (IORef [[Block]])
forall a. a -> IO (IORef a)
IORef.newIORef []

    let forceEvalVar :: Presentation -> Var -> IO Presentation
forceEvalVar Presentation
pres0 Var
var = do
            Presentation
pres1 <- Var -> ([Block] -> IO ()) -> Presentation -> IO Presentation
evalVar
                Var
var
                (\[Block]
u -> IORef [[Block]] -> ([[Block]] -> ([[Block]], ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
IORef.atomicModifyIORef' IORef [[Block]]
updates (\[[Block]]
l -> ([[Block]]
l [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ [[Block]
u], ())))
                Presentation
pres0
            case Var -> HashMap Var EvalBlock -> Maybe EvalBlock
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMS.lookup Var
var (Presentation -> HashMap Var EvalBlock
pEvalBlocks Presentation
pres1) of
                Maybe EvalBlock
Nothing -> Presentation -> IO Presentation
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Presentation
pres1
                Just EvalBlock
eb -> do
                    Maybe (Async ()) -> (Async () -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (EvalBlock -> Maybe (Async ())
ebAsync EvalBlock
eb) Async () -> IO ()
forall a. Async a -> IO a
Async.wait
                    IORef [[Block]]
-> ([[Block]] -> ([[Block]], Presentation)) -> IO Presentation
forall a b. IORef a -> (a -> (a, b)) -> IO b
IORef.atomicModifyIORef' IORef [[Block]]
updates (([[Block]] -> ([[Block]], Presentation)) -> IO Presentation)
-> ([[Block]] -> ([[Block]], Presentation)) -> IO Presentation
forall a b. (a -> b) -> a -> b
$ \[[Block]]
l ->
                        ([], (Presentation -> [Block] -> Presentation)
-> Presentation -> [[Block]] -> Presentation
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Presentation
p [Block]
u -> Var -> [Block] -> Presentation -> Presentation
updateVar Var
var [Block]
u Presentation
p) Presentation
pres1 [[Block]]
l)

    (Presentation -> Var -> IO Presentation)
-> Presentation -> [Var] -> IO Presentation
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Presentation -> Var -> IO Presentation
forceEvalVar Presentation
pres (HashMap Var EvalBlock -> [Var]
forall k v. HashMap k v -> [k]
HMS.keys (Presentation -> HashMap Var EvalBlock
pEvalBlocks Presentation
pres))