Capture intermediate results and display them

Hspec.hs

@@ -29,7 +29,7 @@ is string blockType = do
 
 eval string = do
   outputAccum <- newIORef []
-  let publish displayDatas = liftIO $ modifyIORef outputAccum (displayDatas :)
+  let publish _ displayDatas = modifyIORef outputAccum (displayDatas :)
   getTemporaryDirectory >>= setCurrentDirectory
   interpret $ evaluate 1 string publish
   out <- readIORef outputAccum

IHaskell.cabal

@@ -56,6 +56,7 @@ extra-source-files:
 
 library
   build-depends:       base ==4.6.*,
+                       unix >= 2.6,
                        hspec,
                        zeromq3-haskell ==0.5.*,
                        aeson ==0.6.*,
@@ -113,6 +114,7 @@ executable IHaskell
   
   -- Other library packages from which modules are imported.
   build-depends:       base ==4.6.*,
+                       unix >= 2.6,
                        hspec,
                        zeromq3-haskell ==0.5.*,
                        aeson ==0.6.*,
@@ -143,6 +145,7 @@ Test-Suite hspec
   Ghc-Options: -threaded
   Main-Is: Hspec.hs
   build-depends:       base ==4.6.*,
+                       unix >= 2.6,
                        hspec,
                        zeromq3-haskell ==0.5.*,
                        aeson ==0.6.*,

IHaskell/Eval/Completion.hs

@@ -18,7 +18,7 @@
 module IHaskell.Eval.Completion (complete, completionTarget, completionType, CompletionType(..)) where
 
 import Prelude
-import Data.List (find, isPrefixOf, nub, findIndex, intercalate)
+import Data.List (find, isPrefixOf, nub, findIndex, intercalate, elemIndex)
 import GHC
 import GhcMonad
 import PackageConfig
@@ -53,7 +53,7 @@ complete line pos = do
 
   let Just db = pkgDatabase flags
       getNames = map moduleNameString . exposedModules
-      moduleNames = nub $ concat $ map getNames db
+      moduleNames = nub $ concatMap getNames db
 
   let target = completionTarget line pos
       matchedText = intercalate "." target
@@ -97,15 +97,13 @@ getTrueModuleName name = do
 
 completionType :: String -> [String] -> CompletionType
 completionType line [] = Empty
-completionType line target =
-  if startswith "import" (strip line) && isModName
-  then ModuleName dotted candidate
-  else 
-    if isModName && (not . null . init) target
-    then Qualified dotted candidate
-    else Identifier candidate
-  where
-    dotted = dots target
+completionType line target
+  | startswith "import" (strip line) && isModName =
+    ModuleName dotted candidate
+  | isModName && (not . null . init) target =
+    Qualified dotted candidate
+  | otherwise = Identifier candidate
+  where dotted = dots target
         candidate = last target
         dots = intercalate "." . init
         isModName = all isCapitalized (init target)
@@ -132,7 +130,7 @@ completionTarget code cursor = expandCompletionPiece pieceToComplete
     splitAlongCursor :: [[(Char, Int)]] -> [[(Char, Int)]]
     splitAlongCursor [] = []
     splitAlongCursor (x:xs) = 
-      case findIndex (== cursor) $  map snd x of
+      case elemIndex cursor $  map snd x of
         Nothing -> x:splitAlongCursor xs
         Just idx -> take (idx + 1) x:drop (idx + 1) x:splitAlongCursor xs
 

IHaskell/Eval/Info.hs

 {-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
 {- | Description : Inspect type and function information and documentation.
 -}
 module IHaskell.Eval.Info (

IHaskell/Message/Writer.hs

@@ -81,6 +81,10 @@ instance ToJSON Message where
                             "restart" .= restart
                            ]
 
+  toJSON ClearOutput{wait = wait} = object [
+                            "wait" .= wait
+                           ]
+
 
   toJSON body = error $ "Do not know how to convert to JSON for message " ++ show body
 

IHaskell/Types.hs

@@ -108,6 +108,7 @@ data MessageType = KernelInfoReplyMessage
                  | ObjectInfoReplyMessage
                  | ShutdownRequestMessage
                  | ShutdownReplyMessage
+                 | ClearOutputMessage
 
 instance Show MessageType where
   show KernelInfoReplyMessage     = "kernel_info_reply"
@@ -125,6 +126,7 @@ instance Show MessageType where
   show ObjectInfoReplyMessage     = "object_info_reply"
   show ShutdownRequestMessage     = "shutdown_request"
   show ShutdownReplyMessage       = "shutdown_reply"
+  show ClearOutputMessage         = "clear_output"
 
 instance FromJSON MessageType where
   parseJSON (String s) = case s of
@@ -143,6 +145,7 @@ instance FromJSON MessageType where
     "object_info_reply"   -> return ObjectInfoReplyMessage
     "shutdown_request"    -> return ShutdownRequestMessage
     "shutdown_reply"      -> return ShutdownReplyMessage
+    "clear_output"        -> return ClearOutputMessage
 
     _                     -> fail ("Unknown message type: " ++ show s)
   parseJSON _ = fail "Must be a string."
@@ -222,22 +225,7 @@ data Message
      completionText :: ByteString,
      completionStatus :: Bool
   }
