No longer crashing on breaking imports.

Haskell-Notebook.ipynb

@@ -46,7 +46,7 @@
      "cell_type": "code",
      "collapsed": false,
      "input": [
-      "import Control.Applicative\n",
+      "import Control.Appldaicative\n",
       "print\n",
       "print $ (+) <$> Just 3 <*> Just 10"
      ],
@@ -54,15 +54,14 @@
      "metadata": {},
      "outputs": [
       {
-       "ename": "SyntaxError",
-       "evalue": "invalid syntax (<ipython-input-2-ee999d0ba8c4>, line 3)",
-       "output_type": "pyerr",
-       "traceback": [
-        "\u001b[0;36m  File \u001b[0;32m\"<ipython-input-2-ee999d0ba8c4>\"\u001b[0;36m, line \u001b[0;32m3\u001b[0m\n\u001b[0;31m    print $ (+) <$> Just 3 <*> Just 10\u001b[0m\n\u001b[0m          ^\u001b[0m\n\u001b[0;31mSyntaxError\u001b[0m\u001b[0;31m:\u001b[0m invalid syntax\n"
-       ]
+       "html": [
+        "<span style='color: red; font-style: italic;'>Not in scope: `<*>'<br/>Perhaps you meant `<$>' (imported from Control.Applicative)<br/></span>"
+       ],
+       "metadata": {},
+       "output_type": "display_data"
       }
      ],
