diff --git a/.travis.yml b/.travis.yml index 0d7a20c1..519f34b2 100644 --- a/.travis.yml +++ b/.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) diff --git a/ipython-kernel/src/IHaskell/IPython/Message/Parser.hs b/ipython-kernel/src/IHaskell/IPython/Message/Parser.hs index 0d40f88b..072b0d7f 100644 --- a/ipython-kernel/src/IHaskell/IPython/Message/Parser.hs +++ b/ipython-kernel/src/IHaskell/IPython/Message/Parser.hs @@ -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 diff --git a/ipython-kernel/src/IHaskell/IPython/Types.hs b/ipython-kernel/src/IHaskell/IPython/Types.hs index 8d80df08..d3cad68a 100644 --- a/ipython-kernel/src/IHaskell/IPython/Types.hs +++ b/ipython-kernel/src/IHaskell/IPython/Types.hs @@ -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 } = diff --git a/main/Main.hs b/main/Main.hs index d353c646..f96d695b 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -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. diff --git a/notebooks/IHaskell.ipynb b/notebooks/IHaskell.ipynb index 44b45ae4..0e3f35aa 100644 --- a/notebooks/IHaskell.ipynb +++ b/notebooks/IHaskell.ipynb @@ -183,99 +183,12 @@ "metadata": {}, "outputs": [ { - "data": { - "text/html": [ - "<interactive>:1:1: error:
• ‘Thing’ has no constructors (EmptyDataDecls permits this)
• In the data declaration for ‘Thing’" - ], - "text/plain": [ - ":1:1: error:\n", - " • ‘Thing’ has no constructors (EmptyDataDecls permits this)\n", - " • In the data declaration for ‘Thing’" - ] - }, - "metadata": {}, - "output_type": "display_data" + "ename": "", + "evalue": "", + "output_type": "error", + "traceback": [ + ":1:1: error:\n • ‘Thing’ has no constructors (EmptyDataDecls permits this)\n • In the data declaration for ‘Thing’" + ] } ], "source": [ @@ -3275,97 +3188,12 @@ "metadata": {}, "outputs": [ { - "data": { - "text/html": [ - "<interactive>:1:1: error: Variable not in scope: f :: Integer -> t" - ], - "text/plain": [ - ":1:1: error: Variable not in scope: f :: Integer -> t" - ] - }, - "metadata": {}, - "output_type": "display_data" + "ename": "", + "evalue": "", + "output_type": "error", + "traceback": [ + ":1:1: error: Variable not in scope: f :: Integer -> t" + ] } ], "source": [ diff --git a/src/IHaskell/Eval/Evaluate.hs b/src/IHaskell/Eval/Evaluate.hs index 7b2a6897..ce1e587d 100644 --- a/src/IHaskell/Eval/Evaluate.hs +++ b/src/IHaskell/Eval/Evaluate.hs @@ -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 diff --git a/src/IHaskell/Publish.hs b/src/IHaskell/Publish.hs index 53271ae1..968d8e1c 100644 --- a/src/IHaskell/Publish.hs +++ b/src/IHaskell/Publish.hs @@ -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 - hdr <- dupHeader replyHeader DisplayDataMessage - send $ PublishDisplayData hdr (map (makeUnique uniqueLabel . prependCss) outs) Nothing + 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 ["", h] diff --git a/src/IHaskell/Types.hs b/src/IHaskell/Types.hs index aac4d7f8..03a20a96 100644 --- a/src/IHaskell/Types.hs +++ b/src/IHaskell/Types.hs @@ -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) diff --git a/src/tests/IHaskell/Test/Eval.hs b/src/tests/IHaskell/Test/Eval.hs index c301c83d..197fb772 100644 --- a/src/tests/IHaskell/Test/Eval.hs +++ b/src/tests/IHaskell/Test/Eval.hs @@ -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