Skip to content

G
gargantext-ihaskell
Commit c53f70d8 authored by Andrew Gibiansky's avatar Andrew Gibiansky
Browse files
Options

Formatting ipython-kernel

parent 7ba7c4d1
Show whitespace changes
Inline Side-by-side
Showing with 836 additions and 890 deletions
ipython-kernel/examples/Calc.hs
View file @ c53f70d8
{-# LANGUAGE FlexibleContexts, FlexibleInstances, OverloadedStrings, MultiWayIf #-}
module Main where
import Control.Applicative
......@@ -20,7 +21,8 @@ import IHaskell.IPython.EasyKernel (installProfile, easyKernel, KernelConfig(..)
import System.Environment (getArgs)
import System.FilePath ((</>))
import Text.Parsec (Parsec, ParseError, alphaNum, char, letter, oneOf, optionMaybe, runParser, (<?>))
import Text.Parsec (Parsec, ParseError, alphaNum, char, letter, oneOf, optionMaybe,
runParser, (<?>))
import qualified Text.Parsec.Token as P
import qualified Paths_ipython_kernel as Paths
......@@ -28,21 +30,16 @@ import qualified Paths_ipython_kernel as Paths
---------------------------------------------------------
-- Hutton's Razor, plus time delays, plus a global state
---------------------------------------------------------
-- | This language is Hutton's Razor with two added operations that
-- are needed to demonstrate the kernel features: a global state,
-- accessed and modified using Count, and a sleep operation.
--
-- | This language is Hutton's Razor with two added operations that are needed to demonstrate the
-- kernel features: a global state, accessed and modified using Count, and a sleep operation.
data Razor = I Integer
| Plus Razor Razor
| SleepThen Double Razor
| Count
deriving (Read, Show, Eq)
---------
-- Parser
---------
-- ------- Parser -------
razorDef :: Monad m => P.GenLanguageDef String a m
razorDef = P.LanguageDef
{ P.commentStart = "(*"
......@@ -83,7 +80,8 @@ literal :: Parsec String a Razor
literal = I <$> integer
sleepThen :: Parsec String a Razor
sleepThen = do keyword "sleep"
sleepThen = do
keyword "sleep"
delay <- float <?> "seconds"
keyword "then"
body <- expr
......@@ -94,8 +92,11 @@ count :: Parsec String a Razor
count = keyword "count" >> return Count
expr :: Parsec String a Razor
expr = do one <- parens expr <|> literal <|> sleepThen <|> count
rest <- optionMaybe (do op <- operator
expr = do
one <- parens expr <|> literal <|> sleepThen <|> count
rest <- optionMaybe
(do
op <- operator
guard (op == "+")
expr)
case rest of
......@@ -105,12 +106,7 @@ expr = do one <- parens expr <|> literal <|> sleepThen <|> count
parse :: String -> Either ParseError Razor
parse = runParser expr () "(input)"
----------------------
-- Language operations
----------------------
-- | Completion
-- -------------------- Language operations -------------------- | Completion
langCompletion :: T.Text -> T.Text -> Int -> Maybe ([T.Text], T.Text, T.Text)
langCompletion _code line col =
let (before, _) = T.splitAt col line
......@@ -123,20 +119,18 @@ langCompletion _code line col =
lastMaybe (_:xs) = lastMaybe xs
matchesFor :: String -> [String]
matchesFor input = filter (isPrefixOf input) available
available = ["sleep", "then", "end", "count"] ++ map show [(-1000::Int)..1000]
available = ["sleep", "then", "end", "count"] ++ map show [(-1000 :: Int) .. 1000]
-- | Documentation lookup
langInfo :: T.Text -> Maybe (T.Text, T.Text, T.Text)
langInfo obj =
if | any (T.isPrefixOf obj) ["sleep", "then", "end"] ->
Just (obj, sleepDocs, sleepType)
| T.isPrefixOf obj "count" ->
Just (obj, countDocs, countType)
if | any (T.isPrefixOf obj) ["sleep", "then", "end"] -> Just (obj, sleepDocs, sleepType)
| T.isPrefixOf obj "count" -> Just (obj, countDocs, countType)
| obj == "+" -> Just (obj, plusDocs, plusType)
| T.all isDigit obj -> Just (obj, intDocs obj, intType)
| [x, y] <- T.splitOn "." obj,
T.all isDigit x,
T.all isDigit y -> Just (obj, floatDocs obj, floatType)
| [x, y] <- T.splitOn "." obj
, T.all isDigit x
, T.all isDigit y -> Just (obj, floatDocs obj, floatType)
| otherwise -> Nothing
where
sleepDocs = "sleep DURATION then VALUE end: sleep DURATION seconds, then eval VALUE"
......@@ -155,11 +149,11 @@ data IntermediateEvalRes = Got Razor Integer
| Waiting Double
deriving Show
-- | Cons for lists of trace elements - in this case, "sleeping"
-- messages should replace old ones to create a countdown effect.
-- | Cons for lists of trace elements - in this case, "sleeping" messages should replace old ones to
-- create a countdown effect.
consRes :: IntermediateEvalRes -> [IntermediateEvalRes] -> [IntermediateEvalRes]
consRes r@(Waiting _) (Waiting _ : s) = r:s
consRes r s = r:s
consRes r@(Waiting _) (Waiting _:s) = r : s
consRes r s = r : s
-- | Execute an expression.
execRazor :: MVar Integer -- ^ The global counter state
......@@ -168,9 +162,10 @@ execRazor :: MVar Integer -- ^ The global counter state
-> ([IntermediateEvalRes] -> IO ()) -- ^ Callback for intermediate results
-> StateT ([IntermediateEvalRes], T.Text) IO Integer
execRazor _ x@(I i) _ _ =
modify (second (<> (T.pack (show x)))) >> return i
modify (second (<> T.pack (show x))) >> return i
execRazor val tm@(Plus x y) clear send =
do modify (second (<> (T.pack (show tm))))
do
modify (second (<> T.pack (show tm)))
x' <- execRazor val x clear send
modify (first $ consRes (Got x x'))
sendState
......@@ -181,33 +176,39 @@ execRazor val tm@(Plus x y) clear send =
modify (first $ consRes (Got tm res))
sendState
return res
where sendState = liftIO clear >> fst <$> get >>= liftIO . send
where
sendState = liftIO clear >> fst <$> get >>= liftIO . send
execRazor val (SleepThen delay body) clear send
| delay <= 0.0 = execRazor val body clear send
| delay > 0.1 = do modify (first $ consRes (Waiting delay))
| delay > 0.1 = do
modify (first $ consRes (Waiting delay))
sendState
liftIO $ threadDelay 100000
execRazor val (SleepThen (delay - 0.1) body) clear send
| otherwise = do modify (first $ consRes (Waiting 0))
| otherwise = do
modify (first $ consRes (Waiting 0))
sendState
liftIO $ threadDelay (floor (delay * 1000000))
execRazor val body clear send
where sendState = liftIO clear >> fst <$> get >>= liftIO . send
where
sendState = liftIO clear >> fst <$> get >>= liftIO . send
execRazor val Count clear send = do
i <- liftIO $ takeMVar val
modify (first $ consRes (Got Count i))
sendState
liftIO $ putMVar val (i+1)
liftIO $ putMVar val (i + 1)
return i
where sendState = liftIO clear >> fst <$> get >>= liftIO . send
where
sendState = liftIO clear >> fst <$> get >>= liftIO . send
-- | Generate a language configuration for some initial state
mkConfig :: MVar Integer -- ^ The internal state of the execution
-> KernelConfig IO [IntermediateEvalRes] (Either ParseError Integer)
mkConfig var = KernelConfig
{ languageName = "expanded_huttons_razor"
, languageVersion = [0,1,0]
, languageVersion = [0, 1, 0]
, profileSource = Just . (</> "calc_profile.tar") <$> Paths.getDataDir
, displayResult = displayRes
, displayOutput = displayOut
......@@ -235,7 +236,8 @@ mkConfig var = KernelConfig
return (Right res, Ok, T.unpack pager)
main :: IO ()
main = do args <- getArgs
main = do
args <- getArgs
val <- newMVar 1
case args of
["kernel", profileFile] ->
......@@ -246,4 +248,5 @@ main = do args <- getArgs
_ -> do
putStrLn "Usage:"
putStrLn "simple-calc-example setup -- set up the profile"
putStrLn "simple-calc-example kernel FILE -- run a kernel with FILE for communication with the frontend"
putStrLn
"simple-calc-example kernel FILE -- run a kernel with FILE for communication with the frontend"
ipython-kernel/src/IHaskell/IPython/EasyKernel.hs
View file @ c53f70d8
{-# LANGUAGE OverloadedStrings #-}
-- | Description : Easy IPython kernels
-- = Overview
-- This module provides automation for writing simple IPython
-- kernels. In particular, it provides a record type that defines
-- configurations and a function that interprets a configuration as an
-- action in some monad that can do IO.
-- | Description : Easy IPython kernels = Overview This module provides automation for writing
-- simple IPython kernels. In particular, it provides a record type that defines configurations and
-- a function that interprets a configuration as an action in some monad that can do IO.
--
-- The configuration consists primarily of functions that implement
-- the various features of a kernel, such as running code, looking up
-- documentation, and performing completion. An example for a simple
-- language that nevertheless has side effects, global state, and
-- timing effects is included in the examples directory.
-- The configuration consists primarily of functions that implement the various features of a
-- kernel, such as running code, looking up documentation, and performing completion. An example for
-- a simple language that nevertheless has side effects, global state, and timing effects is
-- included in the examples directory.
--
-- = Profiles
-- To run your kernel, you will need an IPython profile that causes
-- the frontend to run it. To generate a fresh profile, run the command
-- = Profiles To run your kernel, you will need an IPython profile that causes the frontend to run
-- it. To generate a fresh profile, run the command
--
-- > ipython profile create NAME
--
-- This will create a fresh IPython profile in @~\/.ipython\/profile_NAME@.
-- This profile must be modified in two ways:
-- This will create a fresh IPython profile in @~\/.ipython\/profile_NAME@. This profile must be
-- modified in two ways:
--
-- 1. It needs to run your kernel instead of the default ipython
-- 2. It must have message signing turned off, because 'easyKernel' doesn't support it
-- 1. It needs to run your kernel instead of the default ipython 2. It must have message signing
-- turned off, because 'easyKernel' doesn't support it
--
-- == Setting the executable
-- To set the executable, modify the configuration object's
-- == Setting the executable To set the executable, modify the configuration object's
-- @KernelManager.kernel_cmd@ property. For example:
--
-- > c.KernelManager.kernel_cmd = ['my_kernel', '{connection_file}']
......@@ -44,7 +38,6 @@
-- Consult the IPython documentation along with the generated profile
-- source code for further configuration of the frontend, including
-- syntax highlighting, logos, help text, and so forth.
module IHaskell.IPython.EasyKernel (easyKernel, installProfile, KernelConfig(..)) where
import Data.Aeson (decode)
......@@ -64,59 +57,54 @@ import qualified Data.Text as T
import IHaskell.IPython.Kernel
import IHaskell.IPython.Message.UUID as UUID
import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getHomeDirectory)
import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist,
getHomeDirectory)
import System.FilePath ((</>))
import System.Exit (exitSuccess)
import System.IO (openFile, IOMode(ReadMode))
-- | The kernel configuration specifies the behavior that is specific
-- to your language. The type parameters provide the monad in which
-- your kernel will run, the type of intermediate outputs from running
-- cells, and the type of final results of cells, respectively.
data KernelConfig m output result = KernelConfig
{ languageName :: String
-- ^ The name of the language. This field is used to calculate
-- the name of the profile, so it should contain characters that
-- are reasonable to have in file names.
, languageVersion :: [Int] -- ^ The version of the language
, profileSource :: IO (Maybe FilePath)
-- ^ Determine the source of a profile to install using
-- 'installProfile'. The source should be a tarball whose contents
-- will be unpacked directly into the profile directory. For
-- example, the file whose name is @ipython_config.py@ in the
-- tar file for a language named @lang@ will end up in
-- | The kernel configuration specifies the behavior that is specific to your language. The type
-- parameters provide the monad in which your kernel will run, the type of intermediate outputs from
-- running cells, and the type of final results of cells, respectively.
data KernelConfig m output result =
KernelConfig
{
-- | The name of the language. This field is used to calculate the name of the profile,
-- so it should contain characters that are reasonable to have in file names.
languageName :: String
-- | The version of the language
, languageVersion :: [Int]
-- | Determine the source of a profile to install using 'installProfile'. The source should be a
-- tarball whose contents will be unpacked directly into the profile directory. For example, the
-- file whose name is @ipython_config.py@ in the tar file for a language named @lang@ will end up in
-- @~/.ipython/profile_lang/ipython_config.py@.
, displayOutput :: output -> [DisplayData] -- ^ How to render intermediate output
, displayResult :: result -> [DisplayData] -- ^ How to render final cell results
, profileSource :: IO (Maybe FilePath)
-- | How to render intermediate output
, displayOutput :: output -> [DisplayData]
-- | How to render final cell results
, displayResult :: result -> [DisplayData]
-- | Perform completion. The returned tuple consists of the matches, the matched text, and the
-- completion text. The arguments are the code in the cell, the current line as text, and the column
-- at which the cursor is placed.
, completion :: T.Text -> T.Text -> Int -> Maybe ([T.Text], T.Text, T.Text)
-- ^ Perform completion. The returned tuple consists of the matches,
-- the matched text, and the completion text. The arguments are the
-- code in the cell, the current line as text, and the column at
-- which the cursor is placed.
-- | Return the information or documentation for its argument. The returned tuple consists of the
-- name, the documentation, and the type, respectively.
, objectInfo :: T.Text -> Maybe (T.Text, T.Text, T.Text)
-- ^ Return the information or documentation for its argument. The
-- returned tuple consists of the name, the documentation, and the
-- type, respectively.
-- | Execute a cell. The arguments are the contents of the cell, an IO action that will clear the
-- current intermediate output, and an IO action that will add a new item to the intermediate
-- output. The result consists of the actual result, the status to be sent to IPython, and the
-- contents of the pager. Return the empty string to indicate that there is no pager output. Errors
-- should be handled by defining an appropriate error constructor in your result type.
, run :: T.Text -> IO () -> (output -> IO ()) -> m (result, ExecuteReplyStatus, String)
-- ^ Execute a cell. The arguments are the contents of the cell, an
-- IO action that will clear the current intermediate output, and an
-- IO action that will add a new item to the intermediate
-- output. The result consists of the actual result, the status to
-- be sent to IPython, and the contents of the pager. Return the
-- empty string to indicate that there is no pager output. Errors
-- should be handled by defining an appropriate error constructor in
-- your result type.
, debug :: Bool -- ^ Whether to print extra debugging information to
-- the console
}
-- | Attempt to install the IPython profile from the .tar file
-- indicated by the 'profileSource' field of the configuration, if it
-- is not already installed.
-- the console | Attempt to install the IPython profile from the .tar file indicated by the
-- 'profileSource' field of the configuration, if it is not already installed.
installProfile :: MonadIO m => KernelConfig m output result -> m ()
installProfile config = do
installed <- isInstalled
when (not installed) $ do
unless installed $ do
profSrc <- liftIO $ profileSource config
case profSrc of
Nothing -> liftIO (putStrLn "No IPython profile is installed or specified")
......@@ -124,7 +112,8 @@ installProfile config = do
profExists <- liftIO $ doesFileExist tar
profTgt <- profDir
if profExists
then do liftIO $ createDirectoryIfMissing True profTgt
then do
liftIO $ createDirectoryIfMissing True profTgt
liftIO $ Tar.extract profTgt tar
else liftIO . putStrLn $
"The supplied profile source '" ++ tar ++ "' does not exist"
......@@ -153,28 +142,29 @@ createReplyHeader parent = do
let repType = fromMaybe err (replyType $ msgType parent)
err = error $ "No reply for message " ++ show (msgType parent)
return MessageHeader {
identifiers = identifiers parent,
parentHeader = Just parent,
metadata = Map.fromList [],
messageId = newMessageId,
sessionId = sessionId parent,
username = username parent,
msgType = repType
return
MessageHeader
{ identifiers = identifiers parent
, parentHeader = Just parent
, metadata = Map.fromList []
, messageId = newMessageId
, sessionId = sessionId parent
, username = username parent
, msgType = repType
}
-- | Execute an IPython kernel for a config. Your 'main' action should
-- call this as the last thing it does.
-- | Execute an IPython kernel for a config. Your 'main' action should call this as the last thing
-- it does.
easyKernel :: (MonadIO m)
=> FilePath -- ^ The connection file provided by the IPython frontend
-> KernelConfig m output result -- ^ The kernel configuration specifying how to react to messages
-> KernelConfig m output result -- ^ The kernel configuration specifying how to react to
-- messages
-> m ()
easyKernel profileFile config = do
prof <- liftIO $ getProfile profileFile
zmq@(Channels shellReqChan shellRepChan ctrlReqChan ctrlRepChan iopubChan _) <-
liftIO $ serveProfile prof False
zmq@(Channels shellReqChan shellRepChan ctrlReqChan ctrlRepChan iopubChan _) <- liftIO $ serveProfile
prof
False
execCount <- liftIO $ newMVar 0
forever $ do
req <- liftIO $ readChan shellReqChan
......@@ -183,7 +173,6 @@ easyKernel profileFile config = do
reply <- replyTo config execCount zmq req repHeader
liftIO $ writeChan shellRepChan reply
replyTo :: MonadIO m
=> KernelConfig m output result
-> MVar Integer
......@@ -192,28 +181,31 @@ replyTo :: MonadIO m
-> MessageHeader
-> m Message
replyTo config _ _ KernelInfoRequest{} replyHeader =
return KernelInfoReply
return
KernelInfoReply
{ header = replyHeader
, language = languageName config
, versionList = languageVersion config
}
replyTo config _ interface ShutdownRequest{restartPending=pending} replyHeader = do
replyTo config _ interface ShutdownRequest { restartPending = pending } replyHeader = do
liftIO $ writeChan (shellReplyChannel interface) $ ShutdownReply replyHeader pending
liftIO exitSuccess
replyTo config execCount interface req@ExecuteRequest { getCode = code } replyHeader = do
let send msg = writeChan (iopubChannel interface) msg
let send = writeChan (iopubChannel interface)
busyHeader <- dupHeader replyHeader StatusMessage
liftIO . send $ PublishStatus busyHeader Busy
outputHeader <- dupHeader replyHeader DisplayDataMessage
(res, replyStatus, pagerOut) <-
let clearOutput = do
clearHeader <- dupHeader replyHeader ClearOutputMessage
(res, replyStatus, pagerOut) <- let clearOutput = do
clearHeader <- dupHeader replyHeader
ClearOutputMessage
send $ ClearOutput clearHeader False
sendOutput x =
send $ PublishDisplayData outputHeader (languageName config)
send $ PublishDisplayData
outputHeader
(languageName config)
(displayOutput config x)
in run config code clearOutput sendOutput
liftIO . send $ PublishDisplayData outputHeader (languageName config) (displayResult config res)
......@@ -222,45 +214,24 @@ replyTo config execCount interface req@ExecuteRequest { getCode = code } replyHe
idleHeader <- dupHeader replyHeader StatusMessage
liftIO . send $ PublishStatus idleHeader Idle
liftIO $ modifyMVar_ execCount (return . (+1))
liftIO $ modifyMVar_ execCount (return . (+ 1))
counter <- liftIO $ readMVar execCount
return ExecuteReply
return
ExecuteReply
{ header = replyHeader
, pagerOutput = pagerOut
, executionCounter = fromIntegral counter
, status = replyStatus
}
replyTo config _ _ req@CompleteRequest{} replyHeader = do
replyTo config _ _ req@CompleteRequest{} replyHeader =
-- TODO: FIX
error "Unimplemented in IPython 3.0"
{-
let code = getCode req
line = getCodeLine req
col = getCursorPos req
return $ case completion config code line col of
Nothing ->
CompleteReply
{ header = replyHeader
, completionMatches = []
, completionMatchedText = ""
, completionText = ""
, completionStatus = False
}
Just (matches, matchedText, cmplText) ->
CompleteReply
{ header = replyHeader
, completionMatches = matches
, completionMatchedText = matchedText
, completionText = cmplText
, completionStatus = True
}
-}
replyTo config _ _ ObjectInfoRequest { objectName = obj } replyHeader =
return $ case objectInfo config obj of
return $
case objectInfo config obj of
Just (name, docs, ty) -> ObjectInfoReply
{ header = replyHeader
, objectName = obj
......@@ -281,8 +252,8 @@ replyTo _ _ _ msg _ = do
liftIO $ print msg
return msg
dupHeader :: MonadIO m => MessageHeader -> MessageType -> m MessageHeader
dupHeader hdr mtype =
do uuid <- liftIO UUID.random
return hdr { messageId = uuid , msgType = mtype }
do
uuid <- liftIO UUID.random
return hdr { messageId = uuid, msgType = mtype }
ipython-kernel/src/IHaskell/IPython/Kernel.hs
View file @ c53f70d8
-- | 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 IHaskell.IPython.Kernel (
module X,
) where
-- | 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 IHaskell.IPython.Kernel (module X) where
import IHaskell.IPython.Types as X
import IHaskell.IPython.Message.Writer as X
......
ipython-kernel/src/IHaskell/IPython/Message/Parser.hs
View file @ c53f70d8
{-# 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.
-- 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 IHaskell.IPython.Message.Parser (parseMessage) where
import Data.Aeson ((.:), decode, Result(..), Object)
......@@ -17,9 +18,7 @@ import IHaskell.IPython.Types
type LByteString = Lazy.ByteString
----- External interface -----
-- | Parse a message from its ByteString components into a Message.
-- --- 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.
......@@ -32,16 +31,15 @@ parseMessage idents headerData parentHeader metadata content =
messageWithoutHeader = parser messageType $ Lazy.fromStrict content
in messageWithoutHeader { header = header }
----- Module internals -----
-- | Parse a header from its ByteString components into a MessageHeader.
-- --- 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
MessageHeader
{ identifiers = idents
, parentHeader = parentResult
, metadata = metadataMap
, messageId = messageUUID
......@@ -50,8 +48,8 @@ parseHeader idents headerData parentHeader metadata =
, 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.
-- 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
......@@ -71,8 +69,8 @@ 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.
-> 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
......@@ -85,13 +83,12 @@ parser CommCloseMessage = commCloseParser
parser HistoryRequestMessage = historyRequestParser
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.
-- | 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:
-- | 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.
......@@ -107,7 +104,8 @@ executeRequestParser content =
return (code, silent, storeHistory, allowStdin)
Just decoded = decode content
Success (code, silent, storeHistory, allowStdin) = parse parser decoded
in ExecuteRequest { header = noHeader
in ExecuteRequest
{ header = noHeader
, getCode = code
, getSilent = silent
, getAllowStdin = allowStdin
......@@ -147,7 +145,6 @@ objectInfoRequestParser = requestParser $ \obj -> do
dlevel <- obj .: "detail_level"
return $ ObjectInfoRequest noHeader oname dlevel
shutdownRequestParser :: LByteString -> Message
shutdownRequestParser = requestParser $ \obj -> do
code <- obj .: "restart"
......
ipython-kernel/src/IHaskell/IPython/Message/UUID.hs
View file @ c53f70d8
-- | Description : UUID generator and data structure
--
-- Generate, parse, and pretty print UUIDs for use with IPython.
module IHaskell.IPython.Message.UUID (
UUID,
random, randoms,
) where
module IHaskell.IPython.Message.UUID (UUID, random, randoms) where
import Control.Monad (mzero, replicateM)
import Control.Applicative ((<$>))
......@@ -12,15 +9,15 @@ import Data.Text (pack)
import Data.Aeson
import Data.UUID.V4 (nextRandom)
-- 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, Ord)
data UUID =
-- 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.
UUID String
deriving (Show, Read, Eq, Ord)
-- | Generate a list of random UUIDs.
randoms :: Int -- ^ Number of UUIDs to generate.
......
ipython-kernel/src/IHaskell/IPython/Message/Writer.hs
View file @ c53f70d8
{-# LANGUAGE OverloadedStrings #-}
-- | Description : @ToJSON@ for Messages
--
-- This module contains the @ToJSON@ instance for @Message@.
module IHaskell.IPython.Message.Writer (
ToJSON(..)
) where
module IHaskell.IPython.Message.Writer (ToJSON(..)) where
import Data.Aeson
import Data.Map (Map)
......@@ -19,99 +18,86 @@ import IHaskell.IPython.Types
-- Convert message bodies into JSON.
instance ToJSON Message where
toJSON KernelInfoReply{ versionList = vers, language = language } = object [
"protocol_version" .= string "5.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" .=
toJSON KernelInfoReply { versionList = vers, language = language } =
object ["protocol_version" .= string "5.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
else [object ["source" .= string "page", "text" .= pager]]
, "user_variables" .= emptyMap
, "user_expressions" .= emptyMap
]
toJSON PublishStatus{ executionState = executionState } = object [
"execution_state" .= executionState
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 _ matches start end metadata status) =
object
[ "matches" .= matches
, "cursor_start" .= start
, "cursor_end" .= end
, "metadata" .= metadata
, "status" .= if status
then string "ok"
else "error"
]
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 o@ObjectInfoReply{} =
object
[ "oname" .=
objectName o
, "found" .= objectFound o
, "ismagic" .= False
, "isalias" .= False
, "type_name" .= objectTypeString o
, "docstring" .= objectDocString o
]
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 _ matches start end metadata status) = object [
"matches" .= matches,
"cursor_start" .= start,
"cursor_end" .= end,
"metadata" .= metadata,
"status" .= if status 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 ShutdownReply{restartPending = restart} = object [
"restart" .= restart
]
toJSON ClearOutput { wait = wait } =
object ["wait" .= wait]
toJSON ClearOutput{wait = wait} = object [
"wait" .= wait
]
toJSON RequestInput{inputPrompt = prompt} = object [
"prompt" .= prompt
]
toJSON RequestInput { inputPrompt = prompt } =
object ["prompt" .= prompt]
toJSON req@CommOpen{} = object [
"comm_id" .= commUuid req,
"target_name" .= commTargetName req,
"data" .= commData req
]
toJSON req@CommOpen{} =
object ["comm_id" .= commUuid req, "target_name" .= commTargetName req, "data" .= commData req]
toJSON req@CommData{} = object [
"comm_id" .= commUuid req,
"data" .= commData req
]
toJSON req@CommData{} =
object ["comm_id" .= commUuid req, "data" .= commData req]
toJSON req@CommClose{} = object [
"comm_id" .= commUuid req,
"data" .= commData req
]
toJSON req@CommClose{} =
object ["comm_id" .= commUuid req, "data" .= commData req]
toJSON req@HistoryReply{} = object [ "history" .= map tuplify (historyReply req) ]
where tuplify (HistoryReplyElement sess linum res) = (sess, linum, case res of
toJSON req@HistoryReply{} =
object ["history" .= map tuplify (historyReply req)]
where
tuplify (HistoryReplyElement sess linum res) = (sess, linum, case res of
Left inp -> toJSON inp
Right (inp, out) -> toJSON out)
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"
......@@ -129,7 +115,6 @@ displayDataToJson (DisplayData mimeType dataStr) =
pack (show mimeType) .= String dataStr
----- Constants -----
emptyMap :: Map String String
emptyMap = mempty
......
ipython-kernel/src/IHaskell/IPython/Stdin.hs
View file @ c53f70d8
{-# 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 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.
-- 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.
-- 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, 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 IHaskell.IPython.Stdin (
fixStdin,
recordParentHeader,
recordKernelProfile
) where
-- 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 IHaskell.IPython.Stdin (fixStdin, recordParentHeader, recordKernelProfile) where
import Control.Concurrent
import Control.Applicative ((<$>))
......@@ -53,9 +43,8 @@ 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.
-- | 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.
......@@ -78,6 +67,7 @@ stdinOnce dir = do
hDuplicateTo newStdin stdin
loop stdinInput oldStdin newStdin
where
loop stdinInput oldStdin newStdin = do
let FileHandle _ mvar = stdin
......@@ -98,14 +88,14 @@ getInputLine dir = do
-- 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 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
......
ipython-kernel/src/IHaskell/IPython/Types.hs
View file @ c53f70d8
{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, DeriveGeneric #-}
-- | This module contains all types used to create an IPython language
-- kernel.
-- | This module contains all types used to create an IPython language kernel.
module IHaskell.IPython.Types (
-- * IPython kernel profile
Profile(..),
......@@ -17,7 +17,8 @@ module IHaskell.IPython.Types (
Username(..),
Metadata(..),
MessageType(..),
Width(..), Height(..),
Width(..),
Height(..),
StreamType(..),
ExecutionState(..),
ExecuteReplyStatus(..),
......@@ -28,8 +29,7 @@ module IHaskell.IPython.Types (
-- ** IPython display data message
DisplayData(..),
MimeType(..),
extractPlain
extractPlain,
) where
import Data.Aeson
......@@ -45,7 +45,8 @@ import Data.Typeable
import Data.List (find)
import Data.Map (Map)
-------------------- IPython Kernel Profile Types ----------------------
------------------ IPython Kernel Profile Types ----------------------
--
-- | A TCP port.
type Port = Int
......@@ -57,7 +58,9 @@ 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.
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.
......@@ -107,15 +110,19 @@ instance FromJSON Transport where
instance ToJSON Transport where
toJSON TCP = String "tcp"
-------------------- IPython Kernelspec Types ----------------------
data KernelSpec = KernelSpec {
kernelDisplayName :: String, -- ^ Name shown to users to describe this kernel (e.g. "Haskell")
kernelLanguage :: String, -- ^ Name for the kernel; unique kernel identifier (e.g. "haskell")
kernelCommand :: [String] -- ^ Command to run to start the kernel. One of the strings may be
-- @"{connection_file}"@, which will be replaced by the path to a
-- kernel profile file (see @Profile@) when the command is run.
} deriving (Eq, Show)
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")
, kernelLanguage :: String
-- | Command to run to start the kernel. One of the strings maybe @"{connection_file}"@, which will
-- be replaced by the path to a kernel profile file (see @Profile@) when the command is run.
, kernelCommand :: [String]
}
deriving (Eq, Show)
instance ToJSON KernelSpec where
toJSON kernelspec = object
......@@ -124,28 +131,30 @@ instance ToJSON KernelSpec where
, "language" .= kernelLanguage kernelspec
]
-------------------- IPython Message Types ----------------------
------------------ 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.
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,
"version" .= ("5.0" :: String),
"msg_type" .= showMessageType (msgType header)
toJSON header = object
[ "msg_id" .= messageId header
, "session" .= sessionId header
, "username" .= username header
, "version" .= ("5.0" :: String)
, "msg_type" .= showMessageType (msgType header)
]
-- | A username for the source of a message.
......@@ -235,177 +244,161 @@ instance FromJSON MessageType where
_ -> fail ("Unknown message type: " ++ show s)
parseJSON _ = fail "Must be a string."
-- | A message used to communicate with the IPython frontend.
data Message
data Message =
-- | A request from a frontend for information about the kernel.
= KernelInfoRequest { header :: MessageHeader }
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"
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 :: Text, -- ^ 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 :: [Text], -- ^ Unused.
getUserExpressions :: [Text] -- ^ Unused.
ExecuteRequest
{ header :: MessageHeader
, getCode :: Text -- ^ 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 :: [Text] -- ^ Unused.
, getUserExpressions :: [Text] -- ^ 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.
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.
|
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.
|
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.
|
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.
|
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.
|
PublishInput
{ header :: MessageHeader
, inCode :: String -- ^ Submitted input code.
, executionCount :: Int -- ^ Which input this is.
}
| CompleteRequest {
header :: MessageHeader,
getCode :: Text, {- ^
|
CompleteRequest
{ header :: MessageHeader
, getCode :: Text {- ^
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 @code@ -}
getCursorPos :: Int -- ^ Position of the cursor in unicode characters. json field @cursor_pos@
, getCursorPos :: Int -- ^ Position of the cursor in unicode characters. json field
-- @cursor_pos@
}
| CompleteReply {
header :: MessageHeader,
completionMatches :: [Text],
completionCursorStart :: Int,
completionCursorEnd :: Int,
completionMetadata :: Metadata,
completionStatus :: Bool
|
CompleteReply
{ header :: MessageHeader
, completionMatches :: [Text]
, completionCursorStart :: Int
, completionCursorEnd :: Int
, completionMetadata :: Metadata
, completionStatus :: Bool
}
| ObjectInfoRequest {
header :: MessageHeader,
objectName :: Text, -- ^ 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??.
|
ObjectInfoRequest
{ header :: MessageHeader
-- | Name of object being searched for.
, objectName :: Text
-- | Level of detail desired (defaults to 0). 0 is equivalent to foo?, 1 is equivalent to foo??.
, detailLevel :: Int
}
| ObjectInfoReply {
header :: MessageHeader,
objectName :: Text, -- ^ Name of object which was searched for.
objectFound :: Bool, -- ^ Whether the object was found.
objectTypeString :: Text, -- ^ Object type.
objectDocString :: Text
|
ObjectInfoReply
{ header :: MessageHeader
, objectName :: Text -- ^ Name of object which was searched for.
, objectFound :: Bool -- ^ Whether the object was found.
, objectTypeString :: Text -- ^ Object type.
, objectDocString :: Text
}
| ShutdownRequest {
header :: MessageHeader,
restartPending :: Bool -- ^ Whether this shutdown precedes a restart.
}
| ShutdownReply {
header :: MessageHeader,
restartPending :: Bool -- ^ Whether this shutdown precedes a restart.
|
ShutdownRequest
{ 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.
|
ShutdownReply
{ header :: MessageHeader
, restartPending :: Bool -- ^ Whether this shutdown precedes a restart.
}
| RequestInput {
header :: MessageHeader,
inputPrompt :: String
|
ClearOutput
{ header :: MessageHeader
, wait :: Bool -- ^ Whether to wait to redraw until there is more output.
}
| InputReply {
header :: MessageHeader,
inputValue :: String
| RequestInput { header :: MessageHeader, inputPrompt :: String }
| InputReply { header :: MessageHeader, inputValue :: String }
|
CommOpen
{ header :: MessageHeader
, commTargetName :: String
, commUuid :: UUID
, commData :: Value
}
| CommOpen {
header :: MessageHeader,
commTargetName :: String,
commUuid :: UUID,
commData :: Value
| CommData { header :: MessageHeader, commUuid :: UUID, commData :: Value }
| CommClose { header :: MessageHeader, commUuid :: UUID, commData :: Value }
|
HistoryRequest
{ header :: MessageHeader
, historyGetOutput :: Bool -- ^ If True, also return output history in the resulting
-- dict.
, historyRaw :: Bool -- ^ If True, return the raw input history, else the
-- transformed input.
, historyAccessType :: HistoryAccessType -- ^ What history is being requested.
}
| CommData {
header :: MessageHeader,
commUuid :: UUID,
commData :: Value
}
| CommClose {
header :: MessageHeader,
commUuid :: UUID,
commData :: Value
}
| HistoryRequest {
header :: MessageHeader,
historyGetOutput :: Bool, -- ^ If True, also return output history in the resulting dict.
historyRaw :: Bool, -- ^ If True, return the raw input history, else the transformed input.
historyAccessType :: HistoryAccessType -- ^ What history is being requested.
}
| HistoryReply {
header :: MessageHeader,
historyReply :: [HistoryReplyElement]
}
| HistoryReply { header :: MessageHeader, historyReply :: [HistoryReplyElement] }
| SendNothing -- Dummy message; nothing is sent.
deriving Show
-- | Ways in which the frontend can request history.
-- TODO: Implement fields as described in messaging spec.
-- | Ways in which the frontend can request history. TODO: Implement fields as described in
-- messaging spec.
data HistoryAccessType = HistoryRange
| HistoryTail
| HistorySearch
deriving (Eq, Show)
-- | Reply to history requests.
data HistoryReplyElement = HistoryReplyElement { historyReplySession :: Int
data HistoryReplyElement =
HistoryReplyElement
{ historyReplySession :: Int
, historyReplyLineNumber :: Int
, historyReplyContent :: Either String (String, String)
}
deriving (Eq, Show)
-- | Possible statuses in the execution reply messages.
data ExecuteReplyStatus = Ok | Err | Abort
data ExecuteReplyStatus = Ok
| Err
| Abort
instance Show ExecuteReplyStatus where
show Ok = "ok"
......@@ -413,10 +406,15 @@ instance Show ExecuteReplyStatus where
show Abort = "abort"
-- | The execution state of the kernel.
data ExecutionState = Busy | Idle | Starting deriving Show
data ExecutionState = Busy
| Idle
| Starting
deriving Show
-- | Input and output streams.
data StreamType = Stdin | Stdout deriving Show
data StreamType = Stdin
| Stdout
deriving Show
-- | Get the reply message type for a request message type.
replyType :: MessageType -> Maybe MessageType
......@@ -429,11 +427,11 @@ replyType HistoryRequestMessage = Just HistoryReplyMessage
replyType _ = Nothing
-- | Data for display: a string with associated MIME type.
data DisplayData = DisplayData MimeType Text deriving (Typeable, Generic)
data DisplayData = DisplayData MimeType Text
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.
-- 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"
......@@ -441,12 +439,16 @@ instance Show DisplayData where
instance Serialize Text where
put str = put (Text.encodeUtf8 str)
get = Text.decodeUtf8 <$> get
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
......
ipython-kernel/src/IHaskell/IPython/ZeroMQ.hs
View file @ c53f70d8
{-# 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 IHaskell.IPython.ZeroMQ (
ZeroMQInterface (..),
ZeroMQStdin(..),
serveProfile,
serveStdin,
) where
-- 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 IHaskell.IPython.ZeroMQ (ZeroMQInterface(..), ZeroMQStdin(..), serveProfile, serveStdin) where
import qualified Data.ByteString.Lazy as LBS
import Data.ByteString (ByteString)
......@@ -26,30 +22,37 @@ import IHaskell.IPython.Types
import IHaskell.IPython.Message.Parser
import IHaskell.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.
-- | 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.
hmacKey :: ByteString -- ^ Key used to sign messages.
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.
, shellReplyChannel :: Chan Message
-- | This channel is a duplicate of the shell request channel, though using a different backend
-- socket.
, controlRequestChannel :: Chan Message
-- | This channel is a duplicate of the shell reply channel, though using a different backend
-- socket.
, controlReplyChannel :: Chan Message
-- | Writing to this channel sends an iopub message to the frontend.
, iopubChannel :: Chan Message
-- | Key used to sign messages.
, hmacKey :: ByteString
}
data ZeroMQStdin = StdinChannel {
stdinRequestChannel :: Chan Message,
stdinReplyChannel :: Chan Message
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.
-- | 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.
-> Bool -- ^ Print debug output
-> IO ZeroMQInterface -- ^ The Message-channel based interface to the sockets.
......@@ -63,18 +66,17 @@ serveProfile profile debug = do
let channels = Channels shellReqChan shellRepChan controlReqChan controlRepChan iopubChan
(signatureKey profile)
-- Create the context in a separate thread that never finishes. If
-- withContext or withSocket complete, the context or socket become invalid.
-- 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 debug channels
forkIO $ serveSocket context Router (shellPort profile) $ shell debug 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.
-- 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 debug channels
return channels
......@@ -84,8 +86,8 @@ 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.
-- 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
......@@ -97,9 +99,8 @@ serveStdin profile = do
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.
-- | 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
......@@ -115,9 +116,9 @@ heartbeat _ socket = do
-- 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.
-- | 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 :: Bool -> ZeroMQInterface -> Socket Router -> IO ()
shell debug channels socket = do
-- Receive a message and write it to the interface channel.
......@@ -130,9 +131,9 @@ shell debug channels socket = do
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.
-- | 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 :: Bool -> ZeroMQInterface -> Socket Router -> IO ()
control debug channels socket = do
-- Receive a message and write it to the interface channel.
......@@ -145,9 +146,8 @@ control debug channels socket = do
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.
-- | Send messages via the iopub channel. | This reads messages from the ZeroMQ iopub interface
-- channel | and then writes the messages to the socket.
iopub :: Bool -> ZeroMQInterface -> Socket Pub -> IO ()
iopub debug channels socket =
readChan (iopubChannel channels) >>= sendMessage debug (hmacKey channels) socket
......@@ -179,8 +179,8 @@ receiveMessage debug socket = do
-- 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.
-- 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
......@@ -189,9 +189,8 @@ receiveMessage debug socket = do
return $ line : remaining
else return []
-- | Encode a message in the IPython ZeroMQ communication protocol
-- and send it through the provided socket. Sign it using HMAC
-- with SHA-256 using the provided key.
-- | Encode a message in the IPython ZeroMQ communication protocol and send it through the provided
-- socket. Sign it using HMAC with SHA-256 using the provided key.
sendMessage :: Sender a => Bool -> ByteString -> Socket a -> Message -> IO ()
sendMessage _ _ _ SendNothing = return ()
sendMessage debug hmacKey socket message = do
......
verify_formatting.py
View file @ c53f70d8
......@@ -44,7 +44,12 @@ except:
# Find all the source files
sources = []
for root, dirnames, filenames in os.walk("src"):
for source_dir in ["src", "ipython-kernel"]:
for root, dirnames, filenames in os.walk(source_dir):
# Skip cabal dist directories
if "dist" in root:
continue
for filename in filenames:
if filename.endswith(".hs"):
sources.append(os.path.join(root, filename))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment