Fix #597: Implement is_complete_{request,reply}

These messages are used by console frontends to check whether the
current input is complete or not. If it is not complete, the next line
is treated as the continuation of the code, and a '...' prompt is used
to show that.

To provide support for qtconsole, I have made it such that IHaskell
always responds to an is_complete_request by saying that the code is
complete, which only allows for single line inputs.

ipython-kernel/src/IHaskell/IPython/Message/Parser.hs

@@ -83,6 +83,7 @@ parser ExecuteReplyMessage = executeReplyParser
 parser ExecuteErrorMessage = executeErrorParser
 parser ExecuteResultMessage = executeResultParser
 parser DisplayDataMessage = displayDataParser
+parser IsCompleteRequestMessage = isCompleteRequestParser
 parser CompleteRequestMessage = completeRequestParser
 parser InspectRequestMessage = inspectRequestParser
 parser ShutdownRequestMessage = shutdownRequestParser
@@ -231,6 +232,11 @@ clearOutputMessageParser = requestParser $ \obj -> do
   wait <- obj .: "wait"
   return $ ClearOutput noHeader wait
 
+isCompleteRequestParser :: LByteString -> Message
+isCompleteRequestParser = requestParser $ \obj -> do
+  code <- obj .: "code"
+  return $ IsCompleteRequest noHeader code
+
 completeRequestParser :: LByteString -> Message
 completeRequestParser = requestParser $ \obj -> do
   code <- obj .: "code"

ipython-kernel/src/IHaskell/IPython/Message/Writer.hs

@@ -7,6 +7,7 @@
 module IHaskell.IPython.Message.Writer (ToJSON(..)) where
 
 import           Data.Aeson
+import           Data.Aeson.Types (Pair)
 import           Data.Map (Map)
 import           Data.Monoid (mempty)
 import           Data.Text (Text, pack)
@@ -130,6 +131,18 @@ instance ToJSON Message where
                                                                      Left inp         -> toJSON inp
                                                                      Right (inp, out) -> toJSON out)
 
+  toJSON req@IsCompleteReply{} =
+    object pairs
+    where
+      pairs =
+        case reviewResult req of
+          CodeComplete       -> status "complete"
+          CodeIncomplete ind -> status "incomplete" ++ indent ind
+          CodeInvalid        -> status "invalid"
+          CodeUnknown        -> status "unknown"
+      status x = ["status" .= pack x]
+      indent x = ["indent" .= pack x]
+
   toJSON body = error $ "Do not know how to convert to JSON for message " ++ show body
 
 -- | Print an execution state as "busy", "idle", or "starting".

ipython-kernel/src/IHaskell/IPython/Types.hs

@@ -18,6 +18,7 @@ module IHaskell.IPython.Types (
     Username(..),
     Metadata(..),
     MessageType(..),
+    CodeReview(..),
     Width(..),
     Height(..),
     StreamType(..),
@@ -179,6 +180,8 @@ data MessageType = KernelInfoReplyMessage
                  | DisplayDataMessage
                  | OutputMessage
                  | InputMessage
+                 | IsCompleteRequestMessage
+                 | IsCompleteReplyMessage
                  | CompleteRequestMessage
                  | CompleteReplyMessage
                  | InspectRequestMessage
@@ -208,6 +211,8 @@ showMessageType StreamMessage = "stream"
 showMessageType DisplayDataMessage = "display_data"
 showMessageType OutputMessage = "pyout"
 showMessageType InputMessage = "pyin"
+showMessageType IsCompleteRequestMessage = "is_complete_request"
+showMessageType IsCompleteReplyMessage = "is_complete_reply"
 showMessageType CompleteRequestMessage = "complete_request"
 showMessageType CompleteReplyMessage = "complete_reply"
 showMessageType InspectRequestMessage = "inspect_request"
@@ -238,6 +243,8 @@ instance FromJSON MessageType where
       "display_data"        -> return DisplayDataMessage
       "pyout"               -> return OutputMessage
       "pyin"                -> return InputMessage
+      "is_complete_request" -> return IsCompleteRequestMessage
+      "is_complete_reply"   -> return IsCompleteReplyMessage
       "complete_request"    -> return CompleteRequestMessage
       "complete_reply"      -> return CompleteReplyMessage
       "inspect_request"     -> return InspectRequestMessage
@@ -266,6 +273,12 @@ data LanguageInfo =
          }
   deriving (Show, Eq)
 
+data CodeReview = CodeComplete
+                | CodeIncomplete String -- ^ String to be used to indent next line of input
+                | CodeInvalid
+                | CodeUnknown
+  deriving Show
+
 -- | A message used to communicate with the IPython frontend.
 data Message =
              -- | A request from a frontend for information about the kernel.
@@ -352,6 +365,16 @@ data Message =
                  }
              | Input { header :: MessageHeader, getCode :: Text, executionCount :: Int }
              | Output { header :: MessageHeader, getText :: [DisplayData], executionCount :: Int }
+             |
+               IsCompleteRequest
+                 { header :: MessageHeader
+                 , inputToReview :: String               -- ^ The code entered in the repl.
+                 }
+             |
+               IsCompleteReply
+                 { header :: MessageHeader
+                 , reviewResult :: CodeReview            -- ^ The result of reviewing the code.
+                 }
              |
                CompleteRequest
                  { header :: MessageHeader
@@ -487,6 +510,7 @@ instance FromJSON StreamType where
 replyType :: MessageType -> Maybe MessageType
 replyType KernelInfoRequestMessage = Just KernelInfoReplyMessage
 replyType ExecuteRequestMessage = Just ExecuteReplyMessage
+replyType IsCompleteRequestMessage = Just IsCompleteReplyMessage
 replyType CompleteRequestMessage = Just CompleteReplyMessage
 replyType InspectRequestMessage = Just InspectReplyMessage
 replyType ShutdownRequestMessage = Just ShutdownReplyMessage

main/Main.hs

@@ -306,6 +306,11 @@ replyTo interface req@ExecuteRequest { getCode = code } replyHeader state = do
                      , status = Ok
                      })
 
+-- Always assume that the code is complete, which allows for only
+-- single line inputs for now.
+replyTo _ IsCompleteRequest{} replyHeader state = do
+  let reply = IsCompleteReply { header = replyHeader, reviewResult = CodeComplete }
+  return (state, reply)
 
 replyTo _ req@CompleteRequest{} replyHeader state = do
   let code = getCode req