-     "prompt_number": 2
+     "prompt_number": 6
     },
     {
      "cell_type": "code",
@@ -99,47 +98,41 @@
      "cell_type": "code",
      "collapsed": false,
      "input": [
-      "map "
+      "import Lkjadflkjad\n",
+      "import Alksjdfljksd"
      ],
      "language": "python",
      "metadata": {},
      "outputs": [
       {
        "html": [
-        "<span style='color: red; font-style: italic;'>No instance for (GHC.Show.Show ((a0 -> b0) -> [a0] -> [b0]))<br/>  arising from a use of `System.IO.print'<br/>Possible fix:<br/>  add an instance declaration for<br/>  (GHC.Show.Show ((a0 -> b0) -> [a0] -> [b0]))<br/></span>"
+        "<span style='color: red; font-style: italic;'>Failed to load interface for `Alksjdfljksd'<br/>Use -v to see a list of the files searched for.<br/></span>"
        ],
        "metadata": {},
        "output_type": "display_data"
       }
      ],
-     "prompt_number": 2
+     "prompt_number": 7
     },
     {
      "cell_type": "code",
      "collapsed": false,
      "input": [
-      "abc"
+      "abc\n",
+      "adsf"
      ],
      "language": "python",
      "metadata": {},
      "outputs": [
-      {
-       "metadata": {},
-       "output_type": "pyout",
-       "prompt_number": 3,
-       "text": []
-      },
       {
        "html": [
-        "<span style='color: red; font-style: italic;'>Not in scope: `abc'\n",
-        "Perhaps you meant `abs' (imported from Prelude)\n",
-        "</span>"
+        "<span style='color: red; font-style: italic;'>Not in scope: `adsf'<br/></span>"
        ],
        "metadata": {},
        "output_type": "display_data"
       }
      ],
-     "prompt_number": 3
+     "prompt_number": 9
     },
     {
      "cell_type": "code",

IHaskell/Completion.hs

@@ -19,7 +19,6 @@ module IHaskell.Completion (makeCompletions) where
 import Prelude
 import Data.List (find, isPrefixOf, nub)
 import qualified GHC
-import GhcMonad(liftIO)
 import Outputable (showPpr)
 import Data.Char
 import Data.ByteString.UTF8 hiding (drop)

IHaskell/Eval/Evaluate.hs

@@ -32,6 +32,8 @@ import qualified System.IO.Strict as StrictIO
 
 import IHaskell.Types
 
+data ErrorOccurred = Success | Failure
+
 debug :: Bool
 debug = True
 
@@ -103,14 +105,23 @@ evaluate :: String                    -- ^ Haskell code or other interpreter com
          -> Interpreter [DisplayData] -- ^ All of the output.
 evaluate code
   | strip code == "" = return [] 
-  | otherwise = joinDisplays <$> mapM evalCommand (parseCommands $ strip code)
-
-joinDisplays :: [[DisplayData]] -> [DisplayData]
+  | otherwise = joinDisplays <$> runUntilFailure (parseCommands $ strip code)
+  where
+    runUntilFailure :: [Command] -> Interpreter [DisplayData]
+    runUntilFailure [] = return []
+    runUntilFailure (cmd:rest) = do 
+      (success, result) <- evalCommand cmd
+      case success of
+        Success -> do
+          restRes <- runUntilFailure rest
+          return $ result ++ restRes
+        Failure -> return result
+
+joinDisplays :: [DisplayData] -> [DisplayData]
 joinDisplays displays = 
   let isPlain (Display mime _) = (mime == PlainText)
-      allDisplays = concat displays
-      plains = filter isPlain allDisplays
-      other = filter (not . isPlain) allDisplays 
+      plains = filter isPlain displays
+      other = filter (not . isPlain) displays 
       getText (Display PlainText text) = text
       joinedPlains = Display PlainText $ concat $ map getText plains in
     case length plains of
@@ -160,26 +171,27 @@ parseCommands code = concatMap makeCommands pieces
       ':':'t':' ':expr -> Directive (GetType expr)
       other            -> ParseError 0 0 $ "Unknown command: " ++ other ++ "."
 
-evalCommand :: Command -> Interpreter [DisplayData]
-evalCommand (Import importStr) = do
+wrapExecution :: Interpreter [DisplayData] -> Interpreter (ErrorOccurred, [DisplayData])
+wrapExecution exec = ghandle handler $ exec >>= \res ->
+    return (Success, res)
+  where 
+    handler :: SomeException -> Interpreter (ErrorOccurred, [DisplayData])
+    handler exception = return (Failure, [Display MimeHtml $ makeError $ show exception])
+
+-- | Return the display data for this command, as well as whether it
+-- resulted in an error.
+evalCommand :: Command -> Interpreter (ErrorOccurred, [DisplayData])
+evalCommand (Import importStr) = wrapExecution $ do
   write $ "Import: " ++ importStr
   importDecl <- parseImportDecl importStr
   context <- getContext
   setContext $ IIDecl importDecl : context
   return []
 
-evalCommand (Directive (GetType expr)) 
-  = ghandle handler 
-    $ do result <- exprType expr
-         dflags <- getSessionDynFlags
-         return [Display MimeHtml 
-          $ printf "<span style='font-weight: bold; color: green;'>%s</span>" 
-          $ showSDocUnqual dflags $ ppr result]
-  where 
-    handler :: SomeException -> Interpreter [DisplayData]
-    handler exception = do
-      write $ concat ["BreakCom: ", show exception]
-      return [Display MimeHtml $ makeError $ show exception]
+evalCommand (Directive (GetType expr)) = wrapExecution $ do
+  result <- exprType expr
+  dflags <- getSessionDynFlags
+  return [Display MimeHtml $ printf "<span style='font-weight: bold; color: green;'>%s</span>" $ showSDocUnqual dflags $ ppr result]
 
 evalCommand (Statement stmt) = do
   write $ "Statement: " ++ stmt
@@ -189,14 +201,14 @@ evalCommand (Statement stmt) = do
       RunOk names -> do
         dflags <- getSessionDynFlags
         write $ "Names: " ++ show (map (showPpr dflags) names)  
-        return [Display PlainText printed]
+        return (Success, [Display PlainText printed])
       RunException exception -> do
         write $ "RunException: " ++ show exception
-        return [Display MimeHtml $ makeError $ show exception]
+        return (Failure, [Display MimeHtml $ makeError $ show exception])
       RunBreak{} ->
         error "Should not break."
   where 
-    handler :: SomeException -> Interpreter [DisplayData]
+    handler :: SomeException -> Interpreter (ErrorOccurred, [DisplayData])
     handler exception = do
       write $ concat ["BreakCom: ", show exception, "\nfrom statement:\n", stmt]
 
@@ -204,18 +216,11 @@ evalCommand (Statement stmt) = do
       let (_, _, postStmts) = makeWrapperStmts
       forM_ postStmts $ \s -> runStmt s RunToCompletion
 
-      return [Display MimeHtml $ makeError $ show exception]
+      return (Failure, [Display MimeHtml $ makeError $ show exception])
 
-evalCommand (Declaration decl) = do
-  write $ "Declaration: " ++ decl
-  ghandle handler $ runDecls decl >> return []
-  where 
-    handler :: SomeException -> Interpreter [DisplayData]
-    handler exception = do
-      write $ concat ["BreakDecl: ", show exception, "\nfrom declaration:\n", decl]
-      return [Display MimeHtml $ makeError $ show exception]
+evalCommand (Declaration decl) = wrapExecution $ runDecls decl >> return []
 
-evalCommand (ParseError line col err) =
+evalCommand (ParseError line col err) = wrapExecution $
   return [Display MimeHtml $ makeError $ printf "Error (line %d, column %d): %s" line col err]
 
 capturedStatement :: String -> Interpreter (String, RunResult)
@@ -249,4 +254,5 @@ parseStmts code =
     returnStmt = "return ()"
 
 makeError :: String -> String
-makeError = printf "<span style='color: red; font-style: italic;'>%s</span>" . replace "\n" "<br/>"
+makeError = printf "<span style='color: red; font-style: italic;'>%s</span>" . replace "\n" "<br/>" . replace useDashV ""
+  where useDashV = "\nUse -v to see a list of the files searched for."