{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, CPP #-}
{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-name-shadowing #-}

-- | 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 IHaskell.IPython.Message.Parser (parseMessage) where

import           Data.Aeson ((.:), (.:?), (.!=), decode, FromJSON, Result(..), Object, Value(..))
import           Data.Aeson.Types (Parser, parse, parseEither)
import           Data.ByteString hiding (unpack)
import qualified Data.ByteString.Lazy as Lazy
import           Data.Maybe (fromMaybe)
import           Data.Text (unpack)
import           Debug.Trace
import           IHaskell.IPython.Types

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap   as KM
import           Data.Aeson.Key
#else
import           Data.HashMap.Strict as HM
#endif

type LByteString = Lazy.ByteString

-- --- External interface ----- | Parse a message from its ByteString components into a Message.
--   See https://jupyter-client.readthedocs.io/en/stable/messaging.html#the-wire-protocol
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.
             -> [ByteString] -- ^ Extra raw data buffer(s)
             -> Message      -- ^ A parsed message.
parseMessage :: [ByteString]
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> [ByteString]
-> Message
parseMessage [ByteString]
idents ByteString
headerData ByteString
parentHeader ByteString
metadata ByteString
content [ByteString]
buffers =
  let header :: MessageHeader
header = [ByteString]
-> ByteString
-> ByteString
-> ByteString
-> [ByteString]
-> MessageHeader
parseHeader [ByteString]
idents ByteString
headerData ByteString
parentHeader ByteString
metadata [ByteString]
buffers
      messageType :: MessageType
messageType = MessageHeader -> MessageType
mhMsgType MessageHeader
header
      messageWithoutHeader :: Message
messageWithoutHeader = MessageType -> LByteString -> Message
parser MessageType
messageType (LByteString -> Message) -> LByteString -> Message
forall a b. (a -> b) -> a -> b
$ ByteString -> LByteString
Lazy.fromStrict ByteString
content
  in Message
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.
            -> [ByteString]  -- ^ Extra raw data buffer(s)
            -> MessageHeader -- The resulting message header.
parseHeader :: [ByteString]
-> ByteString
-> ByteString
-> ByteString
-> [ByteString]
-> MessageHeader
parseHeader [ByteString]
idents ByteString
headerData ByteString
parentHeader ByteString
metadata [ByteString]
buffers =
  [ByteString]
-> Maybe MessageHeader
-> Metadata
-> UUID
-> UUID
-> Text
-> MessageType
-> [ByteString]
-> MessageHeader
MessageHeader [ByteString]
idents Maybe MessageHeader
parentResult Metadata
metadataMap UUID
messageUUID UUID
sessionUUID Text
username MessageType
messageType [ByteString]
buffers
  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 Object
result = LByteString -> Maybe Object
forall a. FromJSON a => LByteString -> Maybe a
decode (LByteString -> Maybe Object) -> LByteString -> Maybe Object
forall a b. (a -> b) -> a -> b
$ ByteString -> LByteString
Lazy.fromStrict ByteString
headerData :: Maybe Object
    parentResult :: Maybe MessageHeader
parentResult = if ByteString
parentHeader ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"{}"
                     then Maybe MessageHeader
forall a. Maybe a
Nothing
                     else MessageHeader -> Maybe MessageHeader
forall a. a -> Maybe a
Just (MessageHeader -> Maybe MessageHeader)
-> MessageHeader -> Maybe MessageHeader
forall a b. (a -> b) -> a -> b
$ [ByteString]
-> ByteString
-> ByteString
-> ByteString
-> [ByteString]
-> MessageHeader
parseHeader [ByteString]
idents ByteString
parentHeader ByteString
"{}" ByteString
metadata []

    Success (MessageType
messageType, Text
username, UUID
messageUUID, UUID
sessionUUID) = ((Object -> Parser (MessageType, Text, UUID, UUID))
 -> Object -> Result (MessageType, Text, UUID, UUID))
-> Object
-> (Object -> Parser (MessageType, Text, UUID, UUID))
-> Result (MessageType, Text, UUID, UUID)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Object -> Parser (MessageType, Text, UUID, UUID))
-> Object -> Result (MessageType, Text, UUID, UUID)
forall a b. (a -> Parser b) -> a -> Result b
parse Object
result ((Object -> Parser (MessageType, Text, UUID, UUID))
 -> Result (MessageType, Text, UUID, UUID))
-> (Object -> Parser (MessageType, Text, UUID, UUID))
-> Result (MessageType, Text, UUID, UUID)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      MessageType
messType <- Object
obj Object -> Key -> Parser MessageType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"msg_type"
      Text
username <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"username"
      UUID
message <- Object
obj Object -> Key -> Parser UUID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"msg_id"
      UUID
session <- Object
obj Object -> Key -> Parser UUID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"session"
      (MessageType, Text, UUID, UUID)
-> Parser (MessageType, Text, UUID, UUID)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (MessageType
messType, Text
username, UUID
message, UUID
session)

    -- Get metadata as a simple map.
    Just Metadata
metadataMap = (Object -> Metadata) -> Maybe Object -> Maybe Metadata
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Object -> Metadata
Metadata (Maybe Object -> Maybe Metadata) -> Maybe Object -> Maybe Metadata
forall a b. (a -> b) -> a -> b
$ LByteString -> Maybe Object
forall a. FromJSON a => LByteString -> Maybe a
decode (LByteString -> Maybe Object) -> LByteString -> Maybe Object
forall a b. (a -> b) -> a -> b
$ ByteString -> LByteString
Lazy.fromStrict ByteString
metadata

noHeader :: MessageHeader
noHeader :: MessageHeader
noHeader = String -> MessageHeader
forall a. HasCallStack => String -> a
error String
"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 :: MessageType -> LByteString -> Message
parser MessageType
KernelInfoRequestMessage = LByteString -> Message
kernelInfoRequestParser
parser MessageType
ExecuteInputMessage = LByteString -> Message
executeInputParser
parser MessageType
ExecuteRequestMessage = LByteString -> Message
executeRequestParser
parser MessageType
ExecuteReplyMessage = LByteString -> Message
executeReplyParser
parser MessageType
ExecuteErrorMessage = LByteString -> Message
executeErrorParser
parser MessageType
ExecuteResultMessage = LByteString -> Message
executeResultParser
parser MessageType
DisplayDataMessage = LByteString -> Message
displayDataParser
parser MessageType
IsCompleteRequestMessage = LByteString -> Message
isCompleteRequestParser
parser MessageType
CompleteRequestMessage = LByteString -> Message
completeRequestParser
parser MessageType
InspectRequestMessage = LByteString -> Message
inspectRequestParser
parser MessageType
ShutdownRequestMessage = LByteString -> Message
shutdownRequestParser
parser MessageType
InputReplyMessage = LByteString -> Message
inputReplyParser
parser MessageType
CommOpenMessage = LByteString -> Message
commOpenParser
parser MessageType
CommDataMessage = LByteString -> Message
commDataParser
parser MessageType
CommInfoRequestMessage = LByteString -> Message
commInfoRequestParser
parser MessageType
CommCloseMessage = LByteString -> Message
commCloseParser
parser MessageType
HistoryRequestMessage = LByteString -> Message
historyRequestParser
parser MessageType
StatusMessage = LByteString -> Message
statusMessageParser
parser MessageType
StreamMessage = LByteString -> Message
streamMessageParser
parser MessageType
InputMessage = LByteString -> Message
inputMessageParser
parser MessageType
OutputMessage = LByteString -> Message
outputMessageParser
parser MessageType
ClearOutputMessage = LByteString -> Message
clearOutputMessageParser
parser MessageType
other = String -> LByteString -> Message
forall a. HasCallStack => String -> a
error (String -> LByteString -> Message)
-> String -> LByteString -> Message
forall a b. (a -> b) -> a -> b
$ String
"Unknown message type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ MessageType -> String
forall a. Show a => a -> String
show MessageType
other

-- | Parse a kernel info request. A kernel info request has no auxiliary information, so ignore the
-- body.
kernelInfoRequestParser :: LByteString -> Message
kernelInfoRequestParser :: LByteString -> Message
kernelInfoRequestParser LByteString
_ = KernelInfoRequest { header :: MessageHeader
header = MessageHeader
noHeader }

-- | Parse a comm info request. A comm info request has no auxiliary information, so ignore the
-- body.
commInfoRequestParser :: LByteString -> Message
commInfoRequestParser :: LByteString -> Message
commInfoRequestParser LByteString
_ = CommInfoRequest { header :: MessageHeader
header = MessageHeader
noHeader }

-- | Parse an execute_input response. Fields used are:
executeInputParser :: LByteString -> Message
executeInputParser :: LByteString -> Message
executeInputParser = (Object -> Parser Message) -> LByteString -> Message
forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser ((Object -> Parser Message) -> LByteString -> Message)
-> (Object -> Parser Message) -> LByteString -> Message
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  Text
code <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code"
  Int
executionCount <- Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"execution_count"
  Message -> Parser Message
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Parser Message) -> Message -> Parser Message
forall a b. (a -> b) -> a -> b
$ MessageHeader -> Text -> Int -> Message
ExecuteInput MessageHeader
noHeader Text
code Int
executionCount

