ipython-kernel (empty) → 0.1.0.0
raw patch · 10 files changed
+1106/−0 lines, 10 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, cereal, containers, text, unix, uuid, zeromq4-haskell
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- ipython-kernel.cabal +37/−0
- src/IPython/Kernel.hs +16/−0
- src/IPython/Message/Parser.hs +155/−0
- src/IPython/Message/UUID.hs +46/−0
- src/IPython/Message/Writer.hs +118/−0
- src/IPython/Stdin.hs +123/−0
- src/IPython/Types.hs +382/−0
- src/IPython/ZeroMQ.hs +207/−0
+ LICENSE view
@@ -0,0 +1,20 @@+The MIT License (MIT)++Copyright (c) 2013 Andrew Gibiansky++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of+the Software, and to permit persons to whom the Software is furnished to do so,+subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ipython-kernel.cabal view
@@ -0,0 +1,37 @@+name: ipython-kernel+version: 0.1.0.0+synopsis: A library for creating kernels for IPython frontends++description: ipython-kernel is a library for communicating with frontends for the interactive IPython framework. It is used extensively in IHaskell, the interactive Haskell environment.+homepage: http://github.com/gibiansky/IHaskell+license: MIT+license-file: LICENSE+author: Andrew Gibiansky+maintainer: andrew.gibiansky@gmail.com++category: Development+build-type: Simple++cabal-version: >=1.16++library+ exposed-modules: IPython.Kernel+ IPython.Types+ IPython.ZeroMQ+ IPython.Stdin+ IPython.Message.Writer+ IPython.Message.Parser+ IPython.Message.UUID+ -- other-modules: + other-extensions: OverloadedStrings+ hs-source-dirs: src+ default-language: Haskell2010+ build-depends: base >=4.6 && <4.7,+ aeson >=0.6 && <0.7,+ bytestring >=0.10,+ cereal ==0.3.*,+ containers >=0.5,+ text >=0.11,+ unix >=2.6,+ uuid >=1.3,+ zeromq4-haskell >=0.1
+ src/IPython/Kernel.hs view
@@ -0,0 +1,16 @@+-- | This module exports all the types and functions necessary to create an+-- IPython language kernel that supports the @ipython console@ and @ipython+-- notebook@ frontends. +module IPython.Kernel (+ module IPython.Types,+ module IPython.Message.Writer,+ module IPython.Message.Parser,+ module IPython.Message.UUID,+ module IPython.ZeroMQ,+ ) where++import IPython.Types+import IPython.Message.Writer+import IPython.Message.Parser+import IPython.Message.UUID+import IPython.ZeroMQ
+ src/IPython/Message/Parser.hs view
@@ -0,0 +1,155 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Description : Parsing messages received from IPython+--+-- This module is responsible for converting from low-level ByteStrings+-- obtained from the 0MQ sockets into Messages. The only exposed function is+-- `parseMessage`, which should only be used in the low-level 0MQ interface.+module IPython.Message.Parser (parseMessage) where++import Data.Aeson ((.:), decode, Result(..), Object)+import Control.Applicative ((<|>))+import Data.Aeson.Types (parse)+import Data.ByteString+import qualified Data.ByteString.Lazy as Lazy+import Data.Map (Map)++import IPython.Types++type LByteString = Lazy.ByteString++----- External interface -----++-- | Parse a message from its ByteString components into a Message.+parseMessage :: [ByteString] -- ^ The list of identifiers sent with the message.+ -> ByteString -- ^ The header data.+ -> ByteString -- ^ The parent header, which is just "{}" if there is no header.+ -> ByteString -- ^ The metadata map, also "{}" for an empty map.+ -> ByteString -- ^ The message content.+ -> Message -- ^ A parsed message.+parseMessage idents headerData parentHeader metadata content = + let header = parseHeader idents headerData parentHeader metadata+ messageType = msgType header+ messageWithoutHeader = parser messageType $ Lazy.fromStrict content in+ messageWithoutHeader { header = header }++----- Module internals -----++-- | Parse a header from its ByteString components into a MessageHeader.+parseHeader :: [ByteString] -- ^ The list of identifiers.+ -> ByteString -- ^ The header data.+ -> ByteString -- ^ The parent header, or "{}" for Nothing.+ -> ByteString -- ^ The metadata, or "{}" for an empty map.+ -> MessageHeader -- The resulting message header.+parseHeader idents headerData parentHeader metadata = MessageHeader {+ identifiers = idents,+ parentHeader = parentResult,+ metadata = metadataMap,+ messageId = messageUUID,+ sessionId = sessionUUID,+ username = username,+ msgType = messageType+ } where+ -- Decode the header data and the parent header data into JSON objects.+ -- If the parent header data is absent, just have Nothing instead.+ Just result = decode $ Lazy.fromStrict headerData :: Maybe Object+ parentResult = if parentHeader == "{}"+ then Nothing+ else Just $ parseHeader idents parentHeader "{}" metadata++ -- Get the basic fields from the header.+ Success (messageType, username, messageUUID, sessionUUID) = flip parse result $ \obj -> do + messType <- obj .: "msg_type"+ username <- obj .: "username"+ message <- obj .: "msg_id"+ session <- obj .: "session"+ return (messType, username, message, session)++ -- Get metadata as a simple map.+ Just metadataMap = decode $ Lazy.fromStrict metadata :: Maybe (Map ByteString ByteString)++noHeader :: MessageHeader+noHeader = error "No header created"++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 ExecuteRequestMessage = executeRequestParser+parser CompleteRequestMessage = completeRequestParser+parser ObjectInfoRequestMessage = objectInfoRequestParser+parser ShutdownRequestMessage = shutdownRequestParser+parser InputReplyMessage = inputReplyParser+parser other = error $ "Unknown message type " ++ show other++-- | Parse a kernel info request.+-- A kernel info request has no auxiliary information, so ignore the body.+kernelInfoRequestParser :: LByteString -> Message+kernelInfoRequestParser _ = KernelInfoRequest { header = noHeader }++-- | Parse an execute request.+-- Fields used are:+-- 1. "code": the code to execute.+-- 2. "silent": whether to execute silently.+-- 3. "store_history": whether to include this in history.+-- 4. "allow_stdin": whether to allow reading from stdin for this code.+executeRequestParser :: LByteString -> Message+executeRequestParser content = + let parser obj = do+ code <- obj .: "code"+ silent <- obj .: "silent"+ storeHistory <- obj .: "store_history"+ allowStdin <- obj .: "allow_stdin"++ return (code, silent, storeHistory, allowStdin)+ Just decoded = decode content+ Success (code, silent, storeHistory, allowStdin) = parse parser decoded in+ ExecuteRequest {+ header = noHeader,+ getCode = code,+ getSilent = silent,+ getAllowStdin = allowStdin,+ getStoreHistory = storeHistory,+ getUserVariables = [],+ getUserExpressions = []+ }++completeRequestParser :: LByteString -> Message+completeRequestParser content = parsed+ where+ Success parsed = flip parse decoded $ \ obj -> do+ code <- obj .: "block" <|> return ""+ codeLine <- obj .: "line"+ pos <- obj .: "cursor_pos"+ return $ CompleteRequest noHeader code codeLine pos++ Just decoded = decode content++objectInfoRequestParser :: LByteString -> Message+objectInfoRequestParser content = parsed+ where+ Success parsed = flip parse decoded $ \obj -> do+ oname <- obj .: "oname"+ dlevel <- obj .: "detail_level"+ return $ ObjectInfoRequest noHeader oname dlevel++ Just decoded = decode content+++shutdownRequestParser :: LByteString -> Message+shutdownRequestParser content = parsed+ where+ Success parsed = flip parse decoded $ \ obj -> do+ code <- obj .: "restart"+ return $ ShutdownRequest noHeader code++ Just decoded = decode content++inputReplyParser :: LByteString -> Message+inputReplyParser content = parsed+ where+ Success parsed = flip parse decoded $ \ obj -> do+ value <- obj .: "value"+ return $ InputReply noHeader value++ Just decoded = decode content
+ src/IPython/Message/UUID.hs view
@@ -0,0 +1,46 @@+-- | Description : UUID generator and data structure+--+-- Generate, parse, and pretty print UUIDs for use with IPython.+module IPython.Message.UUID (+ UUID,+ random, randoms,+ ) where++import Control.Monad (mzero, replicateM)+import Control.Applicative ((<$>))+import Data.Text (pack)+import Data.Aeson+import Data.UUID.V4 (nextRandom)++import Text.Read as Read hiding (pfail, String)+++-- We use an internal string representation because for the purposes of+-- IPython, it matters whether the letters are uppercase or lowercase and+-- whether the dashes are present in the correct locations. For the+-- purposes of new UUIDs, it does not matter, but IPython expects UUIDs+-- passed to kernels to be returned unchanged, so we cannot actually parse+-- them.++-- | A UUID (universally unique identifier).+data UUID = UUID String deriving (Show, Read, Eq)++-- | Generate a list of random UUIDs.+randoms :: Int -- ^ Number of UUIDs to generate.+ -> IO [UUID]+randoms n = replicateM n random++-- | Generate a single random UUID.+random :: IO UUID+random = UUID <$> show <$> nextRandom++-- Allows reading and writing UUIDs as Strings in JSON. +instance FromJSON UUID where+ parseJSON val@(String _) = UUID <$> parseJSON val++ -- UUIDs must be Strings.+ parseJSON _ = mzero++instance ToJSON UUID where+ -- Extract the string from the UUID.+ toJSON (UUID str) = String $ pack str
+ src/IPython/Message/Writer.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Description : @ToJSON@ for Messages+--+-- This module contains the @ToJSON@ instance for @Message@.+module IPython.Message.Writer (+ ToJSON(..)+) where++import Data.Aeson+import Data.Map (Map)+import Data.Text (Text, pack)+import Data.Monoid (mempty)+++import IPython.Types++-- Convert message bodies into JSON.+instance ToJSON Message where+ toJSON KernelInfoReply{ versionList = vers, language = language } = object [+ "protocol_version" .= ints [4, 0], -- current protocol version, major and minor+ "language_version" .= vers,+ "language" .= language+ ]++ toJSON ExecuteReply{ status = status, executionCounter = counter, pagerOutput = pager} = object [+ "status" .= show status,+ "execution_count" .= counter,+ "payload" .= + if null pager+ then []+ else [object [+ "source" .= string "page",+ "text" .= pager+ ]],+ "user_variables" .= emptyMap,+ "user_expressions" .= emptyMap+ ]+ toJSON PublishStatus{ executionState = executionState } = object [+ "execution_state" .= executionState+ ]+ toJSON PublishStream{ streamType = streamType, streamContent = content } = object [+ "data" .= content,+ "name" .= streamType+ ]+ toJSON PublishDisplayData{ source = src, displayData = datas } = object [+ "source" .= src,+ "metadata" .= object [],+ "data" .= object (map displayDataToJson datas)+ ]++ toJSON PublishOutput{ executionCount = execCount, reprText = reprText } = object [+ "data" .= object ["text/plain" .= reprText],+ "execution_count" .= execCount,+ "metadata" .= object []+ ]+ toJSON PublishInput{ executionCount = execCount, inCode = code } = object [+ "execution_count" .= execCount,+ "code" .= code+ ]+ toJSON (CompleteReply _ m mt t s) = object [+ "matches" .= m,+ "matched_text" .= mt,+ "text" .= t,+ "status" .= if s then string "ok" else "error"+ ]+ toJSON o@ObjectInfoReply{} = object [+ "oname" .= objectName o,+ "found" .= objectFound o,+ "ismagic" .= False,+ "isalias" .= False,+ "type_name" .= objectTypeString o,+ "docstring" .= objectDocString o+ ]++ toJSON ShutdownReply{restartPending = restart} = object [+ "restart" .= restart+ ]++ toJSON ClearOutput{wait = wait} = object [+ "wait" .= wait+ ]++ toJSON RequestInput{inputPrompt = prompt} = object [+ "prompt" .= prompt+ ]+++ toJSON body = error $ "Do not know how to convert to JSON for message " ++ show body+++-- | Print an execution state as "busy", "idle", or "starting".+instance ToJSON ExecutionState where+ toJSON Busy = String "busy"+ toJSON Idle = String "idle"+ toJSON Starting = String "starting"++-- | Print a stream as "stdin" or "stdout" strings.+instance ToJSON StreamType where+ toJSON Stdin = String "stdin"+ toJSON Stdout = String "stdout"++-- | Convert a MIME type and value into a JSON dictionary pair.+displayDataToJson :: DisplayData -> (Text, Value) +displayDataToJson (DisplayData mimeType dataStr) = pack (show mimeType) .= dataStr++----- Constants -----++emptyMap :: Map String String+emptyMap = mempty++emptyList :: [Int]+emptyList = []++ints :: [Int] -> [Int]+ints = id++string :: String -> String+string = id
+ src/IPython/Stdin.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE OverloadedStrings, DoAndIfThenElse #-}+-- | This module provides a way in which the Haskell standard input may be+-- forwarded to the IPython frontend and thus allows the notebook to use+-- the standard input.+--+-- This relies on the implementation of file handles in GHC, and is+-- generally unsafe and terrible. However, it is difficult to find another+-- way to do it, as file handles are generally meant to point to streams+-- and files, and not networked communication protocols.+--+-- In order to use this module, it must first be initialized with two+-- things. First of all, in order to know how to communicate with the+-- IPython frontend, it must know the kernel profile used for+-- communication. For this, use @recordKernelProfile@ once the profile is+-- known. Both this and @recordParentHeader@ take a directory name where+-- they can store this data.+--+-- Finally, the module must know what @execute_request@ message is+-- currently being replied to (which will request the input). Thus, every+-- time the language kernel receives an @execute_request@ message, it+-- should inform this module via @recordParentHeader@, so that the module+-- may generate messages with an appropriate parent header set. If this is+-- not done, the IPython frontends will not recognize the target of the+-- communication.+--+-- Finally, in order to activate this module, @fixStdin@ must be called+-- once. It must be passed the same directory name as @recordParentHeader@+-- and @recordKernelProfile@. Note that if this is being used from within+-- the GHC API, @fixStdin@ /must/ be called from within the GHC session+-- not from the host code.+module IPython.Stdin (+ fixStdin,+ recordParentHeader,+ recordKernelProfile+ ) where++import Control.Concurrent +import Control.Applicative ((<$>))+import Control.Concurrent.Chan+import Control.Monad+import GHC.IO.Handle+import GHC.IO.Handle.Types+import System.IO+import System.Posix.IO+import System.IO.Unsafe+import qualified Data.Map as Map++import IPython.Types+import IPython.ZeroMQ+import IPython.Message.UUID as UUID++stdinInterface :: MVar ZeroMQStdin+{-# NOINLINE stdinInterface #-}+stdinInterface = unsafePerformIO newEmptyMVar++-- | Manipulate standard input so that it is sourced from the IPython+-- frontend. This function is build on layers of deep magical hackery, so+-- be careful modifying it.+fixStdin :: String -> IO ()+fixStdin dir = do+ -- Initialize the stdin interface.+ profile <- read <$> readFile (dir ++ "/.kernel-profile")+ interface <- serveStdin profile+ putMVar stdinInterface interface+ void $ forkIO $ stdinOnce dir++stdinOnce :: String -> IO ()+stdinOnce dir = do+ -- Create a pipe using and turn it into handles.+ (readEnd, writeEnd) <- createPipe+ newStdin <- fdToHandle readEnd+ stdinInput <- fdToHandle writeEnd+ hSetBuffering newStdin NoBuffering+ hSetBuffering stdinInput NoBuffering++ -- Store old stdin and swap in new stdin.+ oldStdin <- hDuplicate stdin+ hDuplicateTo newStdin stdin++ loop stdinInput oldStdin newStdin+ where+ loop stdinInput oldStdin newStdin = do+ let FileHandle _ mvar = stdin+ threadDelay $ 150 * 1000+ empty <- isEmptyMVar mvar+ if not empty+ then loop stdinInput oldStdin newStdin+ else do+ line <- getInputLine dir+ hPutStr stdinInput $ line ++ "\n"+ loop stdinInput oldStdin newStdin++-- | Get a line of input from the IPython frontend.+getInputLine :: String -> IO String+getInputLine dir = do+ StdinChannel req rep <- readMVar stdinInterface++ -- Send a request for input.+ uuid <- UUID.random+ parentHeader <- read <$> readFile (dir ++ "/.last-req-header")+ let header = MessageHeader {+ username = username parentHeader,+ identifiers = identifiers parentHeader,+ parentHeader = Just parentHeader,+ messageId = uuid,+ sessionId = sessionId parentHeader,+ metadata = Map.fromList [],+ msgType = InputRequestMessage+ }+ let msg = RequestInput header ""+ writeChan req msg++ -- Get the reply.+ InputReply _ value <- readChan rep+ return value++recordParentHeader :: String -> MessageHeader -> IO ()+recordParentHeader dir header =+ writeFile (dir ++ "/.last-req-header") $ show header++recordKernelProfile :: String -> Profile -> IO ()+recordKernelProfile dir profile =+ writeFile (dir ++ "/.kernel-profile") $ show profile
+ src/IPython/Types.hs view
@@ -0,0 +1,382 @@+{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, DeriveGeneric #-}+-- | This module contains all types used to create an IPython language+-- kernel.+module IPython.Types (+ -- * IPython kernel profile+ Profile(..),+ Transport(..),+ Port(..),+ IP(..),++ -- * IPython messaging protocol+ Message(..),+ MessageHeader(..),+ Username(..),+ Metadata(..),+ MessageType(..),+ Width(..), Height(..),+ StreamType(..),+ ExecutionState(..),+ ExecuteReplyStatus(..),+ replyType,++ -- ** IPython display data message+ DisplayData(..),+ MimeType(..),+ extractPlain+ + ) where++import Data.Aeson+import Control.Applicative ((<$>), (<*>))+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as Char+import qualified Data.Text as Text+import Data.Serialize+import IPython.Message.UUID+import GHC.Generics (Generic)+import Data.Typeable+import Data.List (find)+import Data.Map (Map)++-------------------- IPython Kernel Profile Types ----------------------+-- | A TCP port.+type Port = Int++-- | An IP address.+type IP = String++-- | The transport mechanism used to communicate with the IPython frontend.+data Transport+ = TCP -- ^ Default transport mechanism via TCP.+ deriving (Show, Read)++-- | A kernel profile, specifying how the kernel communicates.+data Profile = Profile {+ ip :: IP, -- ^ The IP on which to listen.+ transport :: Transport, -- ^ The transport mechanism.+ stdinPort :: Port, -- ^ The stdin channel port. + controlPort :: Port, -- ^ The control channel port.+ hbPort :: Port, -- ^ The heartbeat channel port.+ shellPort :: Port, -- ^ The shell command port.+ iopubPort :: Port, -- ^ The IOPub port.+ key :: ByteString -- ^ The HMAC encryption key.+ } deriving (Show, Read)++-- Convert the kernel profile to and from JSON.+instance FromJSON Profile where+ parseJSON (Object v) = + Profile <$> v .: "ip"+ <*> v .: "transport"+ <*> v .: "stdin_port"+ <*> v .: "control_port"+ <*> v .: "hb_port"+ <*> v .: "shell_port"+ <*> v .: "iopub_port"+ <*> v .: "key"+ parseJSON _ = fail "Expecting JSON object."++instance ToJSON Profile where+ toJSON profile = object [+ "ip" .= ip profile,+ "transport" .= transport profile,+ "stdin_port" .= stdinPort profile,+ "control_port".= controlPort profile,+ "hb_port" .= hbPort profile,+ "shell_port" .= shellPort profile,+ "iopub_port" .= iopubPort profile,+ "key" .= key profile+ ]++instance FromJSON Transport where+ parseJSON (String str) = do+ let mech = Text.unpack str+ case mech of+ "tcp" -> return TCP+ _ -> fail $ "Unknown transport mechanism " ++ mech+ parseJSON _ = fail "Expected JSON string as transport."++instance ToJSON Transport where+ toJSON TCP = String "tcp"+++-------------------- IPython Message Types ----------------------++-- | A message header with some metadata. +data MessageHeader = MessageHeader {+ identifiers :: [ByteString], -- ^ The identifiers sent with the message.+ parentHeader :: Maybe MessageHeader, -- ^ The parent header, if present.+ metadata :: Metadata, -- ^ A dict of metadata.+ messageId :: UUID, -- ^ A unique message UUID.+ sessionId :: UUID, -- ^ A unique session UUID.+ username :: Username, -- ^ The user who sent this message.+ msgType :: MessageType -- ^ The message type.+ } deriving (Show, Read)++-- Convert a message header into the JSON field for the header.+-- This field does not actually have all the record fields.+instance ToJSON MessageHeader where+ toJSON header = object [+ "msg_id" .= messageId header,+ "session" .= sessionId header,+ "username" .= username header,+ "msg_type" .= showMessageType (msgType header)+ ]++-- | A username for the source of a message.+type Username = ByteString++-- | A metadata dictionary.+type Metadata = Map ByteString ByteString++-- | The type of a message, corresponding to IPython message types.+data MessageType = KernelInfoReplyMessage+ | KernelInfoRequestMessage+ | ExecuteReplyMessage+ | ExecuteRequestMessage+ | StatusMessage+ | StreamMessage+ | DisplayDataMessage+ | OutputMessage+ | InputMessage+ | CompleteRequestMessage+ | CompleteReplyMessage+ | ObjectInfoRequestMessage+ | ObjectInfoReplyMessage+ | ShutdownRequestMessage+ | ShutdownReplyMessage+ | ClearOutputMessage+ | InputRequestMessage+ | InputReplyMessage+ deriving (Show, Read)++showMessageType :: MessageType -> String+showMessageType KernelInfoReplyMessage = "kernel_info_reply"+showMessageType KernelInfoRequestMessage = "kernel_info_request"+showMessageType ExecuteReplyMessage = "execute_reply"+showMessageType ExecuteRequestMessage = "execute_request"+showMessageType StatusMessage = "status"+showMessageType StreamMessage = "stream"+showMessageType DisplayDataMessage = "display_data"+showMessageType OutputMessage = "pyout"+showMessageType InputMessage = "pyin"+showMessageType CompleteRequestMessage = "complete_request"+showMessageType CompleteReplyMessage = "complete_reply"+showMessageType ObjectInfoRequestMessage = "object_info_request"+showMessageType ObjectInfoReplyMessage = "object_info_reply"+showMessageType ShutdownRequestMessage = "shutdown_request"+showMessageType ShutdownReplyMessage = "shutdown_reply"+showMessageType ClearOutputMessage = "clear_output"+showMessageType InputRequestMessage = "input_request"+showMessageType InputReplyMessage = "input_reply"++instance FromJSON MessageType where+ parseJSON (String s) = case s of+ "kernel_info_reply" -> return KernelInfoReplyMessage+ "kernel_info_request" -> return KernelInfoRequestMessage+ "execute_reply" -> return ExecuteReplyMessage+ "execute_request" -> return ExecuteRequestMessage+ "status" -> return StatusMessage+ "stream" -> return StreamMessage+ "display_data" -> return DisplayDataMessage+ "pyout" -> return OutputMessage+ "pyin" -> return InputMessage+ "complete_request" -> return CompleteRequestMessage+ "complete_reply" -> return CompleteReplyMessage+ "object_info_request" -> return ObjectInfoRequestMessage+ "object_info_reply" -> return ObjectInfoReplyMessage+ "shutdown_request" -> return ShutdownRequestMessage+ "shutdown_reply" -> return ShutdownReplyMessage+ "clear_output" -> return ClearOutputMessage+ "input_request" -> return InputRequestMessage+ "input_reply" -> return InputReplyMessage++ _ -> fail ("Unknown message type: " ++ show s)+ parseJSON _ = fail "Must be a string."+++-- | A message used to communicate with the IPython frontend.+data Message + -- | A request from a frontend for information about the kernel.+ = KernelInfoRequest { header :: MessageHeader }+ -- | A response to a KernelInfoRequest.+ | KernelInfoReply { + header :: MessageHeader,+ versionList :: [Int], -- ^ The version of the language, e.g. [7, 6, 3] for GHC 7.6.3+ language :: String -- ^ The language name, e.g. "haskell"+ }+ + -- | A request from a frontend to execute some code.+ | ExecuteRequest {+ header :: MessageHeader,+ getCode :: ByteString, -- ^ The code string.+ getSilent :: Bool, -- ^ Whether this should be silently executed.+ getStoreHistory :: Bool, -- ^ Whether to store this in history.+ getAllowStdin :: Bool, -- ^ Whether this code can use stdin.++ getUserVariables :: [ByteString], -- ^ Unused.+ getUserExpressions :: [ByteString] -- ^ Unused.+ }++ -- | A reply to an execute request.+ | ExecuteReply {+ header :: MessageHeader,+ status :: ExecuteReplyStatus, -- ^ The status of the output.+ pagerOutput :: String, -- ^ The help string to show in the pager.+ executionCounter :: Int -- ^ The execution count, i.e. which output this is.+ }++ | PublishStatus {+ header :: MessageHeader,+ executionState :: ExecutionState -- ^ The execution state of the kernel.+ }++ | PublishStream {+ header :: MessageHeader,+ streamType :: StreamType, -- ^ Which stream to publish to.+ streamContent :: String -- ^ What to publish.+ }++ | PublishDisplayData {+ header :: MessageHeader,+ source :: String, -- ^ The name of the data source.+ displayData :: [DisplayData] -- ^ A list of data representations.+ }++ | PublishOutput {+ header :: MessageHeader,+ reprText :: String, -- ^ Printed output text.+ executionCount :: Int -- ^ Which output this is for.+ }++ | PublishInput {+ header :: MessageHeader,+ inCode :: String, -- ^ Submitted input code.+ executionCount :: Int -- ^ Which input this is.+ }++ | CompleteRequest {+ header :: MessageHeader,+ getCode :: ByteString, {- ^+ The entire block of text where the line is. This may be useful in the+ case of multiline completions where more context may be needed. Note: if+ in practice this field proves unnecessary, remove it to lighten the+ messages. json field @block@ -}+ getCodeLine :: ByteString, -- ^ just the line with the cursor. json field @line@+ getCursorPos :: Int -- ^ position of the cursor (index into the line?). json field @cursor_pos@++ }++ | CompleteReply {+ header :: MessageHeader,+ completionMatches :: [ByteString],+ completionMatchedText :: ByteString,+ completionText :: ByteString,+ completionStatus :: Bool+ }++ | ObjectInfoRequest {+ header :: MessageHeader, + objectName :: ByteString, -- ^ Name of object being searched for.+ detailLevel :: Int -- ^ Level of detail desired (defaults to 0).+ -- 0 is equivalent to foo?, 1 is equivalent+ -- to foo??.+ }++ | ObjectInfoReply {+ header :: MessageHeader, + objectName :: ByteString, -- ^ Name of object which was searched for.+ objectFound :: Bool, -- ^ Whether the object was found.+ objectTypeString :: ByteString, -- ^ Object type.+ objectDocString :: ByteString+ }++ | ShutdownRequest {+ header :: MessageHeader,+ restartPending :: Bool -- ^ Whether this shutdown precedes a restart.+ }+ | ShutdownReply {+ header :: MessageHeader,+ restartPending :: Bool -- ^ Whether this shutdown precedes a restart.+ }++ | ClearOutput {+ header :: MessageHeader,+ wait :: Bool -- ^ Whether to wait to redraw until there is more output.+ }++ | RequestInput {+ header :: MessageHeader,+ inputPrompt :: String + }++ | InputReply {+ header :: MessageHeader,+ inputValue :: String + }++ deriving Show++-- | Possible statuses in the execution reply messages.+data ExecuteReplyStatus = Ok | Err | Abort++instance Show ExecuteReplyStatus where+ show Ok = "ok"+ show Err = "error"+ show Abort = "abort"++-- | The execution state of the kernel.+data ExecutionState = Busy | Idle | Starting deriving Show++-- | Input and output streams.+data StreamType = Stdin | Stdout deriving Show++-- | Get the reply message type for a request message type.+replyType :: MessageType -> Maybe MessageType+replyType KernelInfoRequestMessage = Just KernelInfoReplyMessage+replyType ExecuteRequestMessage = Just ExecuteReplyMessage+replyType CompleteRequestMessage = Just CompleteReplyMessage+replyType ObjectInfoRequestMessage = Just ObjectInfoReplyMessage+replyType ShutdownRequestMessage = Just ShutdownReplyMessage+replyType _ = Nothing++-- | Data for display: a string with associated MIME type.+data DisplayData = DisplayData MimeType ByteString deriving (Typeable, Generic)++-- We can't print the actual data, otherwise this will be printed every+-- time it gets computed because of the way the evaluator is structured.+-- See how `displayExpr` is computed.+instance Show DisplayData where+ show _ = "DisplayData"++-- Allow DisplayData serialization+instance Serialize DisplayData+instance Serialize MimeType++-- | Possible MIME types for the display data.+type Width = Int+type Height = Int+data MimeType = PlainText+ | MimeHtml+ | MimePng Width Height+ | MimeJpg Width Height+ | MimeSvg+ | MimeLatex+ deriving (Eq, Typeable, Generic)++-- Extract the plain text from a list of displays.+extractPlain :: [DisplayData] -> String+extractPlain disps =+ case find isPlain disps of+ Nothing -> ""+ Just (DisplayData PlainText bytestr) -> Char.unpack bytestr+ where+ isPlain (DisplayData mime _) = mime == PlainText++instance Show MimeType where+ show PlainText = "text/plain"+ show MimeHtml = "text/html"+ show (MimePng _ _) = "image/png" + show (MimeJpg _ _) = "image/jpeg"+ show MimeSvg = "image/svg+xml"+ show MimeLatex = "text/latex"
+ src/IPython/ZeroMQ.hs view
@@ -0,0 +1,207 @@+{-# LANGUAGE OverloadedStrings, DoAndIfThenElse #-}+-- | Description : Low-level ZeroMQ communication wrapper.+--+-- The "ZeroMQ" module abstracts away the low-level 0MQ based interface with IPython,+-- replacing it instead with a Haskell Channel based interface. The `serveProfile` function+-- takes a IPython profile specification and returns the channel interface to use.+module IPython.ZeroMQ (+ ZeroMQInterface (..),+ ZeroMQStdin(..),+ serveProfile,+ serveStdin,+ ) where++import qualified Data.ByteString.Lazy as ByteString+import Data.ByteString (ByteString)+import Control.Concurrent+import Control.Monad +import System.IO.Unsafe+import Data.Aeson (encode)+import System.ZMQ4 hiding (stdin)++import IPython.Types+import IPython.Message.Parser+import IPython.Message.Writer++-- | 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 {+ shellRequestChannel :: Chan Message, -- ^ A channel populated with requests from the frontend.+ shellReplyChannel :: Chan Message, -- ^ Writing to this channel causes a reply to be sent to the frontend.+ controlRequestChannel :: Chan Message, -- ^ This channel is a duplicate of the shell request channel,+ -- ^ though using a different backend socket.+ controlReplyChannel :: Chan Message, -- ^ This channel is a duplicate of the shell reply channel,+ -- ^ though using a different backend socket.+ iopubChannel :: Chan Message -- ^ Writing to this channel sends an iopub message to the frontend.+ }++data ZeroMQStdin = StdinChannel {+ stdinRequestChannel :: Chan Message,+ stdinReplyChannel :: Chan Message+ }++-- | Start responding on all ZeroMQ channels used to communicate with IPython+-- | via the provided profile. Return a set of channels which can be used to+-- | communicate with IPython in a more structured manner. +serveProfile :: Profile -- ^ The profile specifying which ports and transport mechanisms to use.+ -> IO ZeroMQInterface -- ^ The Message-channel based interface to the sockets.+serveProfile profile = do+ -- Create all channels which will be used for higher level communication.+ shellReqChan <- newChan+ shellRepChan <- newChan+ controlReqChan <- dupChan shellReqChan+ controlRepChan <- dupChan shellRepChan+ iopubChan <- newChan+ let channels = Channels shellReqChan shellRepChan controlReqChan controlRepChan iopubChan++ -- Create the context in a separate thread that never finishes. If+ -- withContext or withSocket complete, the context or socket become invalid.+ forkIO $ withContext $ \context -> do+ -- Serve on all sockets.+ forkIO $ serveSocket context Rep (hbPort profile) $ heartbeat channels+ forkIO $ serveSocket context Router (controlPort profile) $ control channels+ forkIO $ serveSocket context Router (shellPort profile) $ shell channels++ -- The context is reference counted in this thread only. Thus, the last+ -- serveSocket cannot be asynchronous, because otherwise context would+ -- be garbage collectable - since it would only be used in other+ -- threads. Thus, keep the last serveSocket in this thread.+ serveSocket context Pub (iopubPort profile) $ iopub channels++ return channels++serveStdin :: Profile -> IO ZeroMQStdin +serveStdin profile = do+ reqChannel <- newChan+ repChannel <- newChan+ + -- Create the context in a separate thread that never finishes. If+ -- withContext or withSocket complete, the context or socket become invalid.+ forkIO $ withContext $ \context ->+ -- Serve on all sockets.+ serveSocket context Router (stdinPort profile) $ \socket -> do+ -- Read the request from the interface channel and send it.+ readChan reqChannel >>= sendMessage socket++ -- Receive a response and write it to the interface channel.+ receiveMessage socket >>= writeChan repChannel++ return $ StdinChannel reqChannel repChannel++-- | Serve on a given socket in a separate thread. Bind the socket in the+-- | given context and then loop the provided action, which should listen+-- | on the socket and respond to any events.+serveSocket :: SocketType a => Context -> a -> Port -> (Socket a -> IO b) -> IO ()+serveSocket context socketType port action = void $+ withSocket context socketType $ \socket -> do+ bind socket $ "tcp://127.0.0.1:" ++ show port+ forever $ action socket++-- | Listener on the heartbeat port. Echoes back any data it was sent.+heartbeat :: ZeroMQInterface -> Socket Rep -> IO ()+heartbeat _ socket = do+ -- Read some data.+ request <- receive socket++ -- Send it back.+ send socket [] request++-- | Listener on the shell port. Reads messages and writes them to+-- | the shell request channel. For each message, reads a response from the+-- | shell reply channel of the interface and sends it back to the frontend. +shell :: ZeroMQInterface -> Socket Router -> IO ()+shell channels socket = do+ -- Receive a message and write it to the interface channel.+ receiveMessage socket >>= writeChan requestChannel++ -- Read the reply from the interface channel and send it.+ readChan replyChannel >>= sendMessage socket++ where+ requestChannel = shellRequestChannel channels+ replyChannel = shellReplyChannel channels++-- | Listener on the shell port. Reads messages and writes them to+-- | the shell request channel. For each message, reads a response from the+-- | shell reply channel of the interface and sends it back to the frontend. +control :: ZeroMQInterface -> Socket Router -> IO ()+control channels socket = do+ -- Receive a message and write it to the interface channel.+ receiveMessage socket >>= writeChan requestChannel++ -- Read the reply from the interface channel and send it.+ readChan replyChannel >>= sendMessage socket++ where+ requestChannel = controlRequestChannel channels+ replyChannel = controlReplyChannel channels++-- | Send messages via the iopub channel.+-- | This reads messages from the ZeroMQ iopub interface channel +-- | and then writes the messages to the socket.+iopub :: ZeroMQInterface -> Socket Pub -> IO ()+iopub channels socket =+ readChan (iopubChannel channels) >>= sendMessage socket++-- | Receive and parse a message from a socket.+receiveMessage :: Receiver a => Socket a -> IO Message+receiveMessage socket = do+ -- Read all identifiers until the identifier/message delimiter.+ idents <- readUntil "<IDS|MSG>"++ -- Ignore the signature for now.+ void next++ headerData <- next+ parentHeader <- next+ metadata <- next+ content <- next++ let message = parseMessage idents headerData parentHeader metadata content+ return message++ where+ -- Receive the next piece of data from the socket.+ next = receive socket++ -- Read data from the socket until we hit an ending string.+ -- Return all data as a list, which does not include the ending string.+ readUntil str = do+ line <- next+ if line /= str+ then do+ remaining <- readUntil str+ return $ line : remaining+ else return []+ +-- | Encode a message in the IPython ZeroMQ communication protocol +-- | and send it through the provided socket.+sendMessage :: Sender a => Socket a -> Message -> IO ()+sendMessage socket message = do+ let head = header message+ parentHeaderStr = maybe "{}" encodeStrict $ parentHeader head+ idents = identifiers head+ metadata = "{}"+ content = encodeStrict message+ headStr = encodeStrict head++ -- Send all pieces of the message.+ mapM_ sendPiece idents+ sendPiece "<IDS|MSG>"+ sendPiece ""+ sendPiece headStr+ sendPiece parentHeaderStr+ sendPiece metadata++ -- Conclude transmission with content.+ sendLast content++ where+ sendPiece = send socket [SendMore]+ sendLast = send socket []++ -- Encode to a strict bytestring.+ encodeStrict :: ToJSON a => a -> ByteString+ encodeStrict = ByteString.toStrict . encode