Merge pull request #572 from thomasjm/master

New message types for ipython-kernel

.gitignore

@@ -22,3 +22,4 @@ cabal.sandbox.config
 .tmp1
 .tmp2
 .tmp3
+.stack-work
\ No newline at end of file

ihaskell-display/ihaskell-diagrams/IHaskell/Display/Diagrams.hs

@@ -2,13 +2,11 @@
 
 module IHaskell.Display.Diagrams (diagram, animation) where
 
-import           System.Directory
 import qualified Data.ByteString.Char8 as Char
+import           System.Directory
 import           System.IO.Unsafe
-
-import           Diagrams.Prelude
 import           Diagrams.Backend.Cairo
-
+import           Diagrams.Prelude
 import           IHaskell.Display
 import           IHaskell.Display.Diagrams.Animation
 

ipython-kernel/ipython-kernel.cabal

@@ -46,6 +46,7 @@ library
                        mtl             >=2.1,
                        text            >=0.11,
                        transformers    >=0.3,
+                       unordered-containers >= 0.2.5,
                        uuid            >=1.3,
                        zeromq4-haskell >=0.1,
                        SHA             >=1.6

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

-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-name-shadowing #-}
 
 -- | Description : Parsing messages received from IPython
 --
@@ -7,13 +8,17 @@
 -- the low-level 0MQ interface.
 module IHaskell.IPython.Message.Parser (parseMessage) where
 
-import           Data.Aeson ((.:), (.:?), (.!=), decode, Result(..), Object)
 import           Control.Applicative ((<|>), (<$>), (<*>))
-import           Data.Aeson.Types (parse)
-import           Data.ByteString
+import           Data.Aeson ((.:), (.:?), (.!=), decode, Result(..), Object, Value(..))
+import           Data.Aeson.Types (parse, parseEither)
+import           Data.ByteString hiding (unpack)
+import qualified Data.ByteString.Lazy as Lazy
+import           Data.HashMap.Strict as HM
 import           Data.Map (Map)
+import           Data.Maybe (fromMaybe)
 import           Data.Text (Text)
-import qualified Data.ByteString.Lazy as Lazy
+import           Data.Text (Text, unpack)
+import           Debug.Trace
 import           IHaskell.IPython.Types
 
 type LByteString = Lazy.ByteString
@@ -72,7 +77,12 @@ parser :: MessageType            -- ^ The message type being parsed.
        -> LByteString -> Message -- ^ The parser that converts the body into a message. This message
                                  -- should have an undefined header.
 parser KernelInfoRequestMessage = kernelInfoRequestParser
+parser ExecuteInputMessage = executeInputParser
 parser ExecuteRequestMessage = executeRequestParser
+parser ExecuteReplyMessage = executeReplyParser
+parser ExecuteErrorMessage = executeErrorParser
+parser ExecuteResultMessage = executeResultParser
+parser DisplayDataMessage = displayDataParser
 parser CompleteRequestMessage = completeRequestParser
 parser InspectRequestMessage = inspectRequestParser
 parser ShutdownRequestMessage = shutdownRequestParser
@@ -81,6 +91,11 @@ parser CommOpenMessage = commOpenParser
 parser CommDataMessage = commDataParser
 parser CommCloseMessage = commCloseParser
 parser HistoryRequestMessage = historyRequestParser
+parser StatusMessage = statusMessageParser
+parser StreamMessage = streamMessageParser
+parser InputMessage = inputMessageParser
+parser OutputMessage = outputMessageParser
+parser ClearOutputMessage = clearOutputMessageParser
 parser other = error $ "Unknown message type " ++ show other
 
 -- | Parse a kernel info request. A kernel info request has no auxiliary information, so ignore the
@@ -88,6 +103,13 @@ parser other = error $ "Unknown message type " ++ show other
 kernelInfoRequestParser :: LByteString -> Message
 kernelInfoRequestParser _ = KernelInfoRequest { header = noHeader }
 
+-- | Parse an execute_input response. Fields used are:
+executeInputParser :: LByteString -> Message
+executeInputParser = requestParser $ \obj -> do
+  code <- obj .: "code"
+  executionCount <- obj .: "execution_count"
+  return $ ExecuteInput noHeader code executionCount
+
 -- | Parse an execute request. Fields used are:
 --  1. "code": the code to execute.
 --  2. "silent": whether to execute silently.
@@ -114,9 +136,47 @@ executeRequestParser content =
     , getUserExpressions = []
     }
 