-- | 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 :: LByteString -> Message
executeRequestParser LByteString
content =
  let parser :: Object -> Parser (a, Bool, Bool, d)
parser Object
obj = do
                     let getOrElse :: b -> Key -> Parser b
getOrElse b
a Key
k = (b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe b
a) (Maybe b -> b) -> Parser (Maybe b) -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Maybe b)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
k
                     a
code <- Object
obj Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code"
                     Bool
silent <- Bool -> Key -> Parser Bool
forall {b}. FromJSON b => b -> Key -> Parser b
getOrElse Bool
False Key
"silent"
                     Bool
storeHistory <- Bool -> Key -> Parser Bool
forall {b}. FromJSON b => b -> Key -> Parser b
getOrElse (Bool -> Bool
not Bool
silent) Key
"store_history"
                     d
allowStdin <- Object
obj Object -> Key -> Parser d
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"allow_stdin"

                     (a, Bool, Bool, d) -> Parser (a, Bool, Bool, d)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
code, Bool
silent, Bool
storeHistory, d
allowStdin)
      Just Object
decoded = LByteString -> Maybe Object
forall a. FromJSON a => LByteString -> Maybe a
decode LByteString
content
      Success (Text
code, Bool
silent, Bool
storeHistory, Bool
allowStdin) = (Object -> Parser (Text, Bool, Bool, Bool))
-> Object -> Result (Text, Bool, Bool, Bool)
forall a b. (a -> Parser b) -> a -> Result b
parse Object -> Parser (Text, Bool, Bool, Bool)
forall {a} {d}.
(FromJSON a, FromJSON d) =>
Object -> Parser (a, Bool, Bool, d)
parser Object
decoded
  in ExecuteRequest
    { header :: MessageHeader
header = MessageHeader
noHeader
    , getCode :: Text
getCode = Text
code
    , getSilent :: Bool
getSilent = Bool
silent
    , getAllowStdin :: Bool
getAllowStdin = Bool
allowStdin
    , getStoreHistory :: Bool
getStoreHistory = Bool
storeHistory
    , getUserVariables :: [Text]
getUserVariables = []
    , getUserExpressions :: [Text]
getUserExpressions = []
    }

