--------------------------------------------------------------------------------
{-# 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.Set                    as S
import qualified Data.Text                   as T
import qualified Data.Text.IO                as T
import           Patat.Eval.Internal
import           Patat.Presentation.Internal
import           Patat.Presentation.Syntax
import           Patat.Unique
import           System.Exit                 (ExitCode (..))
import qualified System.IO                   as IO
import qualified System.Process              as Process


--------------------------------------------------------------------------------
parseEvalBlocks :: Presentation -> Presentation
parseEvalBlocks :: Presentation -> Presentation
parseEvalBlocks Presentation
presentation =
    let ((Presentation
pres, UniqueGen
varGen), HashMap Var EvalBlock
evalBlocks) = Writer (HashMap Var EvalBlock) (Presentation, UniqueGen)
-> ((Presentation, UniqueGen), HashMap Var EvalBlock)
forall w a. Writer w a -> (a, w)
runWriter (Writer (HashMap Var EvalBlock) (Presentation, UniqueGen)
 -> ((Presentation, UniqueGen), HashMap Var EvalBlock))
-> Writer (HashMap Var EvalBlock) (Presentation, UniqueGen)
-> ((Presentation, UniqueGen), HashMap Var EvalBlock)
forall a b. (a -> b) -> a -> b
$
            StateT UniqueGen (Writer (HashMap Var EvalBlock)) Presentation
-> UniqueGen
-> Writer (HashMap Var EvalBlock) (Presentation, UniqueGen)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT UniqueGen (Writer (HashMap Var EvalBlock)) Presentation
work (Presentation -> UniqueGen
pUniqueGen Presentation
presentation) in
    Presentation
pres {pEvalBlocks = evalBlocks, pUniqueGen = varGen}
  where
    work :: StateT UniqueGen (Writer (HashMap Var EvalBlock)) Presentation
work = case PresentationSettings -> Maybe EvalSettingsMap
psEval (Presentation -> PresentationSettings
pSettings Presentation
presentation) of
        Maybe EvalSettingsMap
Nothing -> Presentation
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) Presentation
forall a. a -> StateT UniqueGen (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 UniqueGen (Writer (HashMap Var EvalBlock)) Slide)
-> Seq Slide
-> StateT UniqueGen (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 UniqueGen (Writer (HashMap Var EvalBlock)) Slide
evalSlide EvalSettingsMap
settings) (Presentation -> Seq Slide
pSlides Presentation
presentation)
            Presentation
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) Presentation
forall a. a -> StateT UniqueGen (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 UniqueGen (Writer (HMS.HashMap Var EvalBlock)) a


--------------------------------------------------------------------------------
evalSlide :: EvalSettingsMap -> Slide -> ExtractEvalM Slide
evalSlide :: EvalSettingsMap
-> Slide -> StateT UniqueGen (Writer (HashMap Var EvalBlock)) Slide
evalSlide EvalSettingsMap
settings Slide
slide = case Slide -> SlideContent
slideContent Slide
slide of
    TitleSlide Int
_ [Inline]
_ -> Slide -> StateT UniqueGen (Writer (HashMap Var EvalBlock)) Slide
forall a. a -> StateT UniqueGen (Writer (HashMap Var EvalBlock)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Slide
slide
    ContentSlide [Block]
blocks -> do
        [Block]
blocks1 <- (Block
 -> StateT UniqueGen (Writer (HashMap Var EvalBlock)) [Block])
-> (Inline
    -> StateT UniqueGen (Writer (HashMap Var EvalBlock)) [Inline])
-> [Block]
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) [Block]
forall (m :: * -> *).
Monad m =>
(Block -> m [Block])
-> (Inline -> m [Inline]) -> [Block] -> m [Block]
dftBlocks (EvalSettingsMap
-> Block
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) [Block]
evalBlock EvalSettingsMap
settings) ([Inline]
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) [Inline]
forall a. a -> StateT UniqueGen (Writer (HashMap Var EvalBlock)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Inline]
 -> StateT UniqueGen (Writer (HashMap Var EvalBlock)) [Inline])
-> (Inline -> [Inline])
-> Inline
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) [Block]
blocks
        Slide -> StateT UniqueGen (Writer (HashMap Var EvalBlock)) Slide
forall a. a -> StateT UniqueGen (Writer (HashMap Var EvalBlock)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Slide
slide {slideContent = ContentSlide blocks1}


--------------------------------------------------------------------------------
evalBlock
    :: EvalSettingsMap -> Block
    -> ExtractEvalM [Block]
evalBlock :: EvalSettingsMap
-> Block
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) [Block]
evalBlock EvalSettingsMap
settings orig :: Block
orig@(CodeBlock attr :: Attr
attr@(Text
_, [Text]
classes, [(Text, Text)]
_) Text
txt)
    | [s :: EvalSettings
s@EvalSettings {Bool
Text
EvalSettingsContainer
evalCommand :: Text
evalReplace :: Bool
evalReveal :: Bool
evalContainer :: EvalSettingsContainer
evalStderr :: Bool
evalCommand :: EvalSettings -> Text
evalReplace :: EvalSettings -> Bool
evalReveal :: EvalSettings -> Bool
evalContainer :: EvalSettings -> EvalSettingsContainer
evalStderr :: EvalSettings -> Bool
..}] <- [Text] -> EvalSettingsMap -> [EvalSettings]
lookupSettings [Text]
classes EvalSettingsMap
settings = do
        Var
