module IHaskell.IPython.Types (
Profile(..),
Transport(..),
Port(..),
IP(..),
Message(..),
MessageHeader(..),
Username(..),
Metadata(..),
MessageType(..),
Width(..), Height(..),
StreamType(..),
ExecutionState(..),
ExecuteReplyStatus(..),
replyType,
DisplayData(..),
MimeType(..),
extractPlain
) where
import Data.Aeson
import Control.Applicative ((<$>), (<*>))
import Data.ByteString (ByteString)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Data.Text (Text)
import Data.Serialize
import IHaskell.IPython.Message.UUID
import GHC.Generics (Generic)
import Data.Typeable
import Data.List (find)
import Data.Map (Map)
type Port = Int
type IP = String
data Transport
= TCP
deriving (Show, Read)
data Profile = Profile {
ip :: IP,
transport :: Transport,
stdinPort :: Port,
controlPort :: Port,
hbPort :: Port,
shellPort :: Port,
iopubPort :: Port,
key :: Text
} deriving (Show, Read)
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 mech) =
case mech of
"tcp" -> return TCP
_ -> fail $ "Unknown transport mechanism " ++ Text.unpack mech
parseJSON _ = fail "Expected JSON string as transport."
instance ToJSON Transport where
toJSON TCP = String "tcp"
data MessageHeader = MessageHeader {
identifiers :: [ByteString],
parentHeader :: Maybe MessageHeader,
metadata :: Metadata,
messageId :: UUID,
sessionId :: UUID,
username :: Username,
msgType :: MessageType
} deriving (Show, Read)
instance ToJSON MessageHeader where
toJSON header = object [
"msg_id" .= messageId header,
"session" .= sessionId header,
"username" .= username header,
"msg_type" .= showMessageType (msgType header)
]
type Username = Text
type Metadata = Map Text Text
data MessageType = KernelInfoReplyMessage
| KernelInfoRequestMessage
| ExecuteReplyMessage
| ExecuteRequestMessage
| StatusMessage
| StreamMessage
| DisplayDataMessage
| OutputMessage
| InputMessage
| CompleteRequestMessage
| CompleteReplyMessage
| ObjectInfoRequestMessage
| ObjectInfoReplyMessage
| ShutdownRequestMessage
| ShutdownReplyMessage
| ClearOutputMessage
| InputRequestMessage
| InputReplyMessage
| CommOpenMessage
| CommDataMessage
| CommCloseMessage
deriving (Show, Read, Eq)
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"
showMessageType CommOpenMessage = "comm_open"
showMessageType CommDataMessage = "comm_msg"
showMessageType CommCloseMessage = "comm_close"
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
"comm_open" -> return CommOpenMessage
"comm_msg" -> return CommDataMessage
"comm_close" -> return CommCloseMessage
_ -> fail ("Unknown message type: " ++ show s)
parseJSON _ = fail "Must be a string."
data Message
= KernelInfoRequest { header :: MessageHeader }
| KernelInfoReply {
header :: MessageHeader,
versionList :: [Int],
language :: String
}
| ExecuteRequest {
header :: MessageHeader,
getCode :: Text,
getSilent :: Bool,
getStoreHistory :: Bool,
getAllowStdin :: Bool,
getUserVariables :: [Text],
getUserExpressions :: [Text]
}
| ExecuteReply {
header :: MessageHeader,
status :: ExecuteReplyStatus,
pagerOutput :: String,
executionCounter :: Int
}
| PublishStatus {
header :: MessageHeader,
executionState :: ExecutionState
}
| PublishStream {
header :: MessageHeader,
streamType :: StreamType,
streamContent :: String
}
| PublishDisplayData {
header :: MessageHeader,
source :: String,
displayData :: [DisplayData]
}
| PublishOutput {
header :: MessageHeader,
reprText :: String,
executionCount :: Int
}
| PublishInput {
header :: MessageHeader,
inCode :: String,
executionCount :: Int
}
| CompleteRequest {
header :: MessageHeader,
getCode :: Text,
getCodeLine :: Text,
getCursorPos :: Int
}
| CompleteReply {
header :: MessageHeader,
completionMatches :: [Text],
completionMatchedText :: Text,
completionText :: Text,
completionStatus :: Bool
}
| ObjectInfoRequest {
header :: MessageHeader,
objectName :: Text,
detailLevel :: Int
}
| ObjectInfoReply {
header :: MessageHeader,
objectName :: Text,
objectFound :: Bool,
objectTypeString :: Text,
objectDocString :: Text
}
| ShutdownRequest {
header :: MessageHeader,
restartPending :: Bool
}
| ShutdownReply {
header :: MessageHeader,
restartPending :: Bool
}
| ClearOutput {
header :: MessageHeader,
wait :: Bool
}
| RequestInput {
header :: MessageHeader,
inputPrompt :: String
}
| InputReply {
header :: MessageHeader,
inputValue :: String
}
| CommOpen {
header :: MessageHeader,
commTargetName :: String,
commUuid :: UUID,
commData :: Value
}
| CommData {
header :: MessageHeader,
commUuid :: UUID,
commData :: Value
}
| CommClose {
header :: MessageHeader,
commUuid :: UUID,
commData :: Value
}
| SendNothing
deriving Show
data ExecuteReplyStatus = Ok | Err | Abort
instance Show ExecuteReplyStatus where
show Ok = "ok"
show Err = "error"
show Abort = "abort"
data ExecutionState = Busy | Idle | Starting deriving Show
data StreamType = Stdin | Stdout deriving Show
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 DisplayData = DisplayData MimeType Text deriving (Typeable, Generic)
instance Show DisplayData where
show _ = "DisplayData"
instance Serialize Text where
put str = put (Text.encodeUtf8 str)
get = Text.decodeUtf8 <$> get
instance Serialize DisplayData
instance Serialize MimeType
type Width = Int
type Height = Int
data MimeType = PlainText
| MimeHtml
| MimePng Width Height
| MimeJpg Width Height
| MimeSvg
| MimeLatex
| MimeJavascript
deriving (Eq, Typeable, Generic)
extractPlain :: [DisplayData] -> String
extractPlain disps =
case find isPlain disps of
Nothing -> ""
Just (DisplayData PlainText bytestr) -> Text.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"
show MimeJavascript = "application/javascript"