mirror of
https://github.com/IHaskell/IHaskell.git
synced 2025-04-14 10:26:07 +00:00
Reply with execute_result instead of display_data
This commit is contained in:
parent
d7ad5d57ce
commit
2537124800
@ -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 } =
|
||||
|
@ -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.
|
||||
|
@ -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
|
||||
|
@ -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)] "" ""
|
||||
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user