-- | Parse an execute reply
executeReplyParser :: LByteString -> Message
executeReplyParser :: LByteString -> Message
executeReplyParser = (Object -> Parser Message) -> LByteString -> Message
forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser ((Object -> Parser Message) -> LByteString -> Message)
-> (Object -> Parser Message) -> LByteString -> Message
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  ExecuteReplyStatus
status <- Object
obj Object -> Key -> Parser ExecuteReplyStatus
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
  Int
executionCount <- Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"execution_count"
  Message -> Parser Message
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Parser Message) -> Message -> Parser Message
forall a b. (a -> b) -> a -> b
$ MessageHeader
-> ExecuteReplyStatus -> [DisplayData] -> Int -> Message
ExecuteReply MessageHeader
noHeader ExecuteReplyStatus
status [] Int
executionCount

-- | Parse an execute reply
executeErrorParser :: LByteString -> Message
executeErrorParser :: LByteString -> Message
executeErrorParser = (Object -> Parser Message) -> LByteString -> Message
forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser ((Object -> Parser Message) -> LByteString -> Message)
-> (Object -> Parser Message) -> LByteString -> Message
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  -- executionCount <- obj .: "execution_count"
  [Text]
traceback <- Object
obj Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"traceback"
  Text
ename <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ename"
  Text