-requestParser parser content = parsed
+-- | Parse an execute reply
+executeReplyParser :: LByteString -> Message
+executeReplyParser = requestParser $ \obj -> do
+  status <- obj .: "status"
+  executionCount <- obj .: "execution_count"
+  return $ ExecuteReply noHeader status [] executionCount
+
+-- | Parse an execute reply
+executeErrorParser :: LByteString -> Message
+executeErrorParser = requestParser $ \obj -> do
+  -- executionCount <- obj .: "execution_count"
+  traceback <- obj .: "traceback"
+  ename <- obj .: "ename"
+  evalue <- obj .: "evalue"
+  return $ ExecuteError noHeader [] traceback ename evalue
+
+makeDisplayDatas :: Object -> [DisplayData]
+makeDisplayDatas dataDict = [DisplayData (read $ unpack mimeType) content |
+                             (mimeType, String content) <- HM.toList dataDict]
+
+-- | Parse an execute result
+executeResultParser :: LByteString -> Message
+executeResultParser = requestParser $ \obj -> do
+  executionCount <- obj .: "execution_count"
+  dataDict :: Object <- obj .: "data"
+  let displayDatas = makeDisplayDatas dataDict
+  metadataDict <- obj .: "metadata"
+  return $ ExecuteResult noHeader displayDatas metadataDict executionCount
+
+-- | Parse a display data message
+displayDataParser :: LByteString -> Message
+displayDataParser = requestParser $ \obj -> do
+  dataDict :: Object <- obj .: "data"
+  let displayDatas = makeDisplayDatas dataDict
+  maybeSource <- obj .:? "source"
+  return $ PublishDisplayData noHeader (fromMaybe "" maybeSource) displayDatas
+
+requestParser parser content = case parseEither parser decoded of
+  Right parsed -> parsed
+  Left err -> trace ("Parse error: " ++ show err) SendNothing
   where
-    Success parsed = parse parser decoded
     Just decoded = decode content
 
 historyRequestParser :: LByteString -> Message
@@ -133,6 +193,43 @@ historyRequestParser = requestParser $ \obj ->
           "search" -> HistorySearch
           str      -> error $ "Unknown history access type: " ++ str
 
+statusMessageParser :: LByteString -> Message
+statusMessageParser = requestParser $ \obj -> do
+  execution_state <- obj .: "execution_state"
+  return $ PublishStatus noHeader execution_state
+
+streamMessageParser :: LByteString -> Message
+streamMessageParser = requestParser $ \obj -> do
+  streamType <- obj .: "name"
+  streamContent <- obj .: "text"
+  return $ PublishStream noHeader streamType streamContent
+
+inputMessageParser :: LByteString -> Message
+inputMessageParser = requestParser $ \obj -> do
+  code <- obj .: "code"
+  executionCount <- obj .: "execution_count"
+  return $ Input noHeader code executionCount
+
+getDisplayDatas Nothing = []
+getDisplayDatas (Just dataDict) = makeDisplayDatas dataDict
+
+outputMessageParser :: LByteString -> Message
+outputMessageParser = requestParser $ \obj -> do
+  -- Handle both "data" and "text" keys
+  maybeDataDict1 :: Maybe Object <- obj .:? "data"
+  let displayDatas1 = getDisplayDatas maybeDataDict1
+
+  maybeDataDict2 :: Maybe Object <- obj .:? "text"
+  let displayDatas2 = getDisplayDatas maybeDataDict2
+
+  executionCount <- obj .: "execution_count"
+  return $ Output noHeader (displayDatas1 ++ displayDatas2) executionCount
+
+clearOutputMessageParser :: LByteString -> Message
+clearOutputMessageParser = requestParser $ \obj -> do
+  wait <- obj .: "wait"
+  return $ ClearOutput noHeader wait
+
 completeRequestParser :: LByteString -> Message
 completeRequestParser = requestParser $ \obj -> do
   code <- obj .: "code"

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

@@ -4,9 +4,8 @@
 module IHaskell.IPython.Message.UUID (UUID, random, randoms, uuidToString) where
 
 import           Control.Monad (mzero, replicateM)
-import           Control.Applicative ((<$>))
-import           Data.Text (pack)
 import           Data.Aeson
+import           Data.Text (pack)
 import           Data.UUID.V4 (nextRandom)
 
 -- | A UUID (universally unique identifier).

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

 {-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-name-shadowing -fno-warn-unused-matches #-}
 
 -- | Description : @ToJSON@ for Messages
 --
@@ -8,12 +9,6 @@ module IHaskell.IPython.Message.Writer (ToJSON(..)) where
 import           Data.Aeson
 import           Data.Map (Map)
 import           Data.Text (Text, pack)
-import           Data.Monoid (mempty)
-
-import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString as B
-import           Data.Text.Encoding
-
 import           IHaskell.IPython.Types
 
 instance ToJSON LanguageInfo where
@@ -34,6 +29,15 @@ instance ToJSON Message where
       , "language_info" .= languageInfo rep
       ]
 
