Changed output publishing to be incremental.

Haskell-Notebook.ipynb

@@ -27,8 +27,15 @@
      "outputs": [
       {
        "metadata": {},
-       "output_type": "pyout",
-       "prompt_number": 1,
+       "output_type": "display_data"
+      },
+      {
+       "metadata": {},
+       "output_type": "display_data"
+      },
+      {
+       "metadata": {},
+       "output_type": "display_data",
        "text": [
         "X 20\n",
         "Y \"Test\"\n",
@@ -55,10 +62,19 @@
      "outputs": [
       {
        "metadata": {},
-       "output_type": "pyout",
-       "prompt_number": 2,
+       "output_type": "display_data"
+      },
+      {
+       "metadata": {},
+       "output_type": "display_data",
+       "text": [
+        "1\n"
+       ]
+      },
+      {
+       "metadata": {},
+       "output_type": "display_data",
        "text": [
-        "1\n",
         "Just 13\n"
        ]
       },
@@ -83,8 +99,11 @@
      "outputs": [
       {
        "metadata": {},
-       "output_type": "pyout",
-       "prompt_number": 3,
+       "output_type": "display_data"
+      },
+      {
+       "metadata": {},
+       "output_type": "display_data",
        "text": [
         "1\n",
         "4\n",
@@ -152,9 +171,7 @@
      "outputs": [
       {
        "metadata": {},
-       "output_type": "pyout",
-       "prompt_number": 6,
-       "text": []
+       "output_type": "display_data"
       },
       {
        "metadata": {},
@@ -175,9 +192,7 @@
      "outputs": [
       {
        "metadata": {},
-       "output_type": "pyout",
-       "prompt_number": 7,
-       "text": []
+       "output_type": "display_data"
       },
       {
        "metadata": {},
@@ -197,8 +212,7 @@
      "outputs": [
       {
        "metadata": {},
-       "output_type": "pyout",
-       "prompt_number": 8,
+       "output_type": "display_data",
        "text": [
         "3\n"
        ]
@@ -240,8 +254,7 @@
      "outputs": [
       {
        "metadata": {},
-       "output_type": "pyout",
-       "prompt_number": 10,
+       "output_type": "display_data",
        "text": [
         "2\n"
        ]
@@ -264,9 +277,7 @@
      "outputs": [
       {
        "metadata": {},
-       "output_type": "pyout",
-       "prompt_number": 11,
-       "text": []
+       "output_type": "display_data"
       },
       {
        "metadata": {},
@@ -286,8 +297,7 @@
      "outputs": [
       {
        "metadata": {},
-       "output_type": "pyout",
-       "prompt_number": 12,
+       "output_type": "display_data",
        "text": [
         "Y 3\n"
        ]
@@ -310,9 +320,7 @@
      "outputs": [
       {
        "metadata": {},
-       "output_type": "pyout",
-       "prompt_number": 13,
-       "text": []
+       "output_type": "display_data"
       },
       {
        "metadata": {},
@@ -332,13 +340,13 @@
      "outputs": [
       {
        "html": [
-        "<span style='color: red; font-style: italic;'>Not in scope: `test'<br/></span>"
+        "<span style='color: red; font-style: italic;'><interactive>:1:1-12: Non-exhaustive patterns in function test<br/></span>"
        ],
        "metadata": {},
        "output_type": "display_data"
       }
      ],
-     "prompt_number": 2
+     "prompt_number": 14
     },
     {
      "cell_type": "code",
@@ -350,20 +358,18 @@
      "metadata": {},
      "outputs": [
       {
+       "html": [
+        "<span style='color: red; font-style: italic;'>Parse error (line 1, column 1): Unknown directive: 'tadaf'.</span>"
+       ],
        "metadata": {},
-       "output_type": "pyout",
-       "prompt_number": 1,
-       "text": []
+       "output_type": "display_data"
       },
       {
-       "html": [
-        "<span style='color: red; font-style: italic;'>Error (line 1, column 1): Unknown command: 'tadaf'.</span>"
-       ],
        "metadata": {},
        "output_type": "display_data"
       }
      ],
-     "prompt_number": 1
+     "prompt_number": 15
     },
     {
      "cell_type": "code",
@@ -379,8 +385,11 @@
      "outputs": [
       {
        "metadata": {},
-       "output_type": "pyout",
-       "prompt_number": 1,
+       "output_type": "display_data"
+      },
+      {
+       "metadata": {},
+       "output_type": "display_data",
        "text": [
         "11\n"
        ]
@@ -390,7 +399,7 @@
        "output_type": "display_data"
       }
      ],
-     "prompt_number": "*"
+     "prompt_number": 16
     },
     {
      "cell_type": "code",
@@ -403,16 +412,14 @@
      "outputs": [
       {
        "metadata": {},
-       "output_type": "pyout",
-       "prompt_number": 15,
-       "text": []
+       "output_type": "display_data"
       },
       {
        "metadata": {},
        "output_type": "display_data"
       }
      ],
-     "prompt_number": 15
+     "prompt_number": 17
     },
     {
      "cell_type": "code",
@@ -427,8 +434,7 @@
      "outputs": [
       {
        "metadata": {},
-       "output_type": "pyout",
-       "prompt_number": 25,
+       "output_type": "display_data",
        "text": [
         "21\n"
        ]
@@ -438,7 +444,92 @@
        "output_type": "display_data"
       }
      ],
-     "prompt_number": 25
+     "prompt_number": 18
+    },
+    {
+     "cell_type": "code",
+     "collapsed": false,
+     "input": [
+      "let x = 3\n",
+      "let y =10\n",
+      "let z = 100\n",
+      "print 3"
+     ],
+     "language": "python",
+     "metadata": {},
+     "outputs": [
+      {
+       "metadata": {},
+       "output_type": "display_data"
+      },
+      {
+       "metadata": {},
+       "output_type": "display_data"
+      },
+      {
+       "metadata": {},
+       "output_type": "display_data"
+      },
+      {
+       "metadata": {},
+       "output_type": "display_data",
+       "text": [
+        "3\n"
+       ]
+      },
+      {
+       "metadata": {},
+       "output_type": "display_data"
+      }
+     ],
+     "prompt_number": 19
+    },
+    {
+     "cell_type": "code",
+     "collapsed": false,
+     "input": [
+      "import Control.Monad\n",
+      "import Control.Monad\n",
+      "print 3"
+     ],
+     "language": "python",
+     "metadata": {},
+     "outputs": [
+      {
+       "metadata": {},
+       "output_type": "display_data"
+      },
+      {
+       "metadata": {},
+       "output_type": "display_data"
+      },
+      {
+       "metadata": {},
+       "output_type": "display_data",
+       "text": [
+        "3\n"
+       ]
+      },
+      {
+       "metadata": {},
+       "output_type": "display_data"
+      }
+     ],
+     "prompt_number": 20
+    },
+    {
+     "cell_type": "code",
+     "collapsed": false,
+     "input": [],
+     "language": "python",
+     "metadata": {},
+     "outputs": [
+      {
+       "metadata": {},
+       "output_type": "display_data"
+      }
+     ],
+     "prompt_number": 21
     },
     {
      "cell_type": "code",

IHaskell/Eval/Evaluate.hs

@@ -134,45 +134,31 @@ interpret action = runGhc (Just libdir) $ do
   action
 
 -- | Evaluate some IPython input code.
-evaluate :: Int                       -- ^ The execution counter of this evaluation.
-         -> String                    -- ^ Haskell code or other interpreter commands.
-         -> Interpreter [DisplayData] -- ^ All of the output.
-evaluate execCount code
-  | strip code == "" = return [] 
-  | otherwise = do
-      cmds <- parseString (strip code) 
-      joinDisplays <$> runUntilFailure (cmds ++ [storeItCommand execCount])
+evaluate :: Int                                -- ^ The execution counter of this evaluation.
+         -> String                             -- ^ Haskell code or other interpreter commands.
+         -> ([DisplayData] -> Interpreter ())   -- ^ Function used to publish data outputs.
+         -> Interpreter ()
+evaluate execCount code output = do
+  cmds <- parseString (strip code)
+  runUntilFailure (cmds ++ [storeItCommand execCount])
   where
-    runUntilFailure :: [CodeBlock] -> Interpreter [DisplayData]
-    runUntilFailure [] = return []
+    runUntilFailure :: [CodeBlock] -> Interpreter ()
+    runUntilFailure [] = return ()
     runUntilFailure (cmd:rest) = do 
       (success, result) <- evalCommand cmd
+      output result
       case success of
-        Success -> do
-          restRes <- runUntilFailure rest
-          return $ result ++ restRes
-        Failure -> return result
+        Success -> runUntilFailure rest
+        Failure -> return ()
 
     storeItCommand execCount = Statement $ printf "let it%d = it" execCount
 
-joinDisplays :: [DisplayData] -> [DisplayData]
-joinDisplays displays = 
-  let isPlain (Display mime _) = (mime == PlainText)
-      plains = filter isPlain displays
-      other = filter (not . isPlain) displays 
-      getText (Display PlainText text) = text
-      joinedPlains = Display PlainText $ concatMap getText plains in
-    case length plains of
-      0 -> other
-      _ -> joinedPlains : other
-
-
 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])
+    handler exception = return (Failure, [Display MimeHtml $ formatError $ show exception])
 
 -- | Return the display data for this command, as well as whether it
 -- resulted in an error.
@@ -186,8 +172,9 @@ evalCommand (Import importStr) = wrapExecution $ do
 
 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]
+  flags <- getSessionDynFlags
+  let typeStr = formatGetType $ showSDocUnqual flags $ ppr result
+  return [Display MimeHtml typeStr]
 
 evalCommand (Statement stmt) = do
   write $ "Statement: " ++ stmt
@@ -197,10 +184,11 @@ evalCommand (Statement stmt) = do
       RunOk names -> do
         dflags <- getSessionDynFlags
         write $ "Names: " ++ show (map (showPpr dflags) names)  
-        return (Success, [Display PlainText printed])
+        let output = [Display PlainText printed | not . null $ strip printed]
+        return (Success, output)
       RunException exception -> do
         write $ "RunException: " ++ show exception
-        return (Failure, [Display MimeHtml $ makeError $ show exception])
+        return (Failure, [Display MimeHtml $ formatError $ show exception])
       RunBreak{} ->
         error "Should not break."
   where 
@@ -212,14 +200,14 @@ evalCommand (Statement stmt) = do
       let (_, _, postStmts) = makeWrapperStmts
       forM_ postStmts $ \s -> runStmt s RunToCompletion
 
-      return (Failure, [Display MimeHtml $ makeError $ show exception])
+      return (Failure, [Display MimeHtml $ formatError $ show exception])
 
 evalCommand (Expression expr) = evalCommand (Statement expr)
 
 evalCommand (Declaration decl) = wrapExecution $ runDecls decl >> return []
 
-evalCommand (ParseError (Loc line col) err) = wrapExecution $
-  return [Display MimeHtml $ makeError $ printf "Error (line %d, column %d): %s" line col err]
+evalCommand (ParseError loc err) = wrapExecution $
+  return [Display MimeHtml $ formatParseError loc err]
 
 capturedStatement :: String -> Interpreter (String, RunResult)
 capturedStatement stmt = do
@@ -251,10 +239,17 @@ parseStmts code =
     indent = ("  " ++) 
     returnStmt = "return ()"
 
-makeError :: String -> String
-makeError = printf "<span style='color: red; font-style: italic;'>%s</span>" .
+formatError :: ErrMsg -> String
+formatError = printf "<span style='color: red; font-style: italic;'>%s</span>" .
             replace "\n" "<br/>" . 
             replace useDashV "" .
             typeCleaner
   where 
         useDashV = "\nUse -v to see a list of the files searched for."
+
+formatParseError :: StringLoc -> String -> ErrMsg
+formatParseError (Loc line col) msg = 
+  formatError $ printf "Parse error (line %d, column %d): %s" line col msg
+
+formatGetType :: String -> String
+formatGetType = printf "<span style='font-weight: bold; color: green;'>%s</span>"

IHaskell/Eval/Parser.hs

@@ -6,6 +6,7 @@ module IHaskell.Eval.Parser (
     DirectiveType(..),
     LineNumber,
     ColumnNumber,
+    ErrMsg,
     splitAtLoc,
     layoutChunks,
     parseDirective
@@ -81,6 +82,9 @@ data ParseOutput a
 
 -- $extendedParserTests
 --
+-- >>> test ""
+-- []
+--
 -- >>> test "3\nlet x = expr"
 -- [Expression "3",Statement "let x = expr"]
 --
@@ -291,7 +295,7 @@ joinFunctions [] = []
 -- Directive GetInfo "goodbye"
 --
 -- >>> parseDirective ":nope goodbye" 11
--- ParseError (Loc 11 1) "Unknown command: 'nope'."
+-- ParseError (Loc 11 1) "Unknown directive: 'nope'."
 parseDirective :: String       -- ^ Directive string.
                -> Int          -- ^ Line number at which the directive appears.
                -> CodeBlock    -- ^ Directive code block or a parse error.
@@ -303,7 +307,7 @@ parseDirective (':':directive) line = case find rightDirective directives of
     let directiveStart = case words directive of
           [] -> ""
           first:_ -> first in
-      ParseError (Loc line 1) $ "Unknown command: '" ++ directiveStart ++ "'."
+      ParseError (Loc line 1) $ "Unknown directive: '" ++ directiveStart ++ "'."
   where
     rightDirective (_, dirname) = case words directive of
       [] -> False

Main.hs

@@ -141,8 +141,18 @@ replyTo interface ExecuteRequest{ getCode = code } replyHeader state = do
   busyHeader <- dupHeader replyHeader StatusMessage
   send $ PublishStatus busyHeader Busy
 
+  -- Construct a function for publishing output as this is going.
+  let publish :: [DisplayData] -> Interpreter ()
+      publish outputs = do
+        header <- dupHeader replyHeader DisplayDataMessage
+        send $ PublishDisplayData header "haskell" outputs
+
+  -- Get display data outputs of evaluating the code.
+  evaluate execCount (Chars.unpack code) publish
+
+  {-
   -- Get display data outputs of evaluating the code.
-  outputs <- evaluate execCount $ Chars.unpack code
+  outputs <- evaluate execCount (Chars.unpack code) publish
 
   -- Find all the plain text outputs.
   -- Send plain text output via an output message, because we are just
@@ -157,6 +167,7 @@ replyTo interface ExecuteRequest{ getCode = code } replyHeader state = do
   -- Send all the non-plain-text representations of data to the frontend.
   displayHeader <- dupHeader replyHeader DisplayDataMessage
   send $ PublishDisplayData displayHeader "haskell" $ filter (not . isPlain) outputs
+  -}
 
   -- Notify the frontend that we're done computing.
   idleHeader <- dupHeader replyHeader StatusMessage