evalue <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"evalue"
  Message -> Parser Message
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Parser Message) -> Message -> Parser Message
forall a b. (a -> b) -> a -> b
$ MessageHeader -> [Text] -> Text -> Text -> Message
ExecuteError MessageHeader
noHeader [Text]
traceback Text
ename Text
evalue

makeDisplayDatas :: Object -> [DisplayData]
#if MIN_VERSION_aeson(2,0,0)
makeDisplayDatas :: Object -> [DisplayData]
makeDisplayDatas Object
dataDict = [MimeType -> Text -> DisplayData
DisplayData (String -> MimeType
forall a. Read a => String -> a
read (String -> MimeType) -> String -> MimeType
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Key -> Text
toText Key
mimeType)) Text
content | (Key
mimeType, String Text
content) <- Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
dataDict]
#else
makeDisplayDatas dataDict = [DisplayData (read $ unpack mimeType) content | (mimeType, String content) <- HM.toList dataDict]
#endif

-- | Parse an execute result
executeResultParser :: LByteString -> Message
executeResultParser :: LByteString -> Message
executeResultParser = (Object -> Parser Message) -> LByteString -> Message
forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser ((Object -> Parser Message) -> LByteString -> Message)
-> (Object -> Parser Message) -> LByteString -> Message
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  Int
executionCount <- Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"execution_count"
  Object
dataDict :: Object <- Object
obj Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
  let displayDatas :: [DisplayData]
displayDatas = Object -> [DisplayData]
makeDisplayDatas Object
dataDict
  Map String String
metadataDict <- Object
obj Object -> Key -> Parser (Map String String)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"metadata"
  Message -> Parser Message
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Parser Message) -> Message -> Parser Message
forall a b. (a -> b) -> a -> b
$ MessageHeader
-> [DisplayData] -> Map String String -> Int -> Message
ExecuteResult MessageHeader
noHeader [DisplayData]
displayDatas Map String String
metadataDict Int
executionCount

-- | Parse a display data message
displayDataParser :: LByteString -> Message
displayDataParser :: LByteString -> Message
displayDataParser = (Object -> Parser Message) -> LByteString -> Message
forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser ((Object -> Parser Message) -> LByteString -> Message)
-> (Object -> Parser Message) -> LByteString -> Message
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  Object
dataDict :: Object <- Object
obj Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
  let displayDatas :: [DisplayData]
displayDatas = Object -> [DisplayData]
makeDisplayDatas Object
dataDict
  Message -> Parser Message
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Parser Message) -> Message -> Parser Message
forall a b. (a -> b) -> a -> b
$ MessageHeader -> [DisplayData] -> Maybe Transient -> Message
PublishDisplayData MessageHeader
noHeader [DisplayData]
displayDatas Maybe Transient
forall a. Maybe a
Nothing

requestParser :: FromJSON a => (a -> Parser Message) -> LByteString -> Message
requestParser :: forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser a -> Parser Message
parser LByteString
content =
  case (a -> Parser Message) -> a -> Either String Message