-      {- ^
-# The list of all matches to the completion request, such as
-# ['a.isalnum', 'a.isalpha'] for the above example.
-'matches' : list,
-
-# the substring of the matched text
-# this is typically the common prefix of the matches,
-# and the text that is already in the block that would be replaced by the full completion.
-# This would be 'a.is' in the above example.
-'text' : str,
-
-# status should be 'ok' unless an exception was raised during the request,
-# in which case it should be 'error', along with the usual error message content
-# in other messages.
-'status' : 'ok'
-} -}
+
   | ObjectInfoRequest {
       header :: MessageHeader, 
       objectName :: ByteString,  -- ^ Name of object being searched for.
@@ -245,6 +233,7 @@ data Message
                                 -- 0 is equivalent to foo?, 1 is equivalent
                                 -- to foo??.
     }
+
   | ObjectInfoReply {
       header :: MessageHeader, 
       objectName :: ByteString,       -- ^ Name of object which was searched for.
@@ -262,6 +251,11 @@ data Message
       restartPending :: Bool    -- ^ Whether this shutdown precedes a restart.
     }
 
+  | ClearOutput {
+      header :: MessageHeader,
+      wait :: Bool -- ^ Whether to wait to redraw until there is more output.
+  }
+
     deriving Show
 
 -- | Possible statuses in the execution reply messages.

Main.hs

@@ -96,7 +96,7 @@ initialKernelState =
   }
 
 -- | Duplicate a message header, giving it a new UUID and message type.
-dupHeader :: MessageHeader -> MessageType -> Interpreter MessageHeader
+dupHeader :: MessageHeader -> MessageType -> IO MessageHeader
 dupHeader header messageType = do
   uuid <- liftIO UUID.random
 
@@ -145,20 +145,48 @@ replyTo interface ExecuteRequest{ getCode = code } replyHeader state = do
   -- All the headers are copies of the reply header with a different
   -- message type, because this preserves the session ID, parent header,
   -- and other important information.
-  busyHeader <- dupHeader replyHeader StatusMessage
+  busyHeader <- liftIO $ dupHeader replyHeader StatusMessage
   send $ PublishStatus busyHeader Busy
 
   -- Construct a function for publishing output as this is going.
-  let publish :: [DisplayData] -> Interpreter ()
-      publish outputs = do
+  -- This function accepts a boolean indicating whether this is the final
+  -- output and the thing to display. Store the final outputs in a list so
+  -- that when we receive an updated non-final output, we can clear the
+  -- entire output and re-display with the updated output.
+  displayed <- liftIO $ newMVar []
+  updateNeeded <- liftIO $ newMVar False
+  let clearOutput = do
+        header <- dupHeader replyHeader ClearOutputMessage
+        send $ ClearOutput header True
+
+      sendOutput outs = do
         header <- dupHeader replyHeader DisplayDataMessage
-        send $ PublishDisplayData header "haskell" outputs
+        send $ PublishDisplayData header "haskell" outs
+
+      publish :: Bool -> [DisplayData] -> IO ()
+      publish final outputs = do
+        -- If necessary, clear all previous output and redraw.
+        clear <- readMVar updateNeeded
+        when clear $ do
+          clearOutput
+          disps <- readMVar displayed
+          mapM_ sendOutput $ reverse disps
+
+        -- Draw this message.
+        sendOutput outputs
+
+        -- If this is the final message, add it to the list of completed
+        -- messages. If it isn't, make sure we clear it later by marking
+        -- update needed as true.
+        modifyMVar_ updateNeeded (const $ return $ not final)
+        when final $
+          modifyMVar_ displayed (return . (outputs:))
 
   -- Run code and publish to the frontend as we go.
   evaluate execCount (Chars.unpack code) publish
 
   -- Notify the frontend that we're done computing.
-  idleHeader <- dupHeader replyHeader StatusMessage
+  idleHeader <- liftIO $ dupHeader replyHeader StatusMessage
   send $ PublishStatus idleHeader Idle
 
   -- Increment the execution counter in the kernel state.