From 25371248009abdca9a4f9c02cca9220d91d808aa Mon Sep 17 00:00:00 2001 From: Vaibhav Sagar Date: Thu, 7 Sep 2023 20:48:54 +1000 Subject: [PATCH] Reply with execute_result instead of display_data --- ipython-kernel/src/IHaskell/IPython/Types.hs | 12 ++++++++ main/Main.hs | 7 +++-- src/IHaskell/Eval/Evaluate.hs | 29 ++++++++++++-------- src/IHaskell/Publish.hs | 7 +++-- src/tests/IHaskell/Test/Eval.hs | 2 +- 5 files changed, 39 insertions(+), 18 deletions(-) diff --git a/ipython-kernel/src/IHaskell/IPython/Types.hs b/ipython-kernel/src/IHaskell/IPython/Types.hs index 3ef38d4c..c1634ae9 100644 --- a/ipython-kernel/src/IHaskell/IPython/Types.hs +++ b/ipython-kernel/src/IHaskell/IPython/Types.hs @@ -594,6 +594,12 @@ instance ToJSON Message where $ ["metadata" .= object [] , "data" .= object (map displayDataToJson datas) ] + toJSON r@(ExecuteResult header datas metadata execCount) + = object + [ "data" .= object (map displayDataToJson datas) + , "execution_count" .= execCount + , "metadata" .= metadata + ] toJSON r@PublishUpdateDisplayData { displayData = datas } = object $ case transient r of @@ -737,6 +743,12 @@ instance ToJSON Message where , "ename" .= ename , "evalue" .= evalue ] + toEncoding r@(ExecuteResult header datas metadata execCount) + = pairs $ mconcat + [ "data" .= object (map displayDataToJson datas) + , "execution_count" .= execCount + , "metadata" .= metadata + ] toEncoding PublishStatus { executionState = executionState } = pairs $ mconcat ["execution_state" .= executionState] toEncoding PublishStream { streamType = streamType, streamContent = content } = diff --git a/main/Main.hs b/main/Main.hs index 5161b4dc..b605d167 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -169,7 +169,7 @@ runKernel kOpts profileSrc = do kernelState { supportLibrariesAvailable = hasSupportLibraries } -- Initialize the context by evaluating everything we got from the command line flags. - let noPublish _ _ = return () + let noPublish _ _ _ = return () noWidget s _ = return s evaluator line = void $ do -- Create a new state each time. @@ -456,6 +456,7 @@ handleComm send kernelState req replyHeader = do -- a function that executes an IO action and publishes the output to -- the frontend simultaneously. let run = capturedIO publish kernelState + execCount = getExecutionCounter kernelState publish = publishResult send replyHeader displayed updateNeeded pOut toUsePager newState <- case Map.lookup uuid widgets of @@ -465,12 +466,12 @@ handleComm send kernelState req replyHeader = do CommDataMessage -> do disp <- run $ comm widget dat communicate pgrOut <- liftIO $ readMVar pOut - liftIO $ publish (FinalResult disp (if toUsePager then pgrOut else []) []) Success + liftIO $ publish (FinalResult disp (if toUsePager then pgrOut else []) []) Success execCount return kernelState CommCloseMessage -> do disp <- run $ close widget dat pgrOut <- liftIO $ readMVar pOut - liftIO $ publish (FinalResult disp (if toUsePager then pgrOut else []) []) Success + liftIO $ publish (FinalResult disp (if toUsePager then pgrOut else []) []) Success execCount return kernelState { openComms = Map.delete uuid widgets } _ -> -- Only sensible thing to do. diff --git a/src/IHaskell/Eval/Evaluate.hs b/src/IHaskell/Eval/Evaluate.hs index 61a6d19d..12e579c6 100644 --- a/src/IHaskell/Eval/Evaluate.hs +++ b/src/IHaskell/Eval/Evaluate.hs @@ -198,7 +198,7 @@ testInterpret v = interpret GHC.Paths.libdir False False (const v) -- | Evaluation function for testing. testEvaluate :: String -> IO () testEvaluate str = void $ testInterpret $ - evaluate defaultKernelState str (\_ _ -> return ()) (\state _ -> return state) + evaluate defaultKernelState str (\_ _ _ -> return ()) (\state _ -> return state) -- | Run an interpreting action. This is effectively runGhc with initialization -- and importing. The `allowedStdin` argument indicates whether `stdin` is @@ -400,8 +400,9 @@ initializeItVariable = -- | Publisher for IHaskell outputs. The first argument indicates whether this output is final -- (true) or intermediate (false). The second argument indicates whether the evaluation --- completed successfully (Success) or an error occurred (Failure). -type Publisher = (EvaluationResult -> ErrorOccurred -> IO ()) +-- completed successfully (Success) or an error occurred (Failure). The third argument is the +-- execution_count. +type Publisher = (EvaluationResult -> ErrorOccurred -> Int -> IO ()) -- | Output of a command evaluation. data EvalOut = @@ -451,10 +452,10 @@ evaluate kernelState code output widgetHandler = do when (getLintStatus kernelState /= LintOff) $ liftIO $ do lintSuggestions <- lint code cmds unless (noResults lintSuggestions) $ - output (FinalResult lintSuggestions [] []) Success + output (FinalResult lintSuggestions [] []) Success execCount #endif - runUntilFailure kernelState (map unloc cmds ++ [storeItCommand execCount]) + runUntilFailure kernelState (map unloc cmds ++ [storeItCommand execCount]) execCount -- Print all parse errors. _ -> do forM_ errs $ \err -> do @@ -462,6 +463,7 @@ evaluate kernelState code output widgetHandler = do liftIO $ output (FinalResult (evalResult out) [] []) (evalStatus out) + execCount return (kernelState, Failure) return (updated { getExecutionCounter = execCount + 1 }, errorOccurred) @@ -470,9 +472,9 @@ evaluate kernelState code output widgetHandler = do noResults (Display res) = null res noResults (ManyDisplay res) = all noResults res - runUntilFailure :: KernelState -> [CodeBlock] -> Interpreter (KernelState, ErrorOccurred) - runUntilFailure state [] = return (state, Success) - runUntilFailure state (cmd:rest) = do + runUntilFailure :: KernelState -> [CodeBlock] -> Int -> Interpreter (KernelState, ErrorOccurred) + runUntilFailure state [] _ = return (state, Success) + runUntilFailure state (cmd:rest) execCount = do evalOut <- evalCommand output cmd state -- Get displayed channel outputs. Merge them with normal display outputs. @@ -497,6 +499,7 @@ evaluate kernelState code output widgetHandler = do liftIO $ output (FinalResult result (evalPager evalOut) []) (evalStatus evalOut) + execCount let tempMsgs = evalMsgs evalOut tempState = evalState evalOut { evalMsgs = [] } @@ -507,7 +510,7 @@ evaluate kernelState code output widgetHandler = do else return tempState case evalStatus evalOut of - Success -> runUntilFailure newState rest + Success -> runUntilFailure newState rest execCount Failure -> return (newState, Failure) storeItCommand execCount = Statement $ printf "let it%d = it" execCount @@ -867,6 +870,9 @@ evalCommand publish (Directive ShellCmd cmd) state = wrapExecution state $ incSize = 200 output str = publish $ IntermediateResult $ Display [plain str] + -- Get execution_count. + execCount = getExecutionCounter state + loop = do -- Wait and then check if the computation is done. threadDelay delay @@ -880,7 +886,7 @@ evalCommand publish (Directive ShellCmd cmd) state = wrapExecution state $ case mExitCode of Nothing -> do -- Write to frontend and repeat. - readMVar outputAccum >>= flip output Success + readMVar outputAccum >>= (\res -> output res Success execCount) loop Just exitCode -> do next <- readChars pipe "" maxSize @@ -1521,6 +1527,7 @@ capturedIO publish state action = do evalStatementOrIO :: Publisher -> KernelState -> Captured a -> Interpreter Display evalStatementOrIO publish state cmd = do let output str = publish . IntermediateResult $ Display [plain str] + let execCount = getExecutionCounter state case cmd of CapturedStmt stmt -> @@ -1528,7 +1535,7 @@ evalStatementOrIO publish state cmd = do CapturedIO _ -> write state "Evaluating Action" - (printed, result) <- capturedEval (flip output Success) cmd + (printed, result) <- capturedEval (\res -> output res Success execCount) cmd case result of ExecComplete (Right names) _ -> do dflags <- getSessionDynFlags diff --git a/src/IHaskell/Publish.hs b/src/IHaskell/Publish.hs index 956b49e4..2ae2a42c 100644 --- a/src/IHaskell/Publish.hs +++ b/src/IHaskell/Publish.hs @@ -26,8 +26,9 @@ publishResult :: (Message -> IO ()) -- ^ A function to send messages -> Bool -- ^ Whether to use the pager -> EvaluationResult -- ^ The evaluation result -> ErrorOccurred -- ^ Whether evaluation completed successfully + -> Int -> IO () -publishResult send replyHeader displayed updateNeeded poutput upager result success = do +publishResult send replyHeader displayed updateNeeded poutput upager result success execCount = do let final = case result of IntermediateResult{} -> False @@ -71,8 +72,8 @@ publishResult send replyHeader displayed updateNeeded poutput upager result succ mapM_ (sendOutput uniqueLabel) manyOuts sendOutput uniqueLabel (Display outs) = case success of Success -> do - hdr <- dupHeader replyHeader DisplayDataMessage - send $ PublishDisplayData hdr (map (makeUnique uniqueLabel) outs) Nothing + hdr <- dupHeader replyHeader ExecuteResultMessage + send $ ExecuteResult hdr (map (makeUnique uniqueLabel) outs) mempty execCount Failure -> do hdr <- dupHeader replyHeader ExecuteErrorMessage send $ ExecuteError hdr [T.pack (extractPlain outs)] "" "" diff --git a/src/tests/IHaskell/Test/Eval.hs b/src/tests/IHaskell/Test/Eval.hs index 693963d5..8b8a16d0 100644 --- a/src/tests/IHaskell/Test/Eval.hs +++ b/src/tests/IHaskell/Test/Eval.hs @@ -26,7 +26,7 @@ eval :: String -> IO ([Display], String) eval string = do outputAccum <- newIORef [] pagerAccum <- newIORef [] - let publish evalResult _ = + let publish evalResult _ _ = case evalResult of IntermediateResult{} -> return () FinalResult outs page _ -> do