Skip to content

Commit

Permalink
WIP
Browse files Browse the repository at this point in the history
  • Loading branch information
jaspervdj committed Oct 24, 2024
1 parent 578da53 commit 61a0f76
Show file tree
Hide file tree
Showing 4 changed files with 17 additions and 8 deletions.
5 changes: 1 addition & 4 deletions lib/Patat/Eval.hs
Original file line number Diff line number Diff line change
Expand Up @@ -94,7 +94,7 @@ evalBlock
evalBlock settings orig@(Pandoc.CodeBlock attr@(_, classes, _) txt)
| [s@EvalSettings {..}] <- lookupSettings classes settings = do
var <- state freshVar
tell $ HMS.singleton var $ EvalBlock s txt Nothing mempty
tell $ HMS.singleton var $ EvalBlock s attr txt Nothing mempty
out <- liftIO $ unsafeInterleaveIO $ do
EvalResult {..} <- evalCode s txt
pure $ case erExitCode of
Expand Down Expand Up @@ -175,14 +175,12 @@ startEval2 var writeOutput presentation = case HMS.lookup var evalBlocks of
Nothing -> pure presentation
Just EvalBlock {..} | Just _ <- ebAsync -> pure presentation
Just eb@EvalBlock {..} -> do
appendFile "log.txt" $ "starting eval for var " ++ show var ++ "\n"
let EvalSettings {..} = ebSettings
let proc = (Process.shell $ T.unpack evalCommand)
{ Process.std_in = Process.CreatePipe
, Process.std_out = Process.CreatePipe
, Process.std_err = Process.CreatePipe
}
appendFile "log.txt" $ "Creating process\n"
(Just hIn, Just hOut, Just hErr, hProc) <- Process.createProcess proc
async <- Async.async $
Async.withAsync (T.hPutStr hIn ebInput `finally` IO.hClose hIn) $ \_ ->
Expand All @@ -197,7 +195,6 @@ startEval2 var writeOutput presentation = case HMS.lookup var evalBlocks of
ExitFailure i ->
evalCommand <> ": exit code " <> T.pack (show i) <> "\n" <>
erStderr
appendFile "log.txt" $ "OUT: " ++ show out ++ "\n"
writeOutput $ UpdateEvalBlock var out
pure presentation
{ pEvalBlocks = HMS.insert var eb {ebAsync = Just async} evalBlocks
Expand Down
14 changes: 14 additions & 0 deletions lib/Patat/Eval/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,8 @@
module Patat.Eval.Internal
( EvalBlocks
, EvalBlock (..)
, evalBlockToBlocks

, EvalState (..)
, Handle (..)
, newHandle
Expand All @@ -23,6 +25,7 @@ import Patat.Presentation.Settings
import System.Exit (ExitCode (..))
import qualified System.IO as IO
import qualified System.Process as Process
import qualified Text.Pandoc as Pandoc


--------------------------------------------------------------------------------
Expand All @@ -33,12 +36,23 @@ 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 ()))
, ebOutput :: !T.Text
}


--------------------------------------------------------------------------------
evalBlockToBlocks :: EvalBlock -> [Pandoc.Block]
evalBlockToBlocks EvalBlock {..} = case evalContainer ebSettings of
EvalContainerCode -> [Pandoc.CodeBlock ebAttr ebOutput]
EvalContainerNone -> [Pandoc.RawBlock fmt ebOutput]
EvalContainerInline -> [Pandoc.Plain [Pandoc.RawInline fmt ebOutput]]
where
fmt = "eval"


--------------------------------------------------------------------------------
data EvalState
= Starting
Expand Down
4 changes: 1 addition & 3 deletions lib/Patat/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -212,10 +212,8 @@ loop app@App {..} = do
(activeSpeakerNotes aPresentation)

-- Start necessary eval blocks
appendFile "log.txt" "lol test\n"
presentation <- foldM
(\presentation var -> do
appendFile "log.txt" ("starting var: " ++ show var ++ "\n")
(\presentation var ->
Eval.startEval2 var (\u -> Chan.writeChan aCommandChan (PresentationCommand $ UpdateEvalBlock u)) presentation)
aPresentation
(activeVars aPresentation)
Expand Down
2 changes: 1 addition & 1 deletion lib/Patat/Presentation/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -155,7 +155,7 @@ activeFragment presentation = do
where
resolve var = case HMS.lookup var (pEvalBlocks presentation) of
Nothing -> []
Just eb -> [Pandoc.Para [Pandoc.Str "out: ", Pandoc.Str $ Eval.ebOutput eb]]
Just eb -> Eval.evalBlockToBlocks eb


--------------------------------------------------------------------------------
Expand Down

0 comments on commit 61a0f76

Please sign in to comment.