diff --git a/.gitignore b/.gitignore index 1ec8b108..0c46a2cc 100644 --- a/.gitignore +++ b/.gitignore @@ -22,3 +22,5 @@ cabal.sandbox.config .tmp1 .tmp2 .tmp3 +.stack-work +ghc-parser/* \ No newline at end of file diff --git a/ghc-parser/src-7.6/Language/Haskell/GHC/HappyParser.hs b/ghc-parser/src-7.6/Language/Haskell/GHC/HappyParser.hs index d53a1ad6..d88c6ed3 100644 --- a/ghc-parser/src-7.6/Language/Haskell/GHC/HappyParser.hs +++ b/ghc-parser/src-7.6/Language/Haskell/GHC/HappyParser.hs @@ -26668,7 +26668,7 @@ hintMultiWayIf span = do {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "" #-} {-# LINE 16 "" #-} -{-# LINE 1 "/Users/silver/.stack/programs/x86_64-osx/ghc-7.10.2/lib/ghc-7.10.2/include/ghcversion.h" #-} +{-# LINE 1 "/Users/tomm/.stack/programs/x86_64-osx/ghc-7.10.2/lib/ghc-7.10.2/include/ghcversion.h" #-} diff --git a/ghc-parser/src-7.8.2/Language/Haskell/GHC/HappyParser.hs b/ghc-parser/src-7.8.2/Language/Haskell/GHC/HappyParser.hs index 1d8ac0ad..1facf738 100644 --- a/ghc-parser/src-7.8.2/Language/Haskell/GHC/HappyParser.hs +++ b/ghc-parser/src-7.8.2/Language/Haskell/GHC/HappyParser.hs @@ -29392,7 +29392,7 @@ hintExplicitForall span = do {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "" #-} {-# LINE 16 "" #-} -{-# LINE 1 "/Users/silver/.stack/programs/x86_64-osx/ghc-7.10.2/lib/ghc-7.10.2/include/ghcversion.h" #-} +{-# LINE 1 "/Users/tomm/.stack/programs/x86_64-osx/ghc-7.10.2/lib/ghc-7.10.2/include/ghcversion.h" #-} diff --git a/ghc-parser/src-7.8.3/Language/Haskell/GHC/HappyParser.hs b/ghc-parser/src-7.8.3/Language/Haskell/GHC/HappyParser.hs index 78a9fa0e..17084cb7 100644 --- a/ghc-parser/src-7.8.3/Language/Haskell/GHC/HappyParser.hs +++ b/ghc-parser/src-7.8.3/Language/Haskell/GHC/HappyParser.hs @@ -29392,7 +29392,7 @@ hintExplicitForall span = do {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "" #-} {-# LINE 16 "" #-} -{-# LINE 1 "/Users/silver/.stack/programs/x86_64-osx/ghc-7.10.2/lib/ghc-7.10.2/include/ghcversion.h" #-} +{-# LINE 1 "/Users/tomm/.stack/programs/x86_64-osx/ghc-7.10.2/lib/ghc-7.10.2/include/ghcversion.h" #-} diff --git a/ipython-kernel/ipython-kernel.cabal b/ipython-kernel/ipython-kernel.cabal index 1674a22d..5d4adb15 100644 --- a/ipython-kernel/ipython-kernel.cabal +++ b/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 diff --git a/ipython-kernel/src/IHaskell/IPython/Message/Parser.hs b/ipython-kernel/src/IHaskell/IPython/Message/Parser.hs index 3d35943a..95851861 100644 --- a/ipython-kernel/src/IHaskell/IPython/Message/Parser.hs +++ b/ipython-kernel/src/IHaskell/IPython/Message/Parser.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} -- | Description : Parsing messages received from IPython -- @@ -7,13 +7,16 @@ -- 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.Map (Map) -import Data.Text (Text) +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 (catMaybes, fromMaybe) +import Data.Text (Text, unpack, concat) +import Debug.Trace import IHaskell.IPython.Types type LByteString = Lazy.ByteString @@ -72,7 +75,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 +89,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 +101,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 +134,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 +191,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" diff --git a/ipython-kernel/src/IHaskell/IPython/Message/Writer.hs b/ipython-kernel/src/IHaskell/IPython/Message/Writer.hs index 4f3fa4d0..ea0f7168 100644 --- a/ipython-kernel/src/IHaskell/IPython/Message/Writer.hs +++ b/ipython-kernel/src/IHaskell/IPython/Message/Writer.hs @@ -7,11 +7,11 @@ module IHaskell.IPython.Message.Writer (ToJSON(..)) where import Data.Aeson import Data.Map (Map) -import Data.Text (Text, pack) import Data.Monoid (mempty) +import Data.Text (Text, pack) -import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L import Data.Text.Encoding import IHaskell.IPython.Types @@ -34,6 +34,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 diff --git a/ipython-kernel/src/IHaskell/IPython/Types.hs b/ipython-kernel/src/IHaskell/IPython/Types.hs index 175ac20c..65eae648 100644 --- a/ipython-kernel/src/IHaskell/IPython/Types.hs +++ b/ipython-kernel/src/IHaskell/IPython/Types.hs @@ -34,19 +34,19 @@ module IHaskell.IPython.Types ( extractPlain, ) where -import Data.Aeson import Control.Applicative ((<$>), (<*>)) +import Data.Aeson import Data.ByteString (ByteString) -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 Data.Serialize +import qualified Data.String as S +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import Data.Typeable +import GHC.Generics (Generic) +import IHaskell.IPython.Message.UUID ------------------ IPython Kernel Profile Types ---------------------- -- @@ -116,7 +116,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 +169,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 +198,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 +228,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 +252,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 +278,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 +304,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 +350,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 @@ -414,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" @@ -425,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 @@ -489,3 +549,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, "")] diff --git a/ipython-kernel/stack.yaml b/ipython-kernel/stack.yaml new file mode 100644 index 00000000..f855a265 --- /dev/null +++ b/ipython-kernel/stack.yaml @@ -0,0 +1,7 @@ +flags: + ipython-kernel: + examples: false +packages: +- '.' +extra-deps: [] +resolver: lts-2.19