mirror of
https://github.com/IHaskell/IHaskell.git
synced 2025-04-15 19:06:06 +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 []
|
$ ["metadata" .= object []
|
||||||
, "data" .= object (map displayDataToJson datas)
|
, "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 }
|
toJSON r@PublishUpdateDisplayData { displayData = datas }
|
||||||
= object
|
= object
|
||||||
$ case transient r of
|
$ case transient r of
|
||||||
@ -737,6 +743,12 @@ instance ToJSON Message where
|
|||||||
, "ename" .= ename
|
, "ename" .= ename
|
||||||
, "evalue" .= evalue
|
, "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 } =
|
toEncoding PublishStatus { executionState = executionState } =
|
||||||
pairs $ mconcat ["execution_state" .= executionState]
|
pairs $ mconcat ["execution_state" .= executionState]
|
||||||
toEncoding PublishStream { streamType = streamType, streamContent = content } =
|
toEncoding PublishStream { streamType = streamType, streamContent = content } =
|
||||||
|
@ -169,7 +169,7 @@ runKernel kOpts profileSrc = do
|
|||||||
kernelState { supportLibrariesAvailable = hasSupportLibraries }
|
kernelState { supportLibrariesAvailable = hasSupportLibraries }
|
||||||
|
|
||||||
-- Initialize the context by evaluating everything we got from the command line flags.
|
-- Initialize the context by evaluating everything we got from the command line flags.
|
||||||
let noPublish _ _ = return ()
|
let noPublish _ _ _ = return ()
|
||||||
noWidget s _ = return s
|
noWidget s _ = return s
|
||||||
evaluator line = void $ do
|
evaluator line = void $ do
|
||||||
-- Create a new state each time.
|
-- 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
|
-- a function that executes an IO action and publishes the output to
|
||||||
-- the frontend simultaneously.
|
-- the frontend simultaneously.
|
||||||
let run = capturedIO publish kernelState
|
let run = capturedIO publish kernelState
|
||||||
|
execCount = getExecutionCounter kernelState
|
||||||
publish = publishResult send replyHeader displayed updateNeeded pOut toUsePager
|
publish = publishResult send replyHeader displayed updateNeeded pOut toUsePager
|
||||||
|
|
||||||
newState <- case Map.lookup uuid widgets of
|
newState <- case Map.lookup uuid widgets of
|
||||||
@ -465,12 +466,12 @@ handleComm send kernelState req replyHeader = do
|
|||||||
CommDataMessage -> do
|
CommDataMessage -> do
|
||||||
disp <- run $ comm widget dat communicate
|
disp <- run $ comm widget dat communicate
|
||||||
pgrOut <- liftIO $ readMVar pOut
|
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
|
return kernelState
|
||||||
CommCloseMessage -> do
|
CommCloseMessage -> do
|
||||||
disp <- run $ close widget dat
|
disp <- run $ close widget dat
|
||||||
pgrOut <- liftIO $ readMVar pOut
|
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 }
|
return kernelState { openComms = Map.delete uuid widgets }
|
||||||
_ ->
|
_ ->
|
||||||
-- Only sensible thing to do.
|
-- Only sensible thing to do.
|
||||||
|
@ -198,7 +198,7 @@ testInterpret v = interpret GHC.Paths.libdir False False (const v)
|
|||||||
-- | Evaluation function for testing.
|
-- | Evaluation function for testing.
|
||||||
testEvaluate :: String -> IO ()
|
testEvaluate :: String -> IO ()
|
||||||
testEvaluate str = void $ testInterpret $
|
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
|
-- | Run an interpreting action. This is effectively runGhc with initialization
|
||||||
-- and importing. The `allowedStdin` argument indicates whether `stdin` is
|
-- 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
|
-- | Publisher for IHaskell outputs. The first argument indicates whether this output is final
|
||||||
-- (true) or intermediate (false). The second argument indicates whether the evaluation
|
-- (true) or intermediate (false). The second argument indicates whether the evaluation
|
||||||
-- completed successfully (Success) or an error occurred (Failure).
|
-- completed successfully (Success) or an error occurred (Failure). The third argument is the
|
||||||
type Publisher = (EvaluationResult -> ErrorOccurred -> IO ())
|
-- execution_count.
|
||||||
|
type Publisher = (EvaluationResult -> ErrorOccurred -> Int -> IO ())
|
||||||
|
|
||||||
-- | Output of a command evaluation.
|
-- | Output of a command evaluation.
|
||||||
data EvalOut =
|
data EvalOut =
|
||||||
@ -451,10 +452,10 @@ evaluate kernelState code output widgetHandler = do
|
|||||||
when (getLintStatus kernelState /= LintOff) $ liftIO $ do
|
when (getLintStatus kernelState /= LintOff) $ liftIO $ do
|
||||||
lintSuggestions <- lint code cmds
|
lintSuggestions <- lint code cmds
|
||||||
unless (noResults lintSuggestions) $
|
unless (noResults lintSuggestions) $
|
||||||
output (FinalResult lintSuggestions [] []) Success
|
output (FinalResult lintSuggestions [] []) Success execCount
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
runUntilFailure kernelState (map unloc cmds ++ [storeItCommand execCount])
|
runUntilFailure kernelState (map unloc cmds ++ [storeItCommand execCount]) execCount
|
||||||
-- Print all parse errors.
|
-- Print all parse errors.
|
||||||
_ -> do
|
_ -> do
|
||||||
forM_ errs $ \err -> do
|
forM_ errs $ \err -> do
|
||||||
@ -462,6 +463,7 @@ evaluate kernelState code output widgetHandler = do
|
|||||||
liftIO $ output
|
liftIO $ output
|
||||||
(FinalResult (evalResult out) [] [])
|
(FinalResult (evalResult out) [] [])
|
||||||
(evalStatus out)
|
(evalStatus out)
|
||||||
|
execCount
|
||||||
return (kernelState, Failure)
|
return (kernelState, Failure)
|
||||||
|
|
||||||
return (updated { getExecutionCounter = execCount + 1 }, errorOccurred)
|
return (updated { getExecutionCounter = execCount + 1 }, errorOccurred)
|
||||||
@ -470,9 +472,9 @@ evaluate kernelState code output widgetHandler = do
|
|||||||
noResults (Display res) = null res
|
noResults (Display res) = null res
|
||||||
noResults (ManyDisplay res) = all noResults res
|
noResults (ManyDisplay res) = all noResults res
|
||||||
|
|
||||||
runUntilFailure :: KernelState -> [CodeBlock] -> Interpreter (KernelState, ErrorOccurred)
|
runUntilFailure :: KernelState -> [CodeBlock] -> Int -> Interpreter (KernelState, ErrorOccurred)
|
||||||
runUntilFailure state [] = return (state, Success)
|
runUntilFailure state [] _ = return (state, Success)
|
||||||
runUntilFailure state (cmd:rest) = do
|
runUntilFailure state (cmd:rest) execCount = do
|
||||||
evalOut <- evalCommand output cmd state
|
evalOut <- evalCommand output cmd state
|
||||||
|
|
||||||
-- Get displayed channel outputs. Merge them with normal display outputs.
|
-- Get displayed channel outputs. Merge them with normal display outputs.
|
||||||
@ -497,6 +499,7 @@ evaluate kernelState code output widgetHandler = do
|
|||||||
liftIO $ output
|
liftIO $ output
|
||||||
(FinalResult result (evalPager evalOut) [])
|
(FinalResult result (evalPager evalOut) [])
|
||||||
(evalStatus evalOut)
|
(evalStatus evalOut)
|
||||||
|
execCount
|
||||||
|
|
||||||
let tempMsgs = evalMsgs evalOut
|
let tempMsgs = evalMsgs evalOut
|
||||||
tempState = evalState evalOut { evalMsgs = [] }
|
tempState = evalState evalOut { evalMsgs = [] }
|
||||||
@ -507,7 +510,7 @@ evaluate kernelState code output widgetHandler = do
|
|||||||
else return tempState
|
else return tempState
|
||||||
|
|
||||||
case evalStatus evalOut of
|
case evalStatus evalOut of
|
||||||
Success -> runUntilFailure newState rest
|
Success -> runUntilFailure newState rest execCount
|
||||||
Failure -> return (newState, Failure)
|
Failure -> return (newState, Failure)
|
||||||
|
|
||||||
storeItCommand execCount = Statement $ printf "let it%d = it" execCount
|
storeItCommand execCount = Statement $ printf "let it%d = it" execCount
|
||||||
@ -867,6 +870,9 @@ evalCommand publish (Directive ShellCmd cmd) state = wrapExecution state $
|
|||||||
incSize = 200
|
incSize = 200
|
||||||
output str = publish $ IntermediateResult $ Display [plain str]
|
output str = publish $ IntermediateResult $ Display [plain str]
|
||||||
|
|
||||||
|
-- Get execution_count.
|
||||||
|
execCount = getExecutionCounter state
|
||||||
|
|
||||||
loop = do
|
loop = do
|
||||||
-- Wait and then check if the computation is done.
|
-- Wait and then check if the computation is done.
|
||||||
threadDelay delay
|
threadDelay delay
|
||||||
@ -880,7 +886,7 @@ evalCommand publish (Directive ShellCmd cmd) state = wrapExecution state $
|
|||||||
case mExitCode of
|
case mExitCode of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
-- Write to frontend and repeat.
|
-- Write to frontend and repeat.
|
||||||
readMVar outputAccum >>= flip output Success
|
readMVar outputAccum >>= (\res -> output res Success execCount)
|
||||||
loop
|
loop
|
||||||
Just exitCode -> do
|
Just exitCode -> do
|
||||||
next <- readChars pipe "" maxSize
|
next <- readChars pipe "" maxSize
|
||||||
@ -1521,6 +1527,7 @@ capturedIO publish state action = do
|
|||||||
evalStatementOrIO :: Publisher -> KernelState -> Captured a -> Interpreter Display
|
evalStatementOrIO :: Publisher -> KernelState -> Captured a -> Interpreter Display
|
||||||
evalStatementOrIO publish state cmd = do
|
evalStatementOrIO publish state cmd = do
|
||||||
let output str = publish . IntermediateResult $ Display [plain str]
|
let output str = publish . IntermediateResult $ Display [plain str]
|
||||||
|
let execCount = getExecutionCounter state
|
||||||
|
|
||||||
case cmd of
|
case cmd of
|
||||||
CapturedStmt stmt ->
|
CapturedStmt stmt ->
|
||||||
@ -1528,7 +1535,7 @@ evalStatementOrIO publish state cmd = do
|
|||||||
CapturedIO _ ->
|
CapturedIO _ ->
|
||||||
write state "Evaluating Action"
|
write state "Evaluating Action"
|
||||||
|
|
||||||
(printed, result) <- capturedEval (flip output Success) cmd
|
(printed, result) <- capturedEval (\res -> output res Success execCount) cmd
|
||||||
case result of
|
case result of
|
||||||
ExecComplete (Right names) _ -> do
|
ExecComplete (Right names) _ -> do
|
||||||
dflags <- getSessionDynFlags
|
dflags <- getSessionDynFlags
|
||||||
|
@ -26,8 +26,9 @@ publishResult :: (Message -> IO ()) -- ^ A function to send messages
|
|||||||
-> Bool -- ^ Whether to use the pager
|
-> Bool -- ^ Whether to use the pager
|
||||||
-> EvaluationResult -- ^ The evaluation result
|
-> EvaluationResult -- ^ The evaluation result
|
||||||
-> ErrorOccurred -- ^ Whether evaluation completed successfully
|
-> ErrorOccurred -- ^ Whether evaluation completed successfully
|
||||||
|
-> Int
|
||||||
-> IO ()
|
-> IO ()
|
||||||
publishResult send replyHeader displayed updateNeeded poutput upager result success = do
|
publishResult send replyHeader displayed updateNeeded poutput upager result success execCount = do
|
||||||
let final =
|
let final =
|
||||||
case result of
|
case result of
|
||||||
IntermediateResult{} -> False
|
IntermediateResult{} -> False
|
||||||
@ -71,8 +72,8 @@ publishResult send replyHeader displayed updateNeeded poutput upager result succ
|
|||||||
mapM_ (sendOutput uniqueLabel) manyOuts
|
mapM_ (sendOutput uniqueLabel) manyOuts
|
||||||
sendOutput uniqueLabel (Display outs) = case success of
|
sendOutput uniqueLabel (Display outs) = case success of
|
||||||
Success -> do
|
Success -> do
|
||||||
hdr <- dupHeader replyHeader DisplayDataMessage
|
hdr <- dupHeader replyHeader ExecuteResultMessage
|
||||||
send $ PublishDisplayData hdr (map (makeUnique uniqueLabel) outs) Nothing
|
send $ ExecuteResult hdr (map (makeUnique uniqueLabel) outs) mempty execCount
|
||||||
Failure -> do
|
Failure -> do
|
||||||
hdr <- dupHeader replyHeader ExecuteErrorMessage
|
hdr <- dupHeader replyHeader ExecuteErrorMessage
|
||||||
send $ ExecuteError hdr [T.pack (extractPlain outs)] "" ""
|
send $ ExecuteError hdr [T.pack (extractPlain outs)] "" ""
|
||||||
|
@ -26,7 +26,7 @@ eval :: String -> IO ([Display], String)
|
|||||||
eval string = do
|
eval string = do
|
||||||
outputAccum <- newIORef []
|
outputAccum <- newIORef []
|
||||||
pagerAccum <- newIORef []
|
pagerAccum <- newIORef []
|
||||||
let publish evalResult _ =
|
let publish evalResult _ _ =
|
||||||
case evalResult of
|
case evalResult of
|
||||||
IntermediateResult{} -> return ()
|
IntermediateResult{} -> return ()
|
||||||
FinalResult outs page _ -> do
|
FinalResult outs page _ -> do
|
||||||
|
Loading…
x
Reference in New Issue
Block a user