mirrors/IHaskell
1
0
Fork 0
mirror of https://github.com/IHaskell/IHaskell.git synced 2025-04-17 20:06:07 +00:00
Code Issues Packages Projects Releases Wiki Activity

Add a bunch of new message types

Browse Source
This commit is contained in:
Tom McLaughlin 2015-09-03 01:08:36 -07:00
parent a394a2b850
commit bd965779af
9 changed files with 208 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

@ -22,3 +22,5 @@ cabal.sandbox.config
.tmp1
.tmp2
.tmp3
.stack-work
ghc-parser/*

2
ghc-parser/src-7.6/Language/Haskell/GHC/HappyParser.hs
View File

@ -26668,7 +26668,7 @@ hintMultiWayIf span = do
{-# LINE 1 "templates/GenericTemplate.hs" #-}
{-# LINE 1 "<built-in>" #-}
{-# LINE 16 "<built-in>" #-}
{-# 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" #-}

2
ghc-parser/src-7.8.2/Language/Haskell/GHC/HappyParser.hs
View File

@ -29392,7 +29392,7 @@ hintExplicitForall span = do
{-# LINE 1 "templates/GenericTemplate.hs" #-}
{-# LINE 1 "<built-in>" #-}
{-# LINE 16 "<built-in>" #-}
{-# 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" #-}

2
ghc-parser/src-7.8.3/Language/Haskell/GHC/HappyParser.hs
View File

@ -29392,7 +29392,7 @@ hintExplicitForall span = do
{-# LINE 1 "templates/GenericTemplate.hs" #-}
{-# LINE 1 "<built-in>" #-}
{-# LINE 16 "<built-in>" #-}
{-# 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" #-}

1
ipython-kernel/ipython-kernel.cabal
View File

@ -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

111
ipython-kernel/src/IHaskell/IPython/Message/Parser.hs
View File

@ -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"

13
ipython-kernel/src/IHaskell/IPython/Message/Writer.hs
View File

@ -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

91
ipython-kernel/src/IHaskell/IPython/Types.hs
View File

@ -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 ----------------------
--
@ -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, "")]

7
ipython-kernel/stack.yaml Normal file
View File

@ -0,0 +1,7 @@
flags:
ipython-kernel:
examples: false
packages:
- '.'
extra-deps: []
resolver: lts-2.19