forall a b. (a -> Parser b) -> a -> Either String b
parseEither a -> Parser Message
parser a
decoded of
    Right Message
parsed -> Message
parsed
    Left String
err     -> String -> Message -> Message
forall a. String -> a -> a
trace (String
"Parse error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
err) Message
SendNothing
  where
    Just a
decoded = LByteString -> Maybe a
forall a. FromJSON a => LByteString -> Maybe a
decode LByteString
content

historyRequestParser :: LByteString -> Message
historyRequestParser :: LByteString -> Message
historyRequestParser = (Object -> Parser Message) -> LByteString -> Message
forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser ((Object -> Parser Message) -> LByteString -> Message)
-> (Object -> Parser Message) -> LByteString -> Message
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
  MessageHeader -> Bool -> Bool -> HistoryAccessType -> Message
HistoryRequest MessageHeader
noHeader (Bool -> Bool -> HistoryAccessType -> Message)
-> Parser Bool -> Parser (Bool -> HistoryAccessType -> Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"output" Parser (Bool -> HistoryAccessType -> Message)
-> Parser Bool -> Parser (HistoryAccessType -> Message)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"raw" Parser (HistoryAccessType -> Message)
-> Parser HistoryAccessType -> Parser Message
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser HistoryAccessType
historyAccessType Object
obj
  where
    -- TODO: Implement full history access type parsing from message spec
    historyAccessType :: Object -> Parser HistoryAccessType
historyAccessType Object
obj = do
      String
accessTypeStr <- Object
obj Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hist_access_type"
      HistoryAccessType -> Parser HistoryAccessType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (HistoryAccessType -> Parser HistoryAccessType)
-> HistoryAccessType -> Parser HistoryAccessType
forall a b. (a -> b) -> a -> b
$
        case String
accessTypeStr of
          String
"range"  -> HistoryAccessType
HistoryRange
          String
"tail"   -> HistoryAccessType
HistoryTail
          String
"search" -> HistoryAccessType
HistorySearch
          String
str      -> String -> HistoryAccessType
forall a. HasCallStack => String -> a
error (String -> HistoryAccessType) -> String -> HistoryAccessType
forall a b. (a -> b) -> a -> b
$ String
"Unknown history access type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str

statusMessageParser :: LByteString -> Message
statusMessageParser :: LByteString -> Message
statusMessageParser = (Object -> Parser Message) -> LByteString -> Message
forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser ((Object -> Parser Message) -> LByteString -> Message)
-> (Object -> Parser Message) -> LByteString -> Message
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  ExecutionState
execution_state <- Object
obj Object -> Key -> Parser ExecutionState
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"execution_state"
  Message -> Parser Message
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Parser Message) -> Message -> Parser Message
forall a b. (a -> b) -> a -> b
$ MessageHeader -> ExecutionState -> Message
PublishStatus MessageHeader
noHeader ExecutionState
execution_state

streamMessageParser :: LByteString -> Message
streamMessageParser :: LByteString -> Message
streamMessageParser = (Object -> Parser Message) -> LByteString -> Message
forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser ((Object -> Parser Message) -> LByteString -> Message)
-> (Object -> Parser Message) -> LByteString -> Message
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  StreamType
streamType <- Object
obj Object -> Key -> Parser StreamType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
  String
streamContent <- Object
obj Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"text"
  Message -> Parser Message
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Parser Message) -> Message -> Parser Message
forall a b. (a -> b) -> a -> b
$ MessageHeader -> StreamType -> String -> Message
PublishStream MessageHeader
noHeader StreamType
streamType String
streamContent

inputMessageParser :: LByteString -> Message
inputMessageParser :: LByteString -> Message
inputMessageParser = (Object -> Parser Message) -> LByteString -> Message
forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser ((Object -> Parser Message) -> LByteString -> Message)
-> (Object -> Parser Message) -> LByteString -> Message
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  Text
code <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code"
  Int