+  toJSON ExecuteRequest { getCode = code, getSilent = silent, getStoreHistory = storeHistory,
+                          getAllowStdin = allowStdin, getUserVariables = userVariables,
+                          getUserExpressions = userExpressions
+                        } =
+    object ["code" .= code, "silent" .= silent, "store_history" .= storeHistory,
+            "allow_stdin" .= allowStdin, "user_variables" .= userVariables,
+            "user_expressions" .= userExpressions
+           ]
+
   toJSON ExecuteReply { status = status, executionCounter = counter, pagerOutput = pager } =
     object
       [ "status" .= show status

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

 {-# LANGUAGE OverloadedStrings, DeriveDataTypeable, DeriveGeneric #-}
+{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-name-shadowing -fno-warn-unused-matches #-}
 
 -- | This module contains all types used to create an IPython language kernel.
 module IHaskell.IPython.Types (
@@ -35,18 +36,16 @@ module IHaskell.IPython.Types (
     ) where
 
 import           Data.Aeson
-import           Control.Applicative ((<$>), (<*>))
 import           Data.ByteString (ByteString)
+import           Data.List (find)
+import           Data.Map (Map)
+import           Data.Serialize
+import           Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
-import           Data.Text (Text)
-import qualified Data.String as S
-import           Data.Serialize
-import           IHaskell.IPython.Message.UUID
-import           GHC.Generics (Generic)
 import           Data.Typeable
-import           Data.List (find)
-import           Data.Map (Map)
+import           GHC.Generics (Generic)
+import           IHaskell.IPython.Message.UUID
 
 ------------------ IPython Kernel Profile Types ----------------------
 --
@@ -116,7 +115,7 @@ instance ToJSON Transport where
 -------------------- IPython Kernelspec Types ----------------------
 data KernelSpec =
        KernelSpec
-         { 
+         {
          -- | Name shown to users to describe this kernel (e.g. "Haskell")
          kernelDisplayName :: String
          -- | Name for the kernel; unique kernel identifier (e.g. "haskell")
@@ -169,8 +168,11 @@ type Metadata = Map Text Text
 -- | The type of a message, corresponding to IPython message types.
 data MessageType = KernelInfoReplyMessage
                  | KernelInfoRequestMessage
+                 | ExecuteInputMessage
                  | ExecuteReplyMessage
+                 | ExecuteErrorMessage
                  | ExecuteRequestMessage
+                 | ExecuteResultMessage
                  | StatusMessage
                  | StreamMessage
                  | DisplayDataMessage
@@ -195,8 +197,11 @@ data MessageType = KernelInfoReplyMessage
 showMessageType :: MessageType -> String
 showMessageType KernelInfoReplyMessage = "kernel_info_reply"
 showMessageType KernelInfoRequestMessage = "kernel_info_request"
+showMessageType ExecuteInputMessage = "execute_input"
 showMessageType ExecuteReplyMessage = "execute_reply"
+showMessageType ExecuteErrorMessage = "error"
 showMessageType ExecuteRequestMessage = "execute_request"
+showMessageType ExecuteResultMessage = "execute_result"
 showMessageType StatusMessage = "status"
 showMessageType StreamMessage = "stream"
 showMessageType DisplayDataMessage = "display_data"
@@ -222,8 +227,11 @@ instance FromJSON MessageType where
     case s of
       "kernel_info_reply"   -> return KernelInfoReplyMessage
       "kernel_info_request" -> return KernelInfoRequestMessage
+      "execute_input"       -> return ExecuteInputMessage
       "execute_reply"       -> return ExecuteReplyMessage
+      "error"               -> return ExecuteErrorMessage
       "execute_request"     -> return ExecuteRequestMessage
+      "execute_result"      -> return ExecuteResultMessage
       "status"              -> return StatusMessage
       "stream"              -> return StreamMessage
       "display_data"        -> return DisplayDataMessage
@@ -243,6 +251,7 @@ instance FromJSON MessageType where
       "comm_close"          -> return CommCloseMessage
       "history_request"     -> return HistoryRequestMessage
       "history_reply"       -> return HistoryReplyMessage
+      "status_message"      -> return StatusMessage
 
       _                     -> fail ("Unknown message type: " ++ show s)
   parseJSON _ = fail "Must be a string."
@@ -268,6 +277,13 @@ data Message =
                  , implementationVersion :: String -- ^ The version of the implementation
                  , languageInfo :: LanguageInfo
                  }
+             |
+               -- | A request from a frontend to execute some code.
+               ExecuteInput
+                 { header :: MessageHeader
+                 , getCode :: Text         -- ^ The code string.
+                 , executionCounter :: Int -- ^ The execution count, i.e. which output this is.
+                 }
              |
              -- | A request from a frontend to execute some code.
                ExecuteRequest
@@ -287,6 +303,23 @@ data Message =
                  , pagerOutput :: [DisplayData]          -- ^ The mimebundles to display in the pager.
                  , executionCounter :: Int               -- ^ The execution count, i.e. which output this is.
                  }
+             |
+             -- | A reply to an execute request.
+               ExecuteResult
+                 { header :: MessageHeader
+                 , dataResult :: [DisplayData]           -- ^ Key/value pairs (keys are MIME types)
+                 , metadataResult :: Map String String   -- ^ Any metadata that describes the data
+                 , executionCounter :: Int               -- ^ The execution count, i.e. which output this is.
+                 }
+             |
+             -- | An error reply to an execute request
+               ExecuteError
+                 { header :: MessageHeader
+                 , pagerOutput :: [DisplayData]          -- ^ The mimebundles to display in the pager.
+                 , traceback :: [Text]
+                 , ename :: Text
+                 , evalue :: Text
+                 }
              |
                PublishStatus
                  { header :: MessageHeader
@@ -316,8 +349,17 @@ data Message =
                  , inCode :: String                      -- ^ Submitted input code.
                  , executionCount :: Int                 -- ^ Which input this is.
                  }
-             |
-               CompleteRequest
+             | Input
+                 { header :: MessageHeader
+                 , getCode :: Text
+                 , executionCount :: Int
+                 }
+             | Output
+                 { header :: MessageHeader
+                 , getText :: [DisplayData]
+                 , executionCount :: Int
+                 }
+             | CompleteRequest
                  { header :: MessageHeader
                  , getCode :: Text  {- ^
             The entire block of text where the line is. This may be useful in the
@@ -415,6 +457,11 @@ data ExecuteReplyStatus = Ok
                         | Err
                         | Abort
 
+instance FromJSON ExecuteReplyStatus where
+  parseJSON (String "ok") = return Ok
+  parseJSON (String "error") = return Err
+  parseJSON (String "abort") = return Abort
+
 instance Show ExecuteReplyStatus where
   show Ok = "ok"
   show Err = "error"
@@ -426,11 +473,23 @@ data ExecutionState = Busy
                     | Starting
   deriving Show
 
+instance FromJSON ExecutionState where
+  parseJSON (String "busy") = return Busy
+  parseJSON (String "idle") = return Idle
+  parseJSON (String "starting") = return Starting
+
 -- | Input and output streams.
 data StreamType = Stdin
                 | Stdout
+                | Stderr
   deriving Show
 
+instance FromJSON StreamType where
+  parseJSON (String "stdin") = return Stdin
+  parseJSON (String "stdout") = return Stdout
+  parseJSON (String "stderr") = return Stderr
+
+
 -- | Get the reply message type for a request message type.
 replyType :: MessageType -> Maybe MessageType
 replyType KernelInfoRequestMessage = Just KernelInfoReplyMessage
@@ -491,3 +550,12 @@ instance Show MimeType where
   show MimeSvg = "image/svg+xml"
   show MimeLatex = "text/latex"
   show MimeJavascript = "application/javascript"
+
+instance Read MimeType where
+  readsPrec _ "text/plain" = [(PlainText, "")]
+  readsPrec _ "text/html" = [(MimeHtml, "")]
+  readsPrec _ "image/png" = [(MimePng 50 50, "")]
+  readsPrec _ "image/jpg" = [(MimeJpg 50 50, "")]
+  readsPrec _ "image/svg+xml" = [(MimeSvg, "")]
+  readsPrec _ "text/latex" = [(MimeLatex, "")]
+  readsPrec _ "application/javascript" = [(MimeJavascript, "")]

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

@@ -18,9 +18,9 @@ import           Control.Concurrent
 import           Control.Exception
 import           Control.Monad
 import           Data.Aeson
-import qualified Data.ByteString.Lazy as LBS
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as Char
+import qualified Data.ByteString.Lazy as LBS
 import           Data.Char
 import           Data.Digest.Pure.SHA as SHA
 import           Data.Monoid ((<>))
@@ -28,16 +28,16 @@ import qualified Data.Text.Encoding as Text
 import           System.ZMQ4 as ZMQ4 hiding (stdin)
 import           Text.Read (readMaybe)
 
-import           IHaskell.IPython.Types
 import           IHaskell.IPython.Message.Parser
-import           IHaskell.IPython.Message.Writer
+import           IHaskell.IPython.Message.Writer ()
+import           IHaskell.IPython.Types
 
 -- | The channel interface to the ZeroMQ sockets. All communication is done via Messages, which are
 -- encoded and decoded into a lower level form before being transmitted to IPython. These channels
 -- should functionally serve as high-level sockets which speak Messages instead of ByteStrings.
 data ZeroMQInterface =
        Channels
-         { 
+         {
          -- | A channel populated with requests from the frontend.
          shellRequestChannel :: Chan Message
          -- | Writing to this channel causes a reply to be sent to the frontend.