Move ErrorOccurred to IHaskell.Types

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)
@@ -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 []) []) True
+          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 []) []) True
+          liftIO $ publish (FinalResult disp (if toUsePager then pgrOut else []) []) Success
           return kernelState { openComms = Map.delete uuid widgets }
         _ ->
           -- Only sensible thing to do.

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
@@ -250,8 +247,8 @@ 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 (true) or an error occurred (false).
-type Publisher = (EvaluationResult -> Bool -> IO ())
+-- completed successfully (Success) or an error occurred (Failure).
+type Publisher = (EvaluationResult -> ErrorOccurred -> IO ())
 
 -- | Output of a command evaluation.
 data EvalOut =
@@ -278,11 +275,6 @@ cleanString istr = if allBrackets
     -- should never happen:
     removeBracket other = error $ "Expected bracket as first char, but got string: " ++ other
 
--- | Converts Success/Failure to a boolean to set the output cell type.
-successStatus :: ErrorOccurred -> Bool
-successStatus Success = True
-successStatus Failure = False
-
 -- | Evaluate some IPython input code.
 evaluate :: KernelState                  -- ^ The kernel state.
          -> String                       -- ^ Haskell code or other interpreter commands.
@@ -304,7 +296,7 @@ evaluate kernelState code output widgetHandler = do
                  when (getLintStatus kernelState /= LintOff) $ liftIO $ do
                    lintSuggestions <- lint cmds
                    unless (noResults lintSuggestions) $
-                     output (FinalResult lintSuggestions [] []) True
+                     output (FinalResult lintSuggestions [] []) Success
 
                  runUntilFailure kernelState (map unloc cmds ++ [storeItCommand execCount])
                -- Print all parse errors.
@@ -313,7 +305,7 @@ evaluate kernelState code output widgetHandler = do
                    out <- evalCommand output err kernelState
                    liftIO $ output
                      (FinalResult (evalResult out) [] [])
-                     (successStatus $ evalStatus out)
+                     (evalStatus out)
                  return kernelState
 
   return updated { getExecutionCounter = execCount + 1 }
@@ -348,7 +340,7 @@ evaluate kernelState code output widgetHandler = do
       unless (noResults result && null (evalPager evalOut)) $
         liftIO $ output
           (FinalResult result (evalPager evalOut) [])
-          (successStatus $ evalStatus evalOut)
+          (evalStatus evalOut)
 
       let tempMsgs = evalMsgs evalOut
           tempState = evalState evalOut { evalMsgs = [] }
@@ -703,7 +695,7 @@ evalCommand publish (Directive ShellCmd cmd) state = wrapExecution state $
             case mExitCode of
               Nothing -> do
                 -- Write to frontend and repeat.
-                readMVar outputAccum >>= flip output True
+                readMVar outputAccum >>= flip output Success
                 loop
               Just exitCode -> do
                 next <- readChars pipe "" maxSize
@@ -1232,7 +1224,7 @@ evalStatementOrIO publish state cmd = do
     CapturedIO _ ->
       write state "Evaluating Action"
 
-  (printed, result) <- capturedEval (flip output True) cmd
+  (printed, result) <- capturedEval (flip output Success) cmd
   case result of
     ExecComplete (Right names) _ -> do
       dflags <- getSessionDynFlags

src/IHaskell/Publish.hs

@@ -26,7 +26,7 @@ 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
-              -> Bool               -- ^ Whether evaluation completed successfully
+              -> ErrorOccurred      -- ^ Whether evaluation completed successfully
               -> IO ()
 publishResult send replyHeader displayed updateNeeded poutput upager result success = do
   let final =
@@ -70,9 +70,13 @@ publishResult send replyHeader displayed updateNeeded poutput upager result succ
 
     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 ["<style>", T.pack ihaskellCSS, "</style>", h]

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)