executionCount <- Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"execution_count"
  Message -> Parser Message
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Parser Message) -> Message -> Parser Message
forall a b. (a -> b) -> a -> b
$ MessageHeader -> Text -> Int -> Message
Input MessageHeader
noHeader Text
code Int
executionCount

getDisplayDatas :: Maybe Object -> [DisplayData]
getDisplayDatas :: Maybe Object -> [DisplayData]
getDisplayDatas Maybe Object
Nothing = []
getDisplayDatas (Just Object
dataDict) = Object -> [DisplayData]
makeDisplayDatas Object
dataDict

outputMessageParser :: LByteString -> Message
outputMessageParser :: LByteString -> Message
outputMessageParser = (Object -> Parser Message) -> LByteString -> Message
forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser ((Object -> Parser Message) -> LByteString -> Message)
-> (Object -> Parser Message) -> LByteString -> Message
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  -- Handle both "data" and "text" keys
  Maybe Object
maybeDataDict1 :: Maybe Object <- Object
obj Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"data"
  let displayDatas1 :: [DisplayData]
displayDatas1 = Maybe Object -> [DisplayData]
getDisplayDatas Maybe Object
maybeDataDict1

  Maybe Object
maybeDataDict2 :: Maybe Object <- Object
obj Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"text"
  let displayDatas2 :: [DisplayData]
displayDatas2 = Maybe Object -> [DisplayData]
getDisplayDatas Maybe Object
maybeDataDict2

  Int
executionCount <- Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"execution_count"
  Message -> Parser Message
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Parser Message) -> Message -> Parser Message
forall a b. (a -> b) -> a -> b
$ MessageHeader -> [DisplayData] -> Int -> Message
Output MessageHeader
noHeader ([DisplayData]
displayDatas1 [DisplayData] -> [DisplayData] -> [DisplayData]
forall a. [a] -> [a] -> [a]
++ [DisplayData]
displayDatas2) Int
executionCount

clearOutputMessageParser :: LByteString -> Message
clearOutputMessageParser :: LByteString -> Message
clearOutputMessageParser = (Object -> Parser Message) -> LByteString -> Message
forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser ((Object -> Parser Message) -> LByteString -> Message)
-> (Object -> Parser Message) -> LByteString -> Message
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  Bool
wait <- Object
obj Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"wait"
  Message -> Parser Message
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Parser Message) -> Message -> Parser Message
forall a b. (a -> b) -> a -> b
$ MessageHeader -> Bool -> Message
ClearOutput MessageHeader
noHeader Bool
wait

isCompleteRequestParser :: LByteString -> Message
isCompleteRequestParser :: LByteString -> Message
isCompleteRequestParser = (Object -> Parser Message) -> LByteString -> Message
forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser ((Object -> Parser Message) -> LByteString -> Message)
-> (Object -> Parser Message) -> LByteString -> Message
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  String
code <- Object
obj Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code"
  Message -> Parser Message
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Parser Message) -> Message -> Parser Message
forall a b. (a -> b) -> a -> b
$ MessageHeader -> String -> Message
IsCompleteRequest MessageHeader
noHeader String
code

completeRequestParser :: LByteString -> Message
completeRequestParser :: LByteString -> Message
completeRequestParser = (Object -> Parser Message) -> LByteString -> Message
forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser ((Object -> Parser Message) -> LByteString -> Message)
-> (Object -> Parser Message) -> LByteString -> Message
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  Text
code <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code"
  Int
pos <- Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cursor_pos"
  Message -> Parser Message
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Parser Message) -> Message -> Parser Message
forall a b. (a -> b) -> a -> b
$ MessageHeader -> Text -> Int -> Message
CompleteRequest MessageHeader
noHeader Text
code Int
pos

