mirror of
https://github.com/IHaskell/IHaskell.git
synced 2025-04-16 11:26:08 +00:00
Merge pull request #1008 from gibiansky/errorstatus
Attempt to set error status
This commit is contained in:
commit
c6ca209a43
12
.travis.yml
12
.travis.yml
@ -78,7 +78,7 @@ matrix:
|
||||
# Run the notebook to regenerate the outputs, then compare the new notebook to the old one.
|
||||
stack install --fast
|
||||
stack exec -- ihaskell install --stack
|
||||
stack exec -- jupyter nbconvert --to=notebook --execute --stdout notebooks/IHaskell.ipynb > ~/ihaskell-out.ipynb
|
||||
stack exec -- jupyter nbconvert --to=notebook --execute --allow-errors --stdout notebooks/IHaskell.ipynb > ~/ihaskell-out.ipynb
|
||||
|
||||
# Images are rendered differently on different systems, so filter them out in the comparison
|
||||
diff <(egrep -v 'image/png|version|pygments' ~/ihaskell-out.ipynb) <(egrep -v 'image/png|version|pygments' notebooks/IHaskell.ipynb)
|
||||
@ -158,7 +158,7 @@ matrix:
|
||||
# Run the notebook to regenerate the outputs, then compare the new notebook to the old one.
|
||||
stack install --fast
|
||||
stack exec -- ihaskell install --stack
|
||||
stack exec -- jupyter nbconvert --to=notebook --execute --stdout notebooks/IHaskell.ipynb > ~/ihaskell-out.ipynb
|
||||
stack exec -- jupyter nbconvert --to=notebook --execute --allow-errors --stdout notebooks/IHaskell.ipynb > ~/ihaskell-out.ipynb
|
||||
|
||||
# Images are rendered differently on different systems, so filter them out in the comparison
|
||||
diff <(egrep -v 'image/png|version|pygments' ~/ihaskell-out.ipynb) <(egrep -v 'image/png|version|pygments' notebooks/IHaskell.ipynb)
|
||||
@ -238,7 +238,7 @@ matrix:
|
||||
# Run the notebook to regenerate the outputs, then compare the new notebook to the old one.
|
||||
stack install --fast
|
||||
stack exec -- ihaskell install --stack
|
||||
stack exec -- jupyter nbconvert --to=notebook --execute --stdout notebooks/IHaskell.ipynb > ~/ihaskell-out.ipynb
|
||||
stack exec -- jupyter nbconvert --to=notebook --execute --allow-errors --stdout notebooks/IHaskell.ipynb > ~/ihaskell-out.ipynb
|
||||
|
||||
# Images are rendered differently on different systems, so filter them out in the comparison
|
||||
diff <(egrep -v 'image/png|version|pygments' ~/ihaskell-out.ipynb) <(egrep -v 'image/png|version|pygments' notebooks/IHaskell.ipynb)
|
||||
@ -318,7 +318,7 @@ matrix:
|
||||
# Run the notebook to regenerate the outputs, then compare the new notebook to the old one.
|
||||
stack install --fast
|
||||
stack exec -- ihaskell install --stack
|
||||
stack exec -- jupyter nbconvert --to=notebook --execute --stdout notebooks/IHaskell.ipynb > ~/ihaskell-out.ipynb
|
||||
stack exec -- jupyter nbconvert --to=notebook --execute --allow-errors --stdout notebooks/IHaskell.ipynb > ~/ihaskell-out.ipynb
|
||||
|
||||
# Images are rendered differently on different systems, so filter them out in the comparison
|
||||
diff <(egrep -v 'image/png|version|pygments' ~/ihaskell-out.ipynb) <(egrep -v 'image/png|version|pygments' notebooks/IHaskell.ipynb)
|
||||
@ -352,7 +352,7 @@ matrix:
|
||||
ihaskell-plot
|
||||
ihaskell-static-canvas
|
||||
])'
|
||||
- result/bin/ihaskell-nbconvert --to=notebook --execute --stdout notebooks/IHaskell.ipynb > ~/ihaskell-out.ipynb
|
||||
- result/bin/ihaskell-nbconvert --to=notebook --execute --allow-errors --stdout notebooks/IHaskell.ipynb > ~/ihaskell-out.ipynb
|
||||
- diff <(egrep -v 'image/png|version|pygments' ~/ihaskell-out.ipynb) <(egrep -v 'image/png|version|pygments' notebooks/IHaskell.ipynb)
|
||||
- language: nix
|
||||
dist: xenial
|
||||
@ -383,5 +383,5 @@ matrix:
|
||||
ihaskell-plot
|
||||
ihaskell-static-canvas
|
||||
])'
|
||||
- result/bin/ihaskell-nbconvert --to=notebook --execute --stdout notebooks/IHaskell.ipynb > ~/ihaskell-out.ipynb
|
||||
- result/bin/ihaskell-nbconvert --to=notebook --execute --allow-errors --stdout notebooks/IHaskell.ipynb > ~/ihaskell-out.ipynb
|
||||
- diff <(egrep -v 'image/png|version|pygments' ~/ihaskell-out.ipynb) <(egrep -v 'image/png|version|pygments' notebooks/IHaskell.ipynb)
|
||||
|
@ -148,7 +148,7 @@ executeErrorParser = requestParser $ \obj -> do
|
||||
traceback <- obj .: "traceback"
|
||||
ename <- obj .: "ename"
|
||||
evalue <- obj .: "evalue"
|
||||
return $ ExecuteError noHeader [] traceback ename evalue
|
||||
return $ ExecuteError noHeader traceback ename evalue
|
||||
|
||||
makeDisplayDatas :: Object -> [DisplayData]
|
||||
makeDisplayDatas dataDict = [DisplayData (read $ unpack mimeType) content | (mimeType, String content) <- HM.toList
|
||||
|
@ -378,7 +378,6 @@ data Message =
|
||||
-- | An error reply to an execute request
|
||||
ExecuteError
|
||||
{ header :: MessageHeader
|
||||
, pagerOutput :: [DisplayData] -- ^ The mimebundles to display in the pager.
|
||||
, traceback :: [Text]
|
||||
, ename :: Text
|
||||
, evalue :: Text
|
||||
@ -561,6 +560,13 @@ instance ToJSON Message where
|
||||
, "data" .= object (map displayDataToJson o)
|
||||
]
|
||||
]
|
||||
toJSON ExecuteError { header = header, traceback = traceback, ename = ename, evalue = evalue } =
|
||||
object
|
||||
[ "header" .= show header
|
||||
, "traceback" .= map toJSON traceback
|
||||
, "ename" .= ename
|
||||
, "evalue" .= evalue
|
||||
]
|
||||
toJSON PublishStatus { executionState = executionState } =
|
||||
object ["execution_state" .= executionState]
|
||||
toJSON PublishStream { streamType = streamType, streamContent = content } =
|
||||
|
@ -12,7 +12,7 @@ import qualified Data.ByteString.Lazy as LBS
|
||||
-- Standard library imports.
|
||||
import Control.Concurrent.Chan
|
||||
import Control.Arrow (second)
|
||||
import Data.Aeson
|
||||
import Data.Aeson hiding (Success)
|
||||
import System.Process (readProcess, readProcessWithExitCode)
|
||||
import System.Exit (exitSuccess, ExitCode(ExitSuccess))
|
||||
import Control.Exception (try, SomeException)
|
||||
@ -151,7 +151,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.
|
||||
@ -429,12 +429,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 []) []
|
||||
liftIO $ publish (FinalResult disp (if toUsePager then pgrOut else []) []) Success
|
||||
return kernelState
|
||||
CommCloseMessage -> do
|
||||
disp <- run $ close widget dat
|
||||
pgrOut <- liftIO $ readMVar pOut
|
||||
liftIO $ publish $ FinalResult disp (if toUsePager then pgrOut else []) []
|
||||
liftIO $ publish (FinalResult disp (if toUsePager then pgrOut else []) []) Success
|
||||
return kernelState { openComms = Map.delete uuid widgets }
|
||||
_ ->
|
||||
-- Only sensible thing to do.
|
||||
|
@ -183,99 +183,12 @@
|
||||
"metadata": {},
|
||||
"outputs": [
|
||||
{
|
||||
"data": {
|
||||
"text/html": [
|
||||
"<style>/* Styles used for the Hoogle display in the pager */\n",
|
||||
".hoogle-doc {\n",
|
||||
"display: block;\n",
|
||||
"padding-bottom: 1.3em;\n",
|
||||
"padding-left: 0.4em;\n",
|
||||
"}\n",
|
||||
".hoogle-code {\n",
|
||||
"display: block;\n",
|
||||
"font-family: monospace;\n",
|
||||
"white-space: pre;\n",
|
||||
"}\n",
|
||||
".hoogle-text {\n",
|
||||
"display: block;\n",
|
||||
"}\n",
|
||||
".hoogle-name {\n",
|
||||
"color: green;\n",
|
||||
"font-weight: bold;\n",
|
||||
"}\n",
|
||||
".hoogle-head {\n",
|
||||
"font-weight: bold;\n",
|
||||
"}\n",
|
||||
".hoogle-sub {\n",
|
||||
"display: block;\n",
|
||||
"margin-left: 0.4em;\n",
|
||||
"}\n",
|
||||
".hoogle-package {\n",
|
||||
"font-weight: bold;\n",
|
||||
"font-style: italic;\n",
|
||||
"}\n",
|
||||
".hoogle-module {\n",
|
||||
"font-weight: bold;\n",
|
||||
"}\n",
|
||||
".hoogle-class {\n",
|
||||
"font-weight: bold;\n",
|
||||
"}\n",
|
||||
".get-type {\n",
|
||||
"color: green;\n",
|
||||
"font-weight: bold;\n",
|
||||
"font-family: monospace;\n",
|
||||
"display: block;\n",
|
||||
"white-space: pre-wrap;\n",
|
||||
"}\n",
|
||||
".show-type {\n",
|
||||
"color: green;\n",
|
||||
"font-weight: bold;\n",
|
||||
"font-family: monospace;\n",
|
||||
"margin-left: 1em;\n",
|
||||
"}\n",
|
||||
".mono {\n",
|
||||
"font-family: monospace;\n",
|
||||
"display: block;\n",
|
||||
"}\n",
|
||||
".err-msg {\n",
|
||||
"color: red;\n",
|
||||
"font-style: italic;\n",
|
||||
"font-family: monospace;\n",
|
||||
"white-space: pre;\n",
|
||||
"display: block;\n",
|
||||
"}\n",
|
||||
"#unshowable {\n",
|
||||
"color: red;\n",
|
||||
"font-weight: bold;\n",
|
||||
"}\n",
|
||||
".err-msg.in.collapse {\n",
|
||||
"padding-top: 0.7em;\n",
|
||||
"}\n",
|
||||
".highlight-code {\n",
|
||||
"white-space: pre;\n",
|
||||
"font-family: monospace;\n",
|
||||
"}\n",
|
||||
".suggestion-warning { \n",
|
||||
"font-weight: bold;\n",
|
||||
"color: rgb(200, 130, 0);\n",
|
||||
"}\n",
|
||||
".suggestion-error { \n",
|
||||
"font-weight: bold;\n",
|
||||
"color: red;\n",
|
||||
"}\n",
|
||||
".suggestion-name {\n",
|
||||
"font-weight: bold;\n",
|
||||
"}\n",
|
||||
"</style><span class='err-msg'><interactive>:1:1: error:<br/> • ‘Thing’ has no constructors (EmptyDataDecls permits this)<br/> • In the data declaration for ‘Thing’</span>"
|
||||
],
|
||||
"text/plain": [
|
||||
"<interactive>:1:1: error:\n",
|
||||
" • ‘Thing’ has no constructors (EmptyDataDecls permits this)\n",
|
||||
" • In the data declaration for ‘Thing’"
|
||||
"ename": "",
|
||||
"evalue": "",
|
||||
"output_type": "error",
|
||||
"traceback": [
|
||||
"<interactive>:1:1: error:\n • ‘Thing’ has no constructors (EmptyDataDecls permits this)\n • In the data declaration for ‘Thing’"
|
||||
]
|
||||
},
|
||||
"metadata": {},
|
||||
"output_type": "display_data"
|
||||
}
|
||||
],
|
||||
"source": [
|
||||
@ -3275,97 +3188,12 @@
|
||||
"metadata": {},
|
||||
"outputs": [
|
||||
{
|
||||
"data": {
|
||||
"text/html": [
|
||||
"<style>/* Styles used for the Hoogle display in the pager */\n",
|
||||
".hoogle-doc {\n",
|
||||
"display: block;\n",
|
||||
"padding-bottom: 1.3em;\n",
|
||||
"padding-left: 0.4em;\n",
|
||||
"}\n",
|
||||
".hoogle-code {\n",
|
||||
"display: block;\n",
|
||||
"font-family: monospace;\n",
|
||||
"white-space: pre;\n",
|
||||
"}\n",
|
||||
".hoogle-text {\n",
|
||||
"display: block;\n",
|
||||
"}\n",
|
||||
".hoogle-name {\n",
|
||||
"color: green;\n",
|
||||
"font-weight: bold;\n",
|
||||
"}\n",
|
||||
".hoogle-head {\n",
|
||||
"font-weight: bold;\n",
|
||||
"}\n",
|
||||
".hoogle-sub {\n",
|
||||
"display: block;\n",
|
||||
"margin-left: 0.4em;\n",
|
||||
"}\n",
|
||||
".hoogle-package {\n",
|
||||
"font-weight: bold;\n",
|
||||
"font-style: italic;\n",
|
||||
"}\n",
|
||||
".hoogle-module {\n",
|
||||
"font-weight: bold;\n",
|
||||
"}\n",
|
||||
".hoogle-class {\n",
|
||||
"font-weight: bold;\n",
|
||||
"}\n",
|
||||
".get-type {\n",
|
||||
"color: green;\n",
|
||||
"font-weight: bold;\n",
|
||||
"font-family: monospace;\n",
|
||||
"display: block;\n",
|
||||
"white-space: pre-wrap;\n",
|
||||
"}\n",
|
||||
".show-type {\n",
|
||||
"color: green;\n",
|
||||
"font-weight: bold;\n",
|
||||
"font-family: monospace;\n",
|
||||
"margin-left: 1em;\n",
|
||||
"}\n",
|
||||
".mono {\n",
|
||||
"font-family: monospace;\n",
|
||||
"display: block;\n",
|
||||
"}\n",
|
||||
".err-msg {\n",
|
||||
"color: red;\n",
|
||||
"font-style: italic;\n",
|
||||
"font-family: monospace;\n",
|
||||
"white-space: pre;\n",
|
||||
"display: block;\n",
|
||||
"}\n",
|
||||
"#unshowable {\n",
|
||||
"color: red;\n",
|
||||
"font-weight: bold;\n",
|
||||
"}\n",
|
||||
".err-msg.in.collapse {\n",
|
||||
"padding-top: 0.7em;\n",
|
||||
"}\n",
|
||||
".highlight-code {\n",
|
||||
"white-space: pre;\n",
|
||||
"font-family: monospace;\n",
|
||||
"}\n",
|
||||
".suggestion-warning { \n",
|
||||
"font-weight: bold;\n",
|
||||
"color: rgb(200, 130, 0);\n",
|
||||
"}\n",
|
||||
".suggestion-error { \n",
|
||||
"font-weight: bold;\n",
|
||||
"color: red;\n",
|
||||
"}\n",
|
||||
".suggestion-name {\n",
|
||||
"font-weight: bold;\n",
|
||||
"}\n",
|
||||
"</style><span class='err-msg'><interactive>:1:1: error: Variable not in scope: f :: Integer -> t</span>"
|
||||
],
|
||||
"text/plain": [
|
||||
"ename": "",
|
||||
"evalue": "",
|
||||
"output_type": "error",
|
||||
"traceback": [
|
||||
"<interactive>:1:1: error: Variable not in scope: f :: Integer -> t"
|
||||
]
|
||||
},
|
||||
"metadata": {},
|
||||
"output_type": "display_data"
|
||||
}
|
||||
],
|
||||
"source": [
|
||||
|
@ -70,9 +70,6 @@ import Data.Version (versionBranch)
|
||||
#endif
|
||||
|
||||
|
||||
data ErrorOccurred = Success
|
||||
| Failure
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | Set GHC's verbosity for debugging
|
||||
ghcVerbosity :: Maybe Int
|
||||
@ -126,7 +123,7 @@ testInterpret v = interpret GHC.Paths.libdir False (const v)
|
||||
-- | Evaluation function for testing.
|
||||
testEvaluate :: String -> IO ()
|
||||
testEvaluate str = void $ testInterpret $
|
||||
evaluate defaultKernelState str (const $ return ()) (\state _ -> return state)
|
||||
evaluate defaultKernelState str (\_ _ -> return ()) (\state _ -> return state)
|
||||
|
||||
-- | Run an interpreting action. This is effectively runGhc with initialization and importing. First
|
||||
-- argument indicates whether `stdin` is handled specially, which cannot be done in a testing
|
||||
@ -249,8 +246,9 @@ initializeItVariable =
|
||||
void $ execStmt "let it = ()" execOptions
|
||||
|
||||
-- | Publisher for IHaskell outputs. The first argument indicates whether this output is final
|
||||
-- (true) or intermediate (false).
|
||||
type Publisher = (EvaluationResult -> IO ())
|
||||
-- (true) or intermediate (false). The second argument indicates whether the evaluation
|
||||
-- completed successfully (Success) or an error occurred (Failure).
|
||||
type Publisher = (EvaluationResult -> ErrorOccurred -> IO ())
|
||||
|
||||
-- | Output of a command evaluation.
|
||||
data EvalOut =
|
||||
@ -298,14 +296,16 @@ evaluate kernelState code output widgetHandler = do
|
||||
when (getLintStatus kernelState /= LintOff) $ liftIO $ do
|
||||
lintSuggestions <- lint cmds
|
||||
unless (noResults lintSuggestions) $
|
||||
output $ FinalResult lintSuggestions [] []
|
||||
output (FinalResult lintSuggestions [] []) Success
|
||||
|
||||
runUntilFailure kernelState (map unloc cmds ++ [storeItCommand execCount])
|
||||
-- Print all parse errors.
|
||||
_ -> do
|
||||
forM_ errs $ \err -> do
|
||||
out <- evalCommand output err kernelState
|
||||
liftIO $ output $ FinalResult (evalResult out) [] []
|
||||
liftIO $ output
|
||||
(FinalResult (evalResult out) [] [])
|
||||
(evalStatus out)
|
||||
return kernelState
|
||||
|
||||
return updated { getExecutionCounter = execCount + 1 }
|
||||
@ -338,7 +338,9 @@ evaluate kernelState code output widgetHandler = do
|
||||
|
||||
-- Output things only if they are non-empty.
|
||||
unless (noResults result && null (evalPager evalOut)) $
|
||||
liftIO $ output $ FinalResult result (evalPager evalOut) []
|
||||
liftIO $ output
|
||||
(FinalResult result (evalPager evalOut) [])
|
||||
(evalStatus evalOut)
|
||||
|
||||
let tempMsgs = evalMsgs evalOut
|
||||
tempState = evalState evalOut { evalMsgs = [] }
|
||||
@ -693,7 +695,7 @@ evalCommand publish (Directive ShellCmd cmd) state = wrapExecution state $
|
||||
case mExitCode of
|
||||
Nothing -> do
|
||||
-- Write to frontend and repeat.
|
||||
readMVar outputAccum >>= output
|
||||
readMVar outputAccum >>= flip output Success
|
||||
loop
|
||||
Just exitCode -> do
|
||||
next <- readChars pipe "" maxSize
|
||||
@ -1222,7 +1224,7 @@ evalStatementOrIO publish state cmd = do
|
||||
CapturedIO _ ->
|
||||
write state "Evaluating Action"
|
||||
|
||||
(printed, result) <- capturedEval output cmd
|
||||
(printed, result) <- capturedEval (flip output Success) cmd
|
||||
case result of
|
||||
ExecComplete (Right names) _ -> do
|
||||
dflags <- getSessionDynFlags
|
||||
|
@ -26,8 +26,9 @@ publishResult :: (Message -> IO ()) -- ^ A function to send messages
|
||||
-> MVar [DisplayData] -- ^ A MVar to use for storing pager output
|
||||
-> Bool -- ^ Whether to use the pager
|
||||
-> EvaluationResult -- ^ The evaluation result
|
||||
-> ErrorOccurred -- ^ Whether evaluation completed successfully
|
||||
-> IO ()
|
||||
publishResult send replyHeader displayed updateNeeded poutput upager result = do
|
||||
publishResult send replyHeader displayed updateNeeded poutput upager result success = do
|
||||
let final =
|
||||
case result of
|
||||
IntermediateResult{} -> False
|
||||
@ -69,9 +70,13 @@ publishResult send replyHeader displayed updateNeeded poutput upager result = do
|
||||
|
||||
sendOutput uniqueLabel (ManyDisplay manyOuts) =
|
||||
mapM_ (sendOutput uniqueLabel) manyOuts
|
||||
sendOutput uniqueLabel (Display outs) = do
|
||||
sendOutput uniqueLabel (Display outs) = case success of
|
||||
Success -> do
|
||||
hdr <- dupHeader replyHeader DisplayDataMessage
|
||||
send $ PublishDisplayData hdr (map (makeUnique uniqueLabel . prependCss) outs) Nothing
|
||||
Failure -> do
|
||||
hdr <- dupHeader replyHeader ExecuteErrorMessage
|
||||
send $ ExecuteError hdr [T.pack (extractPlain outs)] "" ""
|
||||
|
||||
prependCss (DisplayData MimeHtml h) =
|
||||
DisplayData MimeHtml $ mconcat ["<style>", T.pack ihaskellCSS, "</style>", h]
|
||||
|
@ -18,6 +18,7 @@ module IHaskell.Types (
|
||||
StreamType(..),
|
||||
MimeType(..),
|
||||
DisplayData(..),
|
||||
ErrorOccurred(..),
|
||||
EvaluationResult(..),
|
||||
evaluationOutputs,
|
||||
ExecuteReplyStatus(..),
|
||||
@ -274,5 +275,9 @@ evaluationOutputs er =
|
||||
dupHeader :: MessageHeader -> MessageType -> IO MessageHeader
|
||||
dupHeader hdr messageType = do
|
||||
uuid <- liftIO random
|
||||
|
||||
return hdr { mhMessageId = uuid, mhMsgType = messageType }
|
||||
|
||||
-- | Whether or not an error occurred.
|
||||
data ErrorOccurred = Success
|
||||
| Failure
|
||||
deriving (Show, Eq)
|
||||
|
@ -24,7 +24,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