{-# 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 forall a b. (a -> b) -> a -> b
$ ByteString -> LByteString
Lazy.fromStrict ByteString
content
  in Message
messageWithoutHeader { header :: MessageHeader
header = MessageHeader
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 = forall a. FromJSON a => LByteString -> Maybe a
decode forall a b. (a -> b) -> a -> b
$ ByteString -> LByteString
Lazy.fromStrict ByteString
headerData :: Maybe Object
    parentResult :: Maybe MessageHeader
parentResult = if ByteString
parentHeader forall a. Eq a => a -> a -> Bool
== ByteString
"{}"
                     then forall a. Maybe a
Nothing
                     else forall a. a -> Maybe a
Just 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) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> Parser b) -> a -> Result b
parse Object
result forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      MessageType
messType <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"msg_type"
      Text
username <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"username"
      UUID
message <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"msg_id"
      UUID
session <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"session"
      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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Object -> Metadata
Metadata forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => LByteString -> Maybe a
decode forall a b. (a -> b) -> a -> b
$ ByteString -> LByteString
Lazy.fromStrict ByteString
metadata

noHeader :: MessageHeader
noHeader :: MessageHeader
noHeader = 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 = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Unknown message type " forall a. [a] -> [a] -> [a]
++ 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 = forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  Text
code <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code"
  Int
executionCount <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"execution_count"
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 = (forall a. a -> Maybe a -> a
fromMaybe b
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
k
                     a
code <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code"
                     Bool
silent <- forall {b}. FromJSON b => b -> Key -> Parser b
getOrElse Bool
False Key
"silent"
                     Bool
storeHistory <- forall {b}. FromJSON b => b -> Key -> Parser b
getOrElse (Bool -> Bool
not Bool
silent) Key
"store_history"
                     d
allowStdin <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"allow_stdin"

                     forall (m :: * -> *) a. Monad m => a -> m a
return (a
code, Bool
silent, Bool
storeHistory, d
allowStdin)
      Just Object
decoded = forall a. FromJSON a => LByteString -> Maybe a
decode LByteString
content
      Success (Text
code, Bool
silent, Bool
storeHistory, Bool
allowStdin) = forall a b. (a -> Parser b) -> a -> Result b
parse 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 = forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  ExecuteReplyStatus
status <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
  Int
executionCount <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"execution_count"
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  -- executionCount <- obj .: "execution_count"
  [Text]
traceback <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"traceback"
  Text
ename <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ename"
  Text
evalue <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"evalue"
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 (forall a. Read a => String -> a
read forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Key -> Text
toText Key
mimeType)) Text
content | (Key
mimeType, String Text
content) <- 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 = forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  Int
executionCount <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"execution_count"
  Object
dataDict :: Object <- Object
obj 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 forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"metadata"
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  Object
dataDict :: Object <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
  let displayDatas :: [DisplayData]
displayDatas = Object -> [DisplayData]
makeDisplayDatas Object
dataDict
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MessageHeader -> [DisplayData] -> Maybe Transient -> Message
PublishDisplayData MessageHeader
noHeader [DisplayData]
displayDatas 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 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     -> forall a. String -> a -> a
trace (String
"Parse error: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
err) Message
SendNothing
  where
    Just a
decoded = forall a. FromJSON a => LByteString -> Maybe a
decode LByteString
content

historyRequestParser :: LByteString -> Message
historyRequestParser :: LByteString -> Message
historyRequestParser = forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser forall a b. (a -> b) -> a -> b
$ \Object
obj ->
  MessageHeader -> Bool -> Bool -> HistoryAccessType -> Message
HistoryRequest MessageHeader
noHeader forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"output" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"raw" 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 forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hist_access_type"
      forall (m :: * -> *) a. Monad m => a -> m a
return 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      -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Unknown history access type: " forall a. [a] -> [a] -> [a]
++ String
str

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

streamMessageParser :: LByteString -> Message
streamMessageParser :: LByteString -> Message
streamMessageParser = forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  StreamType
streamType <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
  String
streamContent <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"text"
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  Text
code <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code"
  Int
executionCount <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"execution_count"
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  -- Handle both "data" and "text" keys
  Maybe Object
maybeDataDict1 :: Maybe Object <- Object
obj 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 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 forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"execution_count"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MessageHeader -> [DisplayData] -> Int -> Message
Output MessageHeader
noHeader ([DisplayData]
displayDatas1 forall a. [a] -> [a] -> [a]
++ [DisplayData]
displayDatas2) Int
executionCount

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

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

completeRequestParser :: LByteString -> Message
completeRequestParser :: LByteString -> Message
completeRequestParser = forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  Text
code <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code"
  Int
pos <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cursor_pos"
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  Text
code <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code"
  Int
pos <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cursor_pos"
  Int
dlevel <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"detail_level"
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall a.
FromJSON a =>
(a -> Parser Message) -> LByteString -> Message
requestParser forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  Bool
code <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"restart"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MessageHeader -> Bool -> Message
ShutdownRequest MessageHeader
noHeader Bool
code

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

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