inspectRequestParser :: LByteString -> Message
inspectRequestParser :: LByteString -> Message
inspectRequestParser = (Object -> Parser Message) -> LByteString -> Message
forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser ((Object -> Parser Message) -> LByteString -> Message)
-> (Object -> Parser Message) -> LByteString -> Message
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  Text
code <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code"
  Int
pos <- Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cursor_pos"
  Int
dlevel <- Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"detail_level"
  Message -> Parser Message
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Parser Message) -> Message -> Parser Message
forall a b. (a -> b) -> a -> b
$ MessageHeader -> Text -> Int -> Int -> Message
InspectRequest MessageHeader
noHeader Text
code Int
pos Int
dlevel

shutdownRequestParser :: LByteString -> Message
shutdownRequestParser :: LByteString -> Message
shutdownRequestParser = (Object -> Parser Message) -> LByteString -> Message
forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser ((Object -> Parser Message) -> LByteString -> Message)
-> (Object -> Parser Message) -> LByteString -> Message
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  Bool
code <- Object
obj Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"restart"
  Message -> Parser Message
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Parser Message) -> Message -> Parser Message
forall a b. (a -> b) -> a -> b
$ MessageHeader -> Bool -> Message
ShutdownRequest MessageHeader
noHeader Bool
code

inputReplyParser :: LByteString -> Message
inputReplyParser :: LByteString -> Message
inputReplyParser = (Object -> Parser Message) -> LByteString -> Message
forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser ((Object -> Parser Message) -> LByteString -> Message)
-> (Object -> Parser Message) -> LByteString -> Message
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  String
value <- Object
obj Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
  Message -> Parser Message
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Parser Message) -> Message -> Parser Message
forall a b. (a -> b) -> a -> b
$ MessageHeader -> String -> Message
InputReply MessageHeader
noHeader String
value

commOpenParser :: LByteString -> Message
commOpenParser :: LByteString -> Message
commOpenParser = (Object -> Parser Message) -> LByteString -> Message
forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser ((Object -> Parser Message) -> LByteString -> Message)
-> (Object -> Parser Message) -> LByteString -> Message
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  UUID
uuid <- Object
obj Object -> Key -> Parser UUID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"comm_id"
  String
targetName <- Object
obj Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"target_name"
  String
targetModule <- Object
obj Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"target_module" Parser (Maybe String) -> String -> Parser String
forall a. Parser (Maybe a) -> a -> Parser a
.!= String
""
  Value
value <- Object
obj Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
  Message -> Parser Message
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Parser Message) -> Message -> Parser Message
forall a b. (a -> b) -> a -> b
$ MessageHeader -> String -> String -> UUID -> Value -> Message
CommOpen MessageHeader
noHeader String
targetName String
targetModule UUID
uuid Value
value

commDataParser :: LByteString -> Message
commDataParser :: LByteString -> Message
commDataParser = (Object -> Parser Message) -> LByteString -> Message
forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser ((Object -> Parser Message) -> LByteString -> Message)
-> (Object -> Parser Message) -> LByteString -> Message
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  UUID
uuid <- Object
obj Object -> Key -> Parser UUID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"comm_id"
  Value
value <- Object
obj Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
  Message -> Parser Message
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Parser Message) -> Message -> Parser Message
forall a b. (a -> b) -> a -> b
$ MessageHeader -> UUID -> Value -> Message
CommData MessageHeader
noHeader UUID
uuid Value
value

commCloseParser :: LByteString -> Message
commCloseParser :: LByteString -> Message
commCloseParser = (Object -> Parser Message) -> LByteString -> Message
forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser ((Object -> Parser Message) -> LByteString -> Message)
-> (Object -> Parser Message) -> LByteString -> Message
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  UUID
uuid <- Object
obj Object -> Key -> Parser UUID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"comm_id"
  Value
value <- Object
obj Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
  Message -> Parser Message
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Parser Message) -> Message -> Parser Message
forall a b. (a -> b) -> a -> b
$ MessageHeader -> UUID -> Value -> Message
CommClose MessageHeader
noHeader UUID
uuid Value
value