var <- Unique -> Var
Var (Unique -> Var)
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) Unique
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) Var
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UniqueGen -> (Unique, UniqueGen))
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) Unique
forall a.
(UniqueGen -> (a, UniqueGen))
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state UniqueGen -> (Unique, UniqueGen)
freshUnique
        HashMap Var EvalBlock
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (HashMap Var EvalBlock
 -> StateT UniqueGen (Writer (HashMap Var EvalBlock)) ())
-> HashMap Var EvalBlock
-> StateT UniqueGen (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
        case (Bool
evalReveal, Bool
evalReplace) of
            (Bool
False, Bool
True) -> [Block]
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) [Block]
forall a. a -> StateT UniqueGen (Writer (HashMap Var EvalBlock)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Var -> Block
VarBlock Var
var]
            (Bool
False, Bool
False) -> [Block]
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) [Block]
forall a. a -> StateT UniqueGen (Writer (HashMap Var EvalBlock)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Block
orig, Var -> Block
VarBlock Var
var]
            (Bool
True, Bool
True) -> do
                RevealID
revealID <- Unique -> RevealID
RevealID (Unique -> RevealID)
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) Unique
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) RevealID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UniqueGen -> (Unique, UniqueGen))
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) Unique
forall a.
(UniqueGen -> (a, UniqueGen))
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state UniqueGen -> (Unique, UniqueGen)
freshUnique
                [Block]
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) [Block]
forall a. a -> StateT UniqueGen (Writer (HashMap Var EvalBlock)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Block]
 -> StateT UniqueGen (Writer (HashMap Var EvalBlock)) [Block])
-> [Block]
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) [Block]
forall a b. (a -> b) -> a -> b
$ Block -> [Block]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> [Block]) -> Block -> [Block]
forall a b. (a -> b) -> a -> b
$ RevealWrapper -> RevealSequence [Block] -> Block
Reveal RevealWrapper
ConcatWrapper (RevealSequence [Block] -> Block)
-> RevealSequence [Block] -> Block
forall a b. (a -> b) -> a -> b
$ RevealID
-> [RevealID] -> [(Set Int, [Block])] -> RevealSequence [Block]
forall a.
RevealID -> [RevealID] -> [(Set Int, a)] -> RevealSequence a
RevealSequence
                    RevealID
revealID
                    [RevealID
revealID]
                    [ (Int -> Set Int
forall a. a -> Set a
S.singleton Int
0, [Block
orig])
                    , (Int -> Set Int
forall a. a -> Set a
S.singleton Int
1, [Var -> Block
VarBlock Var
var])
                    ]
            (Bool
True, Bool
False) -> do
                RevealID
revealID <- Unique -> RevealID
RevealID (Unique -> RevealID)
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) Unique
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) RevealID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UniqueGen -> (Unique, UniqueGen))
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) Unique
forall a.
(UniqueGen -> (a, UniqueGen))
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state UniqueGen -> (Unique, UniqueGen)
freshUnique
                [Block]
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) [Block]
forall a. a -> StateT UniqueGen (Writer (HashMap Var EvalBlock)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Block]
 -> StateT UniqueGen (Writer (HashMap Var EvalBlock)) [Block])
-> [Block]
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) [Block]
forall a b. (a -> b) -> a -> b
$ Block -> [Block]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> [Block]) -> Block -> [Block]
forall a b. (a -> b) -> a -> b
$ RevealWrapper -> RevealSequence [Block] -> Block
Reveal RevealWrapper
ConcatWrapper (RevealSequence [Block] -> Block)
-> RevealSequence [Block] -> Block
forall a b. (a -> b) -> a -> b
$ RevealID
-> [RevealID] -> [(Set Int, [Block])] -> RevealSequence [Block]
forall a.
RevealID -> [RevealID] -> [(Set Int, a)] -> RevealSequence a
RevealSequence
                    RevealID
revealID
                    [RevealID
revealID]
                    [ ([Int] -> Set Int
forall a. Ord a => [a] -> Set a
S.fromList [Int
0, Int
1], [Block
orig])
                    , ([Int] -> Set Int
forall a. Ord a => [a] -> Set a
S.fromList [Int
1], [Var -> Block
VarBlock 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
        [Block]
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) [Block]
forall a. a -> StateT UniqueGen (Writer (HashMap Var EvalBlock)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Attr -> Text -> Block
CodeBlock Attr
attr Text
msg]
evalBlock EvalSettingsMap
_ Block
block =
    [Block]
-> StateT UniqueGen (Writer (HashMap Var EvalBlock)) [Block]
forall a. a -> StateT UniqueGen (Writer (HashMap Var EvalBlock)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [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 -> ([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
evalReveal :: EvalSettings -> Bool
evalContainer :: EvalSettings -> EvalSettingsContainer
evalStderr :: EvalSettings -> Bool
evalCommand :: Text
evalReplace :: Bool
evalReveal :: 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 -> [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))