{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, DeriveGeneric, GeneralizedNewtypeDeriving, CPP #-}
{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-name-shadowing -fno-warn-unused-matches #-}

-- | This module contains all types used to create an IPython language kernel.
module IHaskell.IPython.Types (
    -- * IPython kernel profile
    Profile(..),
    Transport(..),
    Port,
    IP,

    -- * IPython kernelspecs
    KernelSpec(..),

    -- * IPython messaging protocol
    Message(..),
    MessageHeader(..),
    Username,
    Transient(..),
    MessageType(..),
    CodeReview(..),
    Width,
    Height,
    StreamType(..),
    ExecutionState(..),
    ExecuteReplyStatus(..),
    HistoryAccessType(..),
    HistoryReplyElement(..),
    LanguageInfo(..),
    Metadata(..),
    replyType,
    showMessageType,

    -- ** IPython display data message
    DisplayData(..),
    MimeType(..),
    extractPlain,
    displayDataToJson,
    ) where

import           Data.Aeson
import           Data.Aeson.Types (typeMismatch)
import           Data.Binary
import           Data.ByteString (ByteString)
import           Data.List (find)
import           Data.Map (Map)
import qualified Data.Map as Map
import           Data.Maybe (fromMaybe)
import           Data.Semigroup (Semigroup)
import           Data.Text (Text, pack)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import           Data.Typeable
import           GHC.Generics (Generic)
import           IHaskell.IPython.Message.UUID

#if MIN_VERSION_aeson(2,0,0)
import           Data.Aeson.Key
#endif

------------------ IPython Kernel Profile Types ----------------------
--
-- | A TCP port.
type Port = Int

-- | An IP address.
type IP = String

-- | The transport mechanism used to communicate with the IPython frontend.
data Transport = TCP -- ^ Default transport mechanism via TCP.
  deriving (Width -> Transport -> ShowS
[Transport] -> ShowS
Transport -> String
forall a.
(Width -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Transport] -> ShowS
$cshowList :: [Transport] -> ShowS
show :: Transport -> String
$cshow :: Transport -> String
showsPrec :: Width -> Transport -> ShowS
$cshowsPrec :: Width -> Transport -> ShowS
Show, ReadPrec [Transport]
ReadPrec Transport
Width -> ReadS Transport
ReadS [Transport]
forall a.
(Width -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Transport]
$creadListPrec :: ReadPrec [Transport]
readPrec :: ReadPrec Transport
$creadPrec :: ReadPrec Transport
readList :: ReadS [Transport]
$creadList :: ReadS [Transport]
readsPrec :: Width -> ReadS Transport
$creadsPrec :: Width -> ReadS Transport
Read)

-- | A kernel profile, specifying how the kernel communicates.
data Profile =
       Profile
         { Profile -> String
ip :: IP                     -- ^ The IP on which to listen.
         , Profile -> Transport
transport :: Transport       -- ^ The transport mechanism.
         , Profile -> Width
stdinPort :: Port            -- ^ The stdin channel port.
         , Profile -> Width
controlPort :: Port          -- ^ The control channel port.
         , Profile -> Width
hbPort :: Port               -- ^ The heartbeat channel port.
         , Profile -> Width
shellPort :: Port            -- ^ The shell command port.
         , Profile -> Width
iopubPort :: Port            -- ^ The IOPub port.
         , Profile -> ByteString
signatureKey :: ByteString   -- ^ The HMAC encryption key.
         }
  deriving (Width -> Profile -> ShowS
[Profile] -> ShowS
Profile -> String
forall a.
(Width -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Profile] -> ShowS
$cshowList :: [Profile] -> ShowS
show :: Profile -> String
$cshow :: Profile -> String
showsPrec :: Width -> Profile -> ShowS
$cshowsPrec :: Width -> Profile -> ShowS
Show, ReadPrec [Profile]
ReadPrec Profile
Width -> ReadS Profile
ReadS [Profile]
forall a.
(Width -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Profile]
$creadListPrec :: ReadPrec [Profile]
readPrec :: ReadPrec Profile
$creadPrec :: ReadPrec Profile
readList :: ReadS [Profile]
$creadList :: ReadS [Profile]
readsPrec :: Width -> ReadS Profile
$creadsPrec :: Width -> ReadS Profile
Read)

-- Convert the kernel profile to and from JSON.
instance FromJSON Profile where
  parseJSON :: Value -> Parser Profile
parseJSON (Object Object
v) = do
    String
signatureScheme <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"signature_scheme"
    case String
signatureScheme of
      String
"hmac-sha256" ->
        String
-> Transport
-> Width
-> Width
-> Width
-> Width
-> Width
-> ByteString
-> Profile
Profile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ip"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"transport"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stdin_port"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"control_port"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hb_port"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"shell_port"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"iopub_port"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> ByteString
Text.encodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"key")
      String
sig -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Unexpected signature scheme: " forall a. [a] -> [a] -> [a]
++ String
sig
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expecting JSON object."

instance ToJSON Profile where
  toJSON :: Profile -> Value
toJSON Profile
profile = [(Key, Value)] -> Value
object
                     [ Key
"ip" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Profile -> String
ip Profile
profile
                     , Key
"transport" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Profile -> Transport
transport Profile
profile
                     , Key
"stdin_port" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Profile -> Width
stdinPort Profile
profile
                     , Key
"control_port" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Profile -> Width
controlPort Profile
profile
                     , Key
"hb_port" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Profile -> Width
hbPort Profile
profile
                     , Key
"shell_port" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Profile -> Width
shellPort Profile
profile
                     , Key
"iopub_port" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Profile -> Width
iopubPort Profile
profile
                     , Key
"key" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
Text.decodeUtf8 (Profile -> ByteString
signatureKey Profile
profile)
                     ]

instance FromJSON Transport where
  parseJSON :: Value -> Parser Transport
parseJSON (String Text
mech) =
    case Text
mech of
      Text
"tcp" -> forall (m :: * -> *) a. Monad m => a -> m a
return Transport
TCP
      Text
_     -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown transport mechanism " forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
mech
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected JSON string as transport."

instance ToJSON Transport where
  toJSON :: Transport -> Value
toJSON Transport
TCP = Text -> Value
String Text
"tcp"

-------------------- IPython Kernelspec Types ----------------------
data KernelSpec =
       KernelSpec
         {
         -- | Name shown to users to describe this kernel (e.g. "Haskell")
         KernelSpec -> String
kernelDisplayName :: String
         -- | Name for the kernel; unique kernel identifier (e.g. "haskell")
         , KernelSpec -> String
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.
         , KernelSpec -> [String]
kernelCommand :: [String]
         }
  deriving (KernelSpec -> KernelSpec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KernelSpec -> KernelSpec -> Bool
$c/= :: KernelSpec -> KernelSpec -> Bool
== :: KernelSpec -> KernelSpec -> Bool
$c== :: KernelSpec -> KernelSpec -> Bool
Eq, Width -> KernelSpec -> ShowS
[KernelSpec] -> ShowS
KernelSpec -> String
forall a.
(Width -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KernelSpec] -> ShowS
$cshowList :: [KernelSpec] -> ShowS
show :: KernelSpec -> String
$cshow :: KernelSpec -> String
showsPrec :: Width -> KernelSpec -> ShowS
$cshowsPrec :: Width -> KernelSpec -> ShowS
Show)

instance ToJSON KernelSpec where
  toJSON :: KernelSpec -> Value
toJSON KernelSpec
kernelspec = [(Key, Value)] -> Value
object
                        [ Key
"argv" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= KernelSpec -> [String]
kernelCommand KernelSpec
kernelspec
                        , Key
"display_name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= KernelSpec -> String
kernelDisplayName KernelSpec
kernelspec
                        , Key
"language" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= KernelSpec -> String
kernelLanguage KernelSpec
kernelspec
                        ]

------------------ IPython Message Types --------------------
--
-- | A message header with some metadata.
data MessageHeader =
       MessageHeader
         { MessageHeader -> [ByteString]
mhIdentifiers :: [ByteString]          -- ^ The identifiers sent with the message.
         , MessageHeader -> Maybe MessageHeader
mhParentHeader :: Maybe MessageHeader  -- ^ The parent header, if present.
         , MessageHeader -> Metadata
mhMetadata :: Metadata                 -- ^ A dict of metadata.
         , MessageHeader -> UUID
mhMessageId :: UUID                    -- ^ A unique message UUID.
         , MessageHeader -> UUID
mhSessionId :: UUID                    -- ^ A unique session UUID.
         , MessageHeader -> Text
mhUsername :: Username                 -- ^ The user who sent this message.
         , MessageHeader -> MessageType
mhMsgType :: MessageType               -- ^ The message type.
         , MessageHeader -> [ByteString]
mhBuffers :: [ByteString]              -- ^ Extra raw data buffer(s)
         }
  deriving (Width -> MessageHeader -> ShowS
[MessageHeader] -> ShowS
MessageHeader -> String
forall a.
(Width -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageHeader] -> ShowS
$cshowList :: [MessageHeader] -> ShowS
show :: MessageHeader -> String
$cshow :: MessageHeader -> String
showsPrec :: Width -> MessageHeader -> ShowS
$cshowsPrec :: Width -> MessageHeader -> ShowS
Show, ReadPrec [MessageHeader]
ReadPrec MessageHeader
Width -> ReadS MessageHeader
ReadS [MessageHeader]
forall a.
(Width -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MessageHeader]
$creadListPrec :: ReadPrec [MessageHeader]
readPrec :: ReadPrec MessageHeader
$creadPrec :: ReadPrec MessageHeader
readList :: ReadS [MessageHeader]
$creadList :: ReadS [MessageHeader]
readsPrec :: Width -> ReadS MessageHeader
$creadsPrec :: Width -> ReadS MessageHeader
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 :: MessageHeader -> Value
toJSON MessageHeader
header = [(Key, Value)] -> Value
object
                    [ Key
"msg_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= MessageHeader -> UUID
mhMessageId MessageHeader
header
                    , Key
"session" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= MessageHeader -> UUID
mhSessionId MessageHeader
header
                    , Key
"username" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= MessageHeader -> Text
mhUsername MessageHeader
header
                    , Key
"version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (String
"5.0" :: String)
                    , Key
"msg_type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= MessageType -> String
showMessageType (MessageHeader -> MessageType
mhMsgType MessageHeader
header)
                    ]

-- | A username for the source of a message.
type Username = Text

-- | A metadata dictionary.
newtype Metadata = Metadata Object
  deriving (Width -> Metadata -> ShowS
[Metadata] -> ShowS
Metadata -> String
forall a.
(Width -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Metadata] -> ShowS
$cshowList :: [Metadata] -> ShowS
show :: Metadata -> String
$cshow :: Metadata -> String
showsPrec :: Width -> Metadata -> ShowS
$cshowsPrec :: Width -> Metadata -> ShowS
Show, ReadPrec [Metadata]
ReadPrec Metadata
Width -> ReadS Metadata
ReadS [Metadata]
forall a.
(Width -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Metadata]
$creadListPrec :: ReadPrec [Metadata]
readPrec :: ReadPrec Metadata
$creadPrec :: ReadPrec Metadata
readList :: ReadS [Metadata]
$creadList :: ReadS [Metadata]
readsPrec :: Width -> ReadS Metadata
$creadsPrec :: Width -> ReadS Metadata
Read, [Metadata] -> Encoding
[Metadata] -> Value
Metadata -> Encoding
Metadata -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Metadata] -> Encoding
$ctoEncodingList :: [Metadata] -> Encoding
toJSONList :: [Metadata] -> Value
$ctoJSONList :: [Metadata] -> Value
toEncoding :: Metadata -> Encoding
$ctoEncoding :: Metadata -> Encoding
toJSON :: Metadata -> Value
$ctoJSON :: Metadata -> Value
ToJSON, NonEmpty Metadata -> Metadata
Metadata -> Metadata -> Metadata
forall b. Integral b => b -> Metadata -> Metadata
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Metadata -> Metadata
$cstimes :: forall b. Integral b => b -> Metadata -> Metadata
sconcat :: NonEmpty Metadata -> Metadata
$csconcat :: NonEmpty Metadata -> Metadata
<> :: Metadata -> Metadata -> Metadata
$c<> :: Metadata -> Metadata -> Metadata
Semigroup, Semigroup Metadata
Metadata
[Metadata] -> Metadata
Metadata -> Metadata -> Metadata
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Metadata] -> Metadata
$cmconcat :: [Metadata] -> Metadata
mappend :: Metadata -> Metadata -> Metadata
$cmappend :: Metadata -> Metadata -> Metadata
mempty :: Metadata
$cmempty :: Metadata
Monoid)

-- | The type of a message, corresponding to IPython message types.
data MessageType = KernelInfoReplyMessage
                 | KernelInfoRequestMessage
                 | ExecuteInputMessage
                 | ExecuteReplyMessage
                 | ExecuteErrorMessage
                 | ExecuteRequestMessage
                 | ExecuteResultMessage
                 | StatusMessage
                 | StreamMessage
                 | DisplayDataMessage
                 | UpdateDisplayDataMessage
                 | OutputMessage
                 | InputMessage
                 | IsCompleteRequestMessage
                 | IsCompleteReplyMessage
                 | CompleteRequestMessage
                 | CompleteReplyMessage
                 | InspectRequestMessage
                 | InspectReplyMessage
                 | ShutdownRequestMessage
                 | ShutdownReplyMessage
                 | ClearOutputMessage
                 | InputRequestMessage
                 | InputReplyMessage
                 | CommOpenMessage
                 | CommDataMessage
                 | CommInfoRequestMessage
                 | CommInfoReplyMessage
                 | CommCloseMessage
                 | HistoryRequestMessage
                 | HistoryReplyMessage
  deriving (Width -> MessageType -> ShowS
[MessageType] -> ShowS
MessageType -> String
forall a.
(Width -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageType] -> ShowS
$cshowList :: [MessageType] -> ShowS
show :: MessageType -> String
$cshow :: MessageType -> String
showsPrec :: Width -> MessageType -> ShowS
$cshowsPrec :: Width -> MessageType -> ShowS
Show, ReadPrec [MessageType]
ReadPrec MessageType
Width -> ReadS MessageType
ReadS [MessageType]
forall a.
(Width -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MessageType]
$creadListPrec :: ReadPrec [MessageType]
readPrec :: ReadPrec MessageType
$creadPrec :: ReadPrec MessageType
readList :: ReadS [MessageType]
$creadList :: ReadS [MessageType]
readsPrec :: Width -> ReadS MessageType
$creadsPrec :: Width -> ReadS MessageType
Read, MessageType -> MessageType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageType -> MessageType -> Bool
$c/= :: MessageType -> MessageType -> Bool
== :: MessageType -> MessageType -> Bool
$c== :: MessageType -> MessageType -> Bool
Eq)

showMessageType :: MessageType -> String
showMessageType :: MessageType -> String
showMessageType MessageType
KernelInfoReplyMessage = String
"kernel_info_reply"
showMessageType MessageType
KernelInfoRequestMessage = String
"kernel_info_request"
showMessageType MessageType
ExecuteInputMessage = String
"execute_input"
showMessageType MessageType
ExecuteReplyMessage = String
"execute_reply"
showMessageType MessageType
ExecuteErrorMessage = String
"error"
showMessageType MessageType
ExecuteRequestMessage = String
"execute_request"
showMessageType MessageType
ExecuteResultMessage = String
"execute_result"
showMessageType MessageType
StatusMessage = String
"status"
showMessageType MessageType
StreamMessage = String
"stream"
showMessageType MessageType
DisplayDataMessage = String
"display_data"
showMessageType MessageType
UpdateDisplayDataMessage = String
"update_display_data"
showMessageType MessageType
OutputMessage = String
"execute_result"
showMessageType MessageType
InputMessage = String
"execute_input"
showMessageType MessageType
IsCompleteRequestMessage = String
"is_complete_request"
showMessageType MessageType
IsCompleteReplyMessage = String
"is_complete_reply"
showMessageType MessageType
CompleteRequestMessage = String
"complete_request"
showMessageType MessageType
CompleteReplyMessage = String
"complete_reply"
showMessageType MessageType
InspectRequestMessage = String
"inspect_request"
showMessageType MessageType
InspectReplyMessage = String
"inspect_reply"
showMessageType MessageType
ShutdownRequestMessage = String
"shutdown_request"
showMessageType MessageType
ShutdownReplyMessage = String
"shutdown_reply"
showMessageType MessageType
ClearOutputMessage = String
"clear_output"
showMessageType MessageType
InputRequestMessage = String
"input_request"
showMessageType MessageType
InputReplyMessage = String
"input_reply"
showMessageType MessageType
CommOpenMessage = String
"comm_open"
showMessageType MessageType
CommDataMessage = String
"comm_msg"
showMessageType MessageType
CommInfoRequestMessage = String
"comm_info_request"
showMessageType MessageType
CommInfoReplyMessage = String
"comm_info_reply"
showMessageType MessageType
CommCloseMessage = String
"comm_close"
showMessageType MessageType
HistoryRequestMessage = String
"history_request"
showMessageType MessageType
HistoryReplyMessage = String
"history_reply"

instance FromJSON MessageType where
  parseJSON :: Value -> Parser MessageType
parseJSON (String Text
s) =
    case Text
s of
      Text
"kernel_info_reply"   -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
KernelInfoReplyMessage
      Text
"kernel_info_request" -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
KernelInfoRequestMessage
      Text
"execute_input"       -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
ExecuteInputMessage
      Text
"execute_reply"       -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
ExecuteReplyMessage
      Text
"error"               -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
ExecuteErrorMessage
      Text
"execute_request"     -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
ExecuteRequestMessage
      Text
"execute_result"      -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
ExecuteResultMessage
      Text
"status"              -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
StatusMessage
      Text
"stream"              -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
StreamMessage
      Text
"display_data"        -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
DisplayDataMessage
      Text
"update_display_data" -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
UpdateDisplayDataMessage
      Text
"pyout"               -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
OutputMessage
      Text
"pyin"                -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
InputMessage
      Text
"is_complete_request" -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
IsCompleteRequestMessage
      Text
"is_complete_reply"   -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
IsCompleteReplyMessage
      Text
"complete_request"    -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
CompleteRequestMessage
      Text
"complete_reply"      -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
CompleteReplyMessage
      Text
"inspect_request"     -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
InspectRequestMessage
      Text
"inspect_reply"       -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
InspectReplyMessage
      Text
"shutdown_request"    -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
ShutdownRequestMessage
      Text
"shutdown_reply"      -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
ShutdownReplyMessage
      Text
"clear_output"        -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
ClearOutputMessage
      Text
"input_request"       -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
InputRequestMessage
      Text
"input_reply"         -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
InputReplyMessage
      Text
"comm_open"           -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
CommOpenMessage
      Text
"comm_msg"            -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
CommDataMessage
      Text
"comm_info_request"   -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
CommInfoRequestMessage
      Text
"comm_info_reply"     -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
CommInfoReplyMessage
      Text
"comm_close"          -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
CommCloseMessage
      Text
"history_request"     -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
HistoryRequestMessage
      Text
"history_reply"       -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
HistoryReplyMessage
      Text
"status_message"      -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
StatusMessage

      Text
_                     -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown message type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
s)
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Must be a string."

-- | Kernel language info, see
--
-- * https://jupyter-client.readthedocs.io/en/stable/messaging.html#kernel-info
-- * https://jupyter-client.readthedocs.io/en/stable/wrapperkernels.html#MyKernel.language_info
data LanguageInfo =
       LanguageInfo
         { LanguageInfo -> String
languageName :: String        -- ^ The language name, e.g. "haskell"
         , LanguageInfo -> String
languageVersion :: String        -- ^ GHC 7.6.3
         , LanguageInfo -> String
languageFileExtension :: String        -- ^ .hs
         , LanguageInfo -> String
languageCodeMirrorMode :: String        -- ^ 'ihaskell'. can be 'null'
         , LanguageInfo -> String
languagePygmentsLexer :: String
         , LanguageInfo -> String
languageMimeType :: String       -- "text/x-haskell"
         }
  deriving (Width -> LanguageInfo -> ShowS
[LanguageInfo] -> ShowS
LanguageInfo -> String
forall a.
(Width -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LanguageInfo] -> ShowS
$cshowList :: [LanguageInfo] -> ShowS
show :: LanguageInfo -> String
$cshow :: LanguageInfo -> String
showsPrec :: Width -> LanguageInfo -> ShowS
$cshowsPrec :: Width -> LanguageInfo -> ShowS
Show, LanguageInfo -> LanguageInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LanguageInfo -> LanguageInfo -> Bool
$c/= :: LanguageInfo -> LanguageInfo -> Bool
== :: LanguageInfo -> LanguageInfo -> Bool
$c== :: LanguageInfo -> LanguageInfo -> Bool
Eq)

instance ToJSON LanguageInfo where
  toJSON :: LanguageInfo -> Value
toJSON LanguageInfo
info = [(Key, Value)] -> Value
object
                  [ Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LanguageInfo -> String
languageName LanguageInfo
info
                  , Key
"version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LanguageInfo -> String
languageVersion LanguageInfo
info
                  , Key
"file_extension" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LanguageInfo -> String
languageFileExtension LanguageInfo
info
                  , Key
"codemirror_mode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LanguageInfo -> String
languageCodeMirrorMode LanguageInfo
info
                  , Key
"pygments_lexer" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LanguageInfo -> String
languagePygmentsLexer LanguageInfo
info
                  , Key
"mimetype" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LanguageInfo -> String
languageMimeType LanguageInfo
info
                  ]

data CodeReview = CodeComplete
                | CodeIncomplete String -- ^ String to be used to indent next line of input
                | CodeInvalid
                | CodeUnknown
  deriving Width -> CodeReview -> ShowS
[CodeReview] -> ShowS
CodeReview -> String
forall a.
(Width -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodeReview] -> ShowS
$cshowList :: [CodeReview] -> ShowS
show :: CodeReview -> String
$cshow :: CodeReview -> String
showsPrec :: Width -> CodeReview -> ShowS
$cshowsPrec :: Width -> CodeReview -> ShowS
Show


newtype Transient = Transient
  { Transient -> UUID
transientDisplayId :: UUID
  }
  deriving (Width -> Transient -> ShowS
[Transient] -> ShowS
Transient -> String
forall a.
(Width -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Transient] -> ShowS
$cshowList :: [Transient] -> ShowS
show :: Transient -> String
$cshow :: Transient -> String
showsPrec :: Width -> Transient -> ShowS
$cshowsPrec :: Width -> Transient -> ShowS
Show, Transient -> Transient -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Transient -> Transient -> Bool
$c/= :: Transient -> Transient -> Bool
== :: Transient -> Transient -> Bool
$c== :: Transient -> Transient -> Bool
Eq)

instance ToJSON Transient where
  toJSON :: Transient -> Value
toJSON Transient
t = [(Key, Value)] -> Value
object [ Key
"display_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Transient -> UUID
transientDisplayId Transient
t
                    ]

-- | A message used to communicate with the IPython frontend.
--
-- See
-- https://jupyter-client.readthedocs.io/en/stable/messaging.html
data Message =
             -- | A request from a frontend for information about the kernel.
              KernelInfoRequest { Message -> MessageHeader
header :: MessageHeader }
             |
             -- | A response to a KernelInfoRequest.
               KernelInfoReply
                 { header :: MessageHeader
                 , Message -> String
protocolVersion :: String -- ^ current protocol version, major and minor
                 , Message -> String
banner :: String -- ^ Kernel information description e.g. (IHaskell 0.8.3.0 GHC
                                    -- 7.10.2)
                 , Message -> String
implementation :: String -- ^ e.g. IHaskell
                 , Message -> String
implementationVersion :: String -- ^ The version of the implementation
                 , Message -> LanguageInfo
languageInfo :: LanguageInfo
                 , Message -> ExecuteReplyStatus
status :: ExecuteReplyStatus
                 }
             |
             -- | A request from a frontend for information about the comms.
               CommInfoRequest { header :: MessageHeader }
             |
             -- | A response to a CommInfoRequest.
               CommInfoReply
                 { header   :: MessageHeader
                 , Message -> Map String String
commInfo :: Map String String -- ^ A dictionary of the comms, indexed by uuids.
                 }
             |
             -- | A request from a frontend to execute some code.
               ExecuteInput
                 { header :: MessageHeader
                 , Message -> Text
getCode :: Text         -- ^ The code string.
                 , Message -> Width
executionCounter :: Int -- ^ The execution count, i.e. which output this is.
                 }
             |
             -- | A request from a frontend to execute some code.
               ExecuteRequest
                 { header :: MessageHeader
                 , getCode :: Text              -- ^ The code string.
                 , Message -> Bool
getSilent :: Bool                  -- ^ Whether this should be silently executed.
                 , Message -> Bool
getStoreHistory :: Bool            -- ^ Whether to store this in history.
                 , Message -> Bool
getAllowStdin :: Bool              -- ^ Whether this code can use stdin.
                 , Message -> [Text]
getUserVariables :: [Text]   -- ^ Unused.
                 , Message -> [Text]
getUserExpressions :: [Text] -- ^ Unused.
                 }
             |
             -- | A reply to an execute request.
               ExecuteReply
                 { header :: MessageHeader
                 , status :: ExecuteReplyStatus          -- ^ The status of the output.
                 , Message -> [DisplayData]
pagerOutput :: [DisplayData]          -- ^ The mimebundles to display in the pager.
                 , executionCounter :: Int               -- ^ The execution count, i.e. which output this is.
                 }
             |
             -- | A reply to an execute request.
               ExecuteResult
                 { header :: MessageHeader
                 , Message -> [DisplayData]
dataResult :: [DisplayData]           -- ^ Key/value pairs (keys are MIME types)
                 , Message -> Map String String
metadataResult :: Map String String   -- ^ Any metadata that describes the data
                 , executionCounter :: Int               -- ^ The execution count, i.e. which output this is.
                 }
             |
             -- | An error reply to an execute request
               ExecuteError
                 { header :: MessageHeader              -- ^ Unused field retained for backwards compatibility.
                 , Message -> [Text]
traceback :: [Text]
                 , Message -> Text
ename :: Text
                 , Message -> Text
evalue :: Text
                 }
             |
               PublishStatus
                 { header :: MessageHeader
                 , Message -> ExecutionState
executionState :: ExecutionState      -- ^ The execution state of the kernel.
                 }
             |
               PublishStream
                 { header :: MessageHeader
                 , Message -> StreamType
streamType :: StreamType              -- ^ Which stream to publish to.
                 , Message -> String
streamContent :: String               -- ^ What to publish.
                 }
             |
               PublishDisplayData
                 { header :: MessageHeader
                 , Message -> [DisplayData]
displayData :: [DisplayData]          -- ^ A list of data representations.
                 , Message -> Maybe Transient
transient   :: Maybe Transient
                 }
             |
               PublishUpdateDisplayData
                 { header :: MessageHeader
                 , displayData :: [DisplayData]          -- ^ A list of data representations.
                 , transient   :: Maybe Transient
                 }
             |
               PublishOutput
                 { header :: MessageHeader
                 , Message -> String
reprText :: String                    -- ^ Printed output text.
                 , Message -> Width
executionCount :: Int                 -- ^ Which output this is for.
                 }
             |
               PublishInput
                 { header :: MessageHeader
                 , Message -> String
inCode :: String                      -- ^ Submitted input code.
                 , executionCount :: Int                 -- ^ Which input this is.
                 }
             | Input { header :: MessageHeader, getCode :: Text, executionCount :: Int }
             | Output { header :: MessageHeader, Message -> [DisplayData]
getText :: [DisplayData], executionCount :: Int }
             |
               IsCompleteRequest
                 { header :: MessageHeader
                 , Message -> String
inputToReview :: String               -- ^ The code entered in the repl.
                 }
             |
               IsCompleteReply
                 { header :: MessageHeader
                 , Message -> CodeReview
reviewResult :: CodeReview            -- ^ The result of reviewing the code.
                 }
             |
               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@  -}
                 , Message -> Width
getCursorPos :: Int -- ^ Position of the cursor in unicode characters. json field
                                       -- @cursor_pos@
                 }
             |
               CompleteReply
                 { header :: MessageHeader
                 , Message -> [Text]
completionMatches :: [Text]
                 , Message -> Width
completionCursorStart :: Int
                 , Message -> Width
completionCursorEnd :: Int
                 , Message -> Metadata
completionMetadata :: Metadata
                 , Message -> Bool
completionStatus :: Bool
                 }
             |
               InspectRequest
                 { header :: MessageHeader
                 -- | The code context in which introspection is requested
                 , Message -> Text
inspectCode :: Text
                 -- | Position of the cursor in unicode characters. json field @cursor_pos@
                 , Message -> Width
inspectCursorPos :: Int
                 -- | Level of detail desired (defaults to 0). 0 is equivalent to foo?, 1 is equivalent to foo??.
                 , Message -> Width
detailLevel :: Int
                 }
             |
               InspectReply
                 { header :: MessageHeader
                 -- | whether the request succeeded or failed
                 , Message -> Bool
inspectStatus :: Bool
                 -- | @inspectData@ can be empty if nothing is found
                 , Message -> [DisplayData]
inspectData :: [DisplayData]
                 }
             |
               ShutdownRequest
                 { header :: MessageHeader
                 , Message -> Bool
restartPending :: Bool    -- ^ Whether this shutdown precedes a restart.
                 }
             |
               ShutdownReply
                 { header :: MessageHeader
                 , restartPending :: Bool    -- ^ Whether this shutdown precedes a restart.
                 }
             |
               ClearOutput
                 { header :: MessageHeader
                 , Message -> Bool
wait :: Bool -- ^ Whether to wait to redraw until there is more output.
                 }
             | RequestInput { header :: MessageHeader, Message -> String
inputPrompt :: String }
             | InputReply { header :: MessageHeader, Message -> String
inputValue :: String }
             |
               CommOpen
                 { header :: MessageHeader
                 , Message -> String
commTargetName :: String
                 , Message -> String
commTargetModule :: String
                 , Message -> UUID
commUuid :: UUID
                 , Message -> Value
commData :: Value
                 }
             | CommData { header :: MessageHeader, commUuid :: UUID, commData :: Value }
             | CommClose { header :: MessageHeader, commUuid :: UUID, commData :: Value }
             |
               HistoryRequest
                 { header :: MessageHeader
                 , Message -> Bool
historyGetOutput :: Bool  -- ^ If True, also return output history in the resulting
                                             -- dict.
                 , Message -> Bool
historyRaw :: Bool        -- ^ If True, return the raw input history, else the
                                             -- transformed input.
                 , Message -> HistoryAccessType
historyAccessType :: HistoryAccessType -- ^ What history is being requested.
                 }
             | HistoryReply { header :: MessageHeader, Message -> [HistoryReplyElement]
historyReply :: [HistoryReplyElement] }
             | SendNothing -- Dummy message; nothing is sent.
  deriving Width -> Message -> ShowS
[Message] -> ShowS
Message -> String
forall a.
(Width -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Width -> Message -> ShowS
$cshowsPrec :: Width -> Message -> ShowS
Show

-- Convert message bodies into JSON.
instance ToJSON Message where
  toJSON :: Message -> Value
toJSON rep :: Message
rep@KernelInfoReply{} =
    [(Key, Value)] -> Value
object
      [ Key
"protocol_version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> String
protocolVersion Message
rep
      , Key
"banner" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> String
banner Message
rep
      , Key
"implementation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> String
implementation Message
rep
      , Key
"implementation_version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> String
implementationVersion Message
rep
      , Key
"language_info" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> LanguageInfo
languageInfo Message
rep
      , Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. Show a => a -> String
show (Message -> ExecuteReplyStatus
status Message
rep)
      ]

  toJSON CommInfoReply
    { header :: Message -> MessageHeader
header = MessageHeader
header
    , commInfo :: Message -> Map String String
commInfo = Map String String
commInfo
    } =
    [(Key, Value)] -> Value
object
      [ Key
"comms" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\String
comm -> [(Key, Value)] -> Value
object [Key
"target_name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
comm]) Map String String
commInfo
      , Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShowS
string String
"ok"
      ]

  toJSON ExecuteRequest
    { getCode :: Message -> Text
getCode = Text
code
    , getSilent :: Message -> Bool
getSilent = Bool
silent
    , getStoreHistory :: Message -> Bool
getStoreHistory = Bool
storeHistory
    , getAllowStdin :: Message -> Bool
getAllowStdin = Bool
allowStdin
    , getUserExpressions :: Message -> [Text]
getUserExpressions = [Text]
userExpressions
    } =
    [(Key, Value)] -> Value
object
      [ Key
"code" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
code
      , Key
"silent" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
silent
      , Key
"store_history" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
storeHistory
      , Key
"allow_stdin" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
allowStdin
      , Key
"user_expressions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
userExpressions
      ]

  toJSON ExecuteReply { status :: Message -> ExecuteReplyStatus
status = ExecuteReplyStatus
status, executionCounter :: Message -> Width
executionCounter = Width
counter, pagerOutput :: Message -> [DisplayData]
pagerOutput = [DisplayData]
pager } =
    [(Key, Value)] -> Value
object
      [ Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. Show a => a -> String
show ExecuteReplyStatus
status
      , Key
"execution_count" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Width
counter
      , Key
"payload" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
        if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DisplayData]
pager
          then []
          else [DisplayData] -> [Value]
mkPayload [DisplayData]
pager
      , Key
"user_expressions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map String String
emptyMap
      ]
    where
      mkPayload :: [DisplayData] -> [Value]
mkPayload [DisplayData]
o = [ [(Key, Value)] -> Value
object
                        [ Key
"source" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShowS
string String
"page"
                        , Key
"start" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Scientific -> Value
Number Scientific
0
                        , Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object (forall a b. (a -> b) -> [a] -> [b]
map DisplayData -> (Key, Value)
displayDataToJson [DisplayData]
o)
                        ]
                    ]
  -- `header` is not a supported field, but removing it would complicate things
  -- downstream in terms of dependency bounds so we just drop it on the floor
  toJSON ExecuteError { header :: Message -> MessageHeader
header = MessageHeader
_header, traceback :: Message -> [Text]
traceback = [Text]
traceback, ename :: Message -> Text
ename = Text
ename, evalue :: Message -> Text
evalue = Text
evalue } =
    [(Key, Value)] -> Value
object
      [ Key
"traceback" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a -> b) -> [a] -> [b]
map forall a. ToJSON a => a -> Value
toJSON [Text]
traceback
      , Key
"ename" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
ename
      , Key
"evalue" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
evalue
      ]
  toJSON PublishStatus { executionState :: Message -> ExecutionState
executionState = ExecutionState
executionState } =
    [(Key, Value)] -> Value
object [Key
"execution_state" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ExecutionState
executionState]
  toJSON PublishStream { streamType :: Message -> StreamType
streamType = StreamType
streamType, streamContent :: Message -> String
streamContent = String
content } =
    -- Since 5.0 "data" key was renamed to "text""
    [(Key, Value)] -> Value
object [Key
"text" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
content, Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StreamType
streamType, Key
"output_type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShowS
string String
"stream"]
  toJSON r :: Message
r@PublishDisplayData { displayData :: Message -> [DisplayData]
displayData = [DisplayData]
datas }
    = [(Key, Value)] -> Value
object
    forall a b. (a -> b) -> a -> b
$ case Message -> Maybe Transient
transient Message
r of
        Just Transient
t  -> ((Key
"transient" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON (Message -> Maybe Transient
transient Message
r)) forall a. a -> [a] -> [a]
:)
        Maybe Transient
Nothing -> forall a. a -> a
id
    forall a b. (a -> b) -> a -> b
$ [Key
"metadata" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object []
      , Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object (forall a b. (a -> b) -> [a] -> [b]
map DisplayData -> (Key, Value)
displayDataToJson [DisplayData]
datas)
      ]
  toJSON r :: Message
r@PublishUpdateDisplayData { displayData :: Message -> [DisplayData]
displayData = [DisplayData]
datas }
    = [(Key, Value)] -> Value
object
    forall a b. (a -> b) -> a -> b
$ case Message -> Maybe Transient
transient Message
r of
        Just Transient
t  -> ((Key
"transient" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON (Message -> Maybe Transient
transient Message
r)) forall a. a -> [a] -> [a]
:)
        Maybe Transient
Nothing -> forall a. a -> a
id
    forall a b. (a -> b) -> a -> b
$ [Key
"metadata" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object []
      , Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object (forall a b. (a -> b) -> [a] -> [b]
map DisplayData -> (Key, Value)
displayDataToJson [DisplayData]
datas)
      ]
  toJSON PublishOutput { executionCount :: Message -> Width
executionCount = Width
execCount, reprText :: Message -> String
reprText = String
reprText } =
    [(Key, Value)] -> Value
object
      [ Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object [Key
"text/plain" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
reprText]
      , Key
"execution_count" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Width
execCount
      , Key
"metadata" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object []
      ]
  toJSON PublishInput { executionCount :: Message -> Width
executionCount = Width
execCount, inCode :: Message -> String
inCode = String
code } =
    [(Key, Value)] -> Value
object [Key
"execution_count" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Width
execCount, Key
"code" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
code]
  toJSON (CompleteReply MessageHeader
_ [Text]
matches Width
start Width
end Metadata
metadata Bool
status) =
    [(Key, Value)] -> Value
object
      [ Key
"matches" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
matches
      , Key
"cursor_start" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Width
start
      , Key
"cursor_end" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Width
end
      , Key
"metadata" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Metadata
metadata
      , Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= if Bool
status
                      then ShowS
string String
"ok"
                      else String
"error"
      ]
  toJSON i :: Message
i@InspectReply{} =
    [(Key, Value)] -> Value
object
      [ Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= if Message -> Bool
inspectStatus Message
i
                      then ShowS
string String
"ok"
                      else String
"error"
      , Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object (forall a b. (a -> b) -> [a] -> [b]
map DisplayData -> (Key, Value)
displayDataToJson forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> [DisplayData]
inspectData forall a b. (a -> b) -> a -> b
$ Message
i)
      , Key
"metadata" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object []
      , Key
"found" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> Bool
inspectStatus Message
i
      ]

  toJSON ShutdownReply { restartPending :: Message -> Bool
restartPending = Bool
restart } =
    [(Key, Value)] -> Value
object [Key
"restart" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
restart
           , Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShowS
string String
"ok"
           ]

  toJSON ClearOutput { wait :: Message -> Bool
wait = Bool
wait } =
    [(Key, Value)] -> Value
object [Key
"wait" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
wait]

  toJSON RequestInput { inputPrompt :: Message -> String
inputPrompt = String
prompt } =
    [(Key, Value)] -> Value
object [Key
"prompt" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
prompt]

  toJSON req :: Message
req@CommOpen{} =
    [(Key, Value)] -> Value
object
      [ Key
"comm_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> UUID
commUuid Message
req
      , Key
"target_name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> String
commTargetName Message
req
      , Key
"target_module" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> String
commTargetModule Message
req
      , Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> Value
commData Message
req
      ]

  toJSON req :: Message
req@CommData{} =
    [(Key, Value)] -> Value
object [Key
"comm_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> UUID
commUuid Message
req, Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> Value
commData Message
req]

  toJSON req :: Message
req@CommClose{} =
    [(Key, Value)] -> Value
object [Key
"comm_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> UUID
commUuid Message
req, Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> Value
commData Message
req]

  toJSON req :: Message
req@HistoryReply{} =
    [(Key, Value)] -> Value
object [Key
"history" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a -> b) -> [a] -> [b]
map HistoryReplyElement -> (Width, Width, Value)
tuplify (Message -> [HistoryReplyElement]
historyReply Message
req)
           , Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShowS
string String
"ok"
           ]
    where
      tuplify :: HistoryReplyElement -> (Width, Width, Value)
tuplify (HistoryReplyElement Width
sess Width
linum Either String (String, String)
res) = (Width
sess, Width
linum, case Either String (String, String)
res of
                                                                     Left String
inp         -> forall a. ToJSON a => a -> Value
toJSON String
inp
                                                                     Right (String
inp, String
out) -> forall a. ToJSON a => a -> Value
toJSON String
out)

  toJSON req :: Message
req@IsCompleteReply{} =
    [(Key, Value)] -> Value
object [(Key, Value)]
pairs
    where
      pairs :: [(Key, Value)]
pairs =
        case Message -> CodeReview
reviewResult Message
req of
          CodeReview
CodeComplete       -> forall {a}. KeyValue a => String -> [a]
status String
"complete"
          CodeIncomplete String
ind -> forall {a}. KeyValue a => String -> [a]
status String
"incomplete" forall a. [a] -> [a] -> [a]
++ forall {a}. KeyValue a => String -> [a]
indent String
ind
          CodeReview
CodeInvalid        -> forall {a}. KeyValue a => String -> [a]
status String
"invalid"
          CodeReview
CodeUnknown        -> forall {a}. KeyValue a => String -> [a]
status String
"unknown"
      status :: String -> [a]
status String
x = [Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> Text
pack String
x]
      indent :: String -> [a]
indent String
x = [Key
"indent" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> Text
pack String
x]

  toJSON Message
body = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Do not know how to convert to JSON for message " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Message
body

  toEncoding :: Message -> Encoding
toEncoding rep :: Message
rep@KernelInfoReply{} =
    Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
      [ Key
"protocol_version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> String
protocolVersion Message
rep
      , Key
"banner" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> String
banner Message
rep
      , Key
"implementation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> String
implementation Message
rep
      , Key
"implementation_version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> String
implementationVersion Message
rep
      , Key
"language_info" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> LanguageInfo
languageInfo Message
rep
      , Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. Show a => a -> String
show (Message -> ExecuteReplyStatus
status Message
rep)
      ]

  toEncoding CommInfoReply
    { header :: Message -> MessageHeader
header = MessageHeader
header
    , commInfo :: Message -> Map String String
commInfo = Map String String
commInfo
    } =
    Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
      [ Key
"comms" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\String
comm -> [(Key, Value)] -> Value
object [Key
"target_name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
comm]) Map String String
commInfo
      , Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShowS
string String
"ok"
      ]

  toEncoding ExecuteRequest
    { getCode :: Message -> Text
getCode = Text
code
    , getSilent :: Message -> Bool
getSilent = Bool
silent
    , getStoreHistory :: Message -> Bool
getStoreHistory = Bool
storeHistory
    , getAllowStdin :: Message -> Bool
getAllowStdin = Bool
allowStdin
    , getUserExpressions :: Message -> [Text]
getUserExpressions = [Text]
userExpressions
    } =
    Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
      [ Key
"code" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
code
      , Key
"silent" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
silent
      , Key
"store_history" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
storeHistory
      , Key
"allow_stdin" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
allowStdin
      , Key
"user_expressions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
userExpressions
      ]

  toEncoding ExecuteReply { status :: Message -> ExecuteReplyStatus
status = ExecuteReplyStatus
status, executionCounter :: Message -> Width
executionCounter = Width
counter, pagerOutput :: Message -> [DisplayData]
pagerOutput = [DisplayData]
pager } =
    Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
      [ Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. Show a => a -> String
show ExecuteReplyStatus
status
      , Key
"execution_count" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Width
counter
      , Key
"payload" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
        if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DisplayData]
pager
          then []
          else [DisplayData] -> [Value]
mkPayload [DisplayData]
pager
      , Key
"user_expressions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map String String
emptyMap
      ]
    where
      mkPayload :: [DisplayData] -> [Value]
mkPayload [DisplayData]
o = [ [(Key, Value)] -> Value
object
                        [ Key
"source" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShowS
string String
"page"
                        , Key
"start" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Scientific -> Value
Number Scientific
0
                        , Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object (forall a b. (a -> b) -> [a] -> [b]
map DisplayData -> (Key, Value)
displayDataToJson [DisplayData]
o)
                        ]
                    ]
  -- `header` is not a supported field, but removing it would complicate things
  -- downstream in terms of dependency bounds so we just drop it on the floor
  toEncoding ExecuteError { header :: Message -> MessageHeader
header = MessageHeader
_header, traceback :: Message -> [Text]
traceback = [Text]
traceback, ename :: Message -> Text
ename = Text
ename, evalue :: Message -> Text
evalue = Text
evalue } =
    Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
      [ Key
"traceback" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a -> b) -> [a] -> [b]
map forall a. ToJSON a => a -> Value
toJSON [Text]
traceback
      , Key
"ename" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
ename
      , Key
"evalue" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
evalue
      ]
  toEncoding PublishStatus { executionState :: Message -> ExecutionState
executionState = ExecutionState
executionState } =
    Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Key
"execution_state" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ExecutionState
executionState]
  toEncoding PublishStream { streamType :: Message -> StreamType
streamType = StreamType
streamType, streamContent :: Message -> String
streamContent = String
content } =
    -- Since 5.0 "data" key was renamed to "text""
    Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Key
"text" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
content, Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StreamType
streamType, Key
"output_type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShowS
string String
"stream"]
  toEncoding r :: Message
r@PublishDisplayData { displayData :: Message -> [DisplayData]
displayData = [DisplayData]
datas }
    = Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    forall a b. (a -> b) -> a -> b
$ case Message -> Maybe Transient
transient Message
r of
        Just Transient
t  -> ((Key
"transient" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON (Message -> Maybe Transient
transient Message
r)) forall a. a -> [a] -> [a]
:)
        Maybe Transient
Nothing -> forall a. a -> a
id
    forall a b. (a -> b) -> a -> b
$ [Key
"metadata" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object []
      , Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object (forall a b. (a -> b) -> [a] -> [b]
map DisplayData -> (Key, Value)
displayDataToJson [DisplayData]
datas)
      ]
  toEncoding r :: Message
r@PublishUpdateDisplayData { displayData :: Message -> [DisplayData]
displayData = [DisplayData]
datas }
    = Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    forall a b. (a -> b) -> a -> b
$ case Message -> Maybe Transient
transient Message
r of
        Just Transient
t  -> ((Key
"transient" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON (Message -> Maybe Transient
transient Message
r)) forall a. a -> [a] -> [a]
:)
        Maybe Transient
Nothing -> forall a. a -> a
id
    forall a b. (a -> b) -> a -> b
$ [Key
"metadata" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object []
      , Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object (forall a b. (a -> b) -> [a] -> [b]
map DisplayData -> (Key, Value)
displayDataToJson [DisplayData]
datas)
      ]
  toEncoding PublishOutput { executionCount :: Message -> Width
executionCount = Width
execCount, reprText :: Message -> String
reprText = String
reprText } =
    Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
      [ Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object [Key
"text/plain" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
reprText]
      , Key
"execution_count" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Width
execCount
      , Key
"metadata" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object []
      ]
  toEncoding PublishInput { executionCount :: Message -> Width
executionCount = Width
execCount, inCode :: Message -> String
inCode = String
code } =
    Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Key
"execution_count" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Width
execCount, Key
"code" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
code]
  toEncoding (CompleteReply MessageHeader
_ [Text]
matches Width
start Width
end Metadata
metadata Bool
status) =
    Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
      [ Key
"matches" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
matches
      , Key
"cursor_start" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Width
start
      , Key
"cursor_end" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Width
end
      , Key
"metadata" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Metadata
metadata
      , Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= if Bool
status
                      then ShowS
string String
"ok"
                      else String
"error"
      ]
  toEncoding i :: Message
i@InspectReply{} =
    Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
      [ Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= if Message -> Bool
inspectStatus Message
i
                      then ShowS
string String
"ok"
                      else String
"error"
      , Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object (forall a b. (a -> b) -> [a] -> [b]
map DisplayData -> (Key, Value)
displayDataToJson forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> [DisplayData]
inspectData forall a b. (a -> b) -> a -> b
$ Message
i)
      , Key
"metadata" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object []
      , Key
"found" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> Bool
inspectStatus Message
i
      ]

  toEncoding ShutdownReply { restartPending :: Message -> Bool
restartPending = Bool
restart } =
    Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Key
"restart" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
restart
                    , Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShowS
string String
"ok"
                    ]

  toEncoding ClearOutput { wait :: Message -> Bool
wait = Bool
wait } =
    Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Key
"wait" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
wait]

  toEncoding RequestInput { inputPrompt :: Message -> String
inputPrompt = String
prompt } =
    Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Key
"prompt" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
prompt]

  toEncoding req :: Message
req@CommOpen{} =
    Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
      [ Key
"comm_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> UUID
commUuid Message
req
      , Key
"target_name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> String
commTargetName Message
req
      , Key
"target_module" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> String
commTargetModule Message
req
      , Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> Value
commData Message
req
      ]

  toEncoding req :: Message
req@CommData{} =
    Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Key
"comm_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> UUID
commUuid Message
req, Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> Value
commData Message
req]

  toEncoding req :: Message
req@CommClose{} =
    Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Key
"comm_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> UUID
commUuid Message
req, Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Message -> Value
commData Message
req]

  toEncoding req :: Message
req@HistoryReply{} =
    Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Key
"history" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a -> b) -> [a] -> [b]
map HistoryReplyElement -> (Width, Width, Value)
tuplify (Message -> [HistoryReplyElement]
historyReply Message
req)
                    , Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShowS
string String
"ok"
                    ]
    where
      tuplify :: HistoryReplyElement -> (Width, Width, Value)
tuplify (HistoryReplyElement Width
sess Width
linum Either String (String, String)
res) = (Width
sess, Width
linum, case Either String (String, String)
res of
                                                                     Left String
inp         -> forall a. ToJSON a => a -> Value
toJSON String
inp
                                                                     Right (String
inp, String
out) -> forall a. ToJSON a => a -> Value
toJSON String
out)

  toEncoding req :: Message
req@IsCompleteReply{} =
    Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Series]
replyPairs
    where
      replyPairs :: [Series]
replyPairs =
        case Message -> CodeReview
reviewResult Message
req of
          CodeReview
CodeComplete       -> forall {a}. KeyValue a => String -> [a]
status String
"complete"
          CodeIncomplete String
ind -> forall {a}. KeyValue a => String -> [a]
status String
"incomplete" forall a. [a] -> [a] -> [a]
++ forall {a}. KeyValue a => String -> [a]
indent String
ind
          CodeReview
CodeInvalid        -> forall {a}. KeyValue a => String -> [a]
status String
"invalid"
          CodeReview
CodeUnknown        -> forall {a}. KeyValue a => String -> [a]
status String
"unknown"
      status :: String -> [a]
status String
x = [Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> Text
pack String
x]
      indent :: String -> [a]
indent String
x = [Key
"indent" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> Text
pack String
x]

  toEncoding Message
body = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Do not know how to convert to JSON for message " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Message
body




-- | Ways in which the frontend can request history. TODO: Implement fields as described in
-- messaging spec.
data HistoryAccessType = HistoryRange
                       | HistoryTail
                       | HistorySearch
  deriving (HistoryAccessType -> HistoryAccessType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HistoryAccessType -> HistoryAccessType -> Bool
$c/= :: HistoryAccessType -> HistoryAccessType -> Bool
== :: HistoryAccessType -> HistoryAccessType -> Bool
$c== :: HistoryAccessType -> HistoryAccessType -> Bool
Eq, Width -> HistoryAccessType -> ShowS
[HistoryAccessType] -> ShowS
HistoryAccessType -> String
forall a.
(Width -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HistoryAccessType] -> ShowS
$cshowList :: [HistoryAccessType] -> ShowS
show :: HistoryAccessType -> String
$cshow :: HistoryAccessType -> String
showsPrec :: Width -> HistoryAccessType -> ShowS
$cshowsPrec :: Width -> HistoryAccessType -> ShowS
Show)

-- | Reply to history requests.
data HistoryReplyElement =
       HistoryReplyElement
         { HistoryReplyElement -> Width
historyReplySession :: Int
         , HistoryReplyElement -> Width
historyReplyLineNumber :: Int
         , HistoryReplyElement -> Either String (String, String)
historyReplyContent :: Either String (String, String)
         }
  deriving (HistoryReplyElement -> HistoryReplyElement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HistoryReplyElement -> HistoryReplyElement -> Bool
$c/= :: HistoryReplyElement -> HistoryReplyElement -> Bool
== :: HistoryReplyElement -> HistoryReplyElement -> Bool
$c== :: HistoryReplyElement -> HistoryReplyElement -> Bool
Eq, Width -> HistoryReplyElement -> ShowS
[HistoryReplyElement] -> ShowS
HistoryReplyElement -> String
forall a.
(Width -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HistoryReplyElement] -> ShowS
$cshowList :: [HistoryReplyElement] -> ShowS
show :: HistoryReplyElement -> String
$cshow :: HistoryReplyElement -> String
showsPrec :: Width -> HistoryReplyElement -> ShowS
$cshowsPrec :: Width -> HistoryReplyElement -> ShowS
Show)

-- | Possible statuses in the execution reply messages.
data ExecuteReplyStatus = Ok
                        | Err
                        | Abort

instance FromJSON ExecuteReplyStatus where
  parseJSON :: Value -> Parser ExecuteReplyStatus
parseJSON (String Text
"ok") = forall (m :: * -> *) a. Monad m => a -> m a
return ExecuteReplyStatus
Ok
  parseJSON (String Text
"error") = forall (m :: * -> *) a. Monad m => a -> m a
return ExecuteReplyStatus
Err
  parseJSON (String Text
"abort") = forall (m :: * -> *) a. Monad m => a -> m a
return ExecuteReplyStatus
Abort
  parseJSON Value
invalid = forall a. String -> Value -> Parser a
typeMismatch String
"ExecuteReplyStatus" Value
invalid

instance Show ExecuteReplyStatus where
  show :: ExecuteReplyStatus -> String
show ExecuteReplyStatus
Ok = String
"ok"
  show ExecuteReplyStatus
Err = String
"error"
  show ExecuteReplyStatus
Abort = String
"abort"

-- | The execution state of the kernel.
data ExecutionState = Busy
                    | Idle
                    | Starting
  deriving Width -> ExecutionState -> ShowS
[ExecutionState] -> ShowS
ExecutionState -> String
forall a.
(Width -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecutionState] -> ShowS
$cshowList :: [ExecutionState] -> ShowS
show :: ExecutionState -> String
$cshow :: ExecutionState -> String
showsPrec :: Width -> ExecutionState -> ShowS
$cshowsPrec :: Width -> ExecutionState -> ShowS
Show

instance FromJSON ExecutionState where
  parseJSON :: Value -> Parser ExecutionState
parseJSON (String Text
"busy") = forall (m :: * -> *) a. Monad m => a -> m a
return ExecutionState
Busy
  parseJSON (String Text
"idle") = forall (m :: * -> *) a. Monad m => a -> m a
return ExecutionState
Idle
  parseJSON (String Text
"starting") = forall (m :: * -> *) a. Monad m => a -> m a
return ExecutionState
Starting
  parseJSON Value
invalid = forall a. String -> Value -> Parser a
typeMismatch String
"ExecutionState" Value
invalid

-- | Print an execution state as "busy", "idle", or "starting".
instance ToJSON ExecutionState where
  toJSON :: ExecutionState -> Value
toJSON ExecutionState
Busy = Text -> Value
String Text
"busy"
  toJSON ExecutionState
Idle = Text -> Value
String Text
"idle"
  toJSON ExecutionState
Starting = Text -> Value
String Text
"starting"

-- | Input and output streams.
data StreamType = Stdin
                | Stdout
                | Stderr
  deriving Width -> StreamType -> ShowS
[StreamType] -> ShowS
StreamType -> String
forall a.
(Width -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StreamType] -> ShowS
$cshowList :: [StreamType] -> ShowS
show :: StreamType -> String
$cshow :: StreamType -> String
showsPrec :: Width -> StreamType -> ShowS
$cshowsPrec :: Width -> StreamType -> ShowS
Show

instance FromJSON StreamType where
  parseJSON :: Value -> Parser StreamType
parseJSON (String Text
"stdin") = forall (m :: * -> *) a. Monad m => a -> m a
return StreamType
Stdin
  parseJSON (String Text
"stdout") = forall (m :: * -> *) a. Monad m => a -> m a
return StreamType
Stdout
  parseJSON (String Text
"stderr") = forall (m :: * -> *) a. Monad m => a -> m a
return StreamType
Stderr
  parseJSON Value
invalid = forall a. String -> Value -> Parser a
typeMismatch String
"StreamType" Value
invalid

-- | Print a stream as "stdin" or "stdout" strings.
instance ToJSON StreamType where
  toJSON :: StreamType -> Value
toJSON StreamType
Stdin = Text -> Value
String Text
"stdin"
  toJSON StreamType
Stdout = Text -> Value
String Text
"stdout"
  toJSON StreamType
Stderr = Text -> Value
String Text
"stderr"

-- | Get the reply message type for a request message type.
replyType :: MessageType -> Maybe MessageType
replyType :: MessageType -> Maybe MessageType
replyType MessageType
KernelInfoRequestMessage = forall a. a -> Maybe a
Just MessageType
KernelInfoReplyMessage
replyType MessageType
ExecuteRequestMessage = forall a. a -> Maybe a
Just MessageType
ExecuteReplyMessage
replyType MessageType
IsCompleteRequestMessage = forall a. a -> Maybe a
Just MessageType
IsCompleteReplyMessage
replyType MessageType
CompleteRequestMessage = forall a. a -> Maybe a
Just MessageType
CompleteReplyMessage
replyType MessageType
InspectRequestMessage = forall a. a -> Maybe a
Just MessageType
InspectReplyMessage
replyType MessageType
ShutdownRequestMessage = forall a. a -> Maybe a
Just MessageType
ShutdownReplyMessage
replyType MessageType
HistoryRequestMessage = forall a. a -> Maybe a
Just MessageType
HistoryReplyMessage
replyType MessageType
CommOpenMessage = forall a. a -> Maybe a
Just MessageType
CommDataMessage
replyType MessageType
CommInfoRequestMessage = forall a. a -> Maybe a
Just MessageType
CommInfoReplyMessage
replyType MessageType
_ = forall a. Maybe a
Nothing

-- | Data for display: a string with associated MIME type.
data DisplayData = DisplayData MimeType Text
  deriving (Typeable, DisplayData -> DisplayData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisplayData -> DisplayData -> Bool
$c/= :: DisplayData -> DisplayData -> Bool
== :: DisplayData -> DisplayData -> Bool
$c== :: DisplayData -> DisplayData -> Bool
Eq, forall x. Rep DisplayData x -> DisplayData
forall x. DisplayData -> Rep DisplayData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DisplayData x -> DisplayData
$cfrom :: forall x. DisplayData -> Rep DisplayData x
Generic)

-- We can't print the actual data, otherwise this will be printed every time it gets computed
-- because of the way the evaluator is structured. See how `displayExpr` is computed.
instance Show DisplayData where
  show :: DisplayData -> String
show DisplayData
_ = String
"DisplayData"

instance Binary DisplayData

instance Binary MimeType

-- | Possible MIME types for the display data.
type Width = Int

type Height = Int

data MimeType = PlainText
              | MimeHtml
              | MimeBmp Width Height
              | MimePng Width Height
              | MimeJpg Width Height
              | MimeGif Width Height
              | MimeSvg
              | MimeLatex
              | MimeMarkdown
              | MimeJavascript
              | MimeJson
              | MimeVega
              | MimeVegalite
              | MimeVdom
              | MimeWidget
              | MimeCustom Text
  deriving (MimeType -> MimeType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MimeType -> MimeType -> Bool
$c/= :: MimeType -> MimeType -> Bool
== :: MimeType -> MimeType -> Bool
$c== :: MimeType -> MimeType -> Bool
Eq, Typeable, forall x. Rep MimeType x -> MimeType
forall x. MimeType -> Rep MimeType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MimeType x -> MimeType
$cfrom :: forall x. MimeType -> Rep MimeType x
Generic)

-- Extract the plain text from a list of displays.
extractPlain :: [DisplayData] -> String
extractPlain :: [DisplayData] -> String
extractPlain [DisplayData]
disps =
  case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find DisplayData -> Bool
isPlain [DisplayData]
disps of
    Maybe DisplayData
Nothing                              -> String
""
    Just (DisplayData MimeType
PlainText Text
bytestr) -> Text -> String
Text.unpack Text
bytestr
    Just DisplayData
_                               -> String
""
  where
    isPlain :: DisplayData -> Bool
isPlain (DisplayData MimeType
mime Text
_) = MimeType
mime forall a. Eq a => a -> a -> Bool
== MimeType
PlainText

instance Show MimeType where
  show :: MimeType -> String
show MimeType
PlainText = String
"text/plain"
  show MimeType
MimeHtml = String
"text/html"
  show (MimeBmp Width
_ Width
_) = String
"image/bmp"
  show (MimePng Width
_ Width
_) = String
"image/png"
  show (MimeJpg Width
_ Width
_) = String
"image/jpeg"
  show (MimeGif Width
_ Width
_) = String
"image/gif"
  show MimeType
MimeSvg = String
"image/svg+xml"
  show MimeType
MimeLatex = String
"text/latex"
  show MimeType
MimeMarkdown = String
"text/markdown"
  show MimeType
MimeJavascript = String
"application/javascript"
  show MimeType
MimeJson = String
"application/json"
  show MimeType
MimeVega = String
"application/vnd.vega.v5+json"
  show MimeType
MimeVegalite = String
"application/vnd.vegalite.v4+json"
  show MimeType
MimeVdom = String
"application/vdom.v1+json"
  show MimeType
MimeWidget = String
"application/vnd.jupyter.widget-view+json"
  show (MimeCustom Text
custom) = Text -> String
Text.unpack Text
custom

instance Read MimeType where
  readsPrec :: Width -> ReadS MimeType
readsPrec Width
_ String
"text/plain" = [(MimeType
PlainText, String
"")]
  readsPrec Width
_ String
"text/html" = [(MimeType
MimeHtml, String
"")]
  readsPrec Width
_ String
"image/bmp" = [(Width -> Width -> MimeType
MimeBmp Width
50 Width
50, String
"")]
  readsPrec Width
_ String
"image/png" = [(Width -> Width -> MimeType
MimePng Width
50 Width
50, String
"")]
  readsPrec Width
_ String
"image/jpg" = [(Width -> Width -> MimeType
MimeJpg Width
50 Width
50, String
"")]
  readsPrec Width
_ String
"image/gif" = [(Width -> Width -> MimeType
MimeGif Width
50 Width
50, String
"")]
  readsPrec Width
_ String
"image/svg+xml" = [(MimeType
MimeSvg, String
"")]
  readsPrec Width
_ String
"text/latex" = [(MimeType
MimeLatex, String
"")]
  readsPrec Width
_ String
"text/markdown" = [(MimeType
MimeMarkdown, String
"")]
  readsPrec Width
_ String
"application/javascript" = [(MimeType
MimeJavascript, String
"")]
  readsPrec Width
_ String
"application/json" = [(MimeType
MimeJson, String
"")]
  readsPrec Width
_ String
"application/vnd.vega.v5+json" = [(MimeType
MimeVega, String
"")]
  readsPrec Width
_ String
"application/vnd.vegalite.v4+json" = [(MimeType
MimeVegalite, String
"")]
  readsPrec Width
_ String
"application/vdom.v1+json" = [(MimeType
MimeVdom, String
"")]
  readsPrec Width
_ String
"application/vnd.jupyter.widget-view+json" = [(MimeType
MimeWidget, String
"")]
  readsPrec Width
_ String
t = [(Text -> MimeType
MimeCustom (String -> Text
Text.pack String
t), String
"")]

-- | Convert a MIME type and value into a JSON dictionary pair.
#if MIN_VERSION_aeson(2,0,0)
displayDataToJson :: DisplayData -> (Key, Value)
displayDataToJson :: DisplayData -> (Key, Value)
displayDataToJson (DisplayData MimeType
MimeJson Text
dataStr) =
    Text -> Key
fromText (String -> Text
pack (forall a. Show a => a -> String
show MimeType
MimeJson)) forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. a -> Maybe a -> a
fromMaybe (Text -> Value
String Text
"") (forall a. FromJSON a => ByteString -> Maybe a
decodeStrict (Text -> ByteString
Text.encodeUtf8 Text
dataStr) :: Maybe Value)
displayDataToJson (DisplayData MimeType
MimeVegalite Text
dataStr) =
    Text -> Key
fromText (String -> Text
pack (forall a. Show a => a -> String
show MimeType
MimeVegalite)) forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. a -> Maybe a -> a
fromMaybe (Text -> Value
String Text
"") (forall a. FromJSON a => ByteString -> Maybe a
decodeStrict (Text -> ByteString
Text.encodeUtf8 Text
dataStr) :: Maybe Value)
displayDataToJson (DisplayData MimeType
MimeVega Text
dataStr) =
    Text -> Key
fromText (String -> Text
pack (forall a. Show a => a -> String
show MimeType
MimeVega)) forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. a -> Maybe a -> a
fromMaybe (Text -> Value
String Text
"") (forall a. FromJSON a => ByteString -> Maybe a
decodeStrict (Text -> ByteString
Text.encodeUtf8 Text
dataStr) :: Maybe Value)
displayDataToJson (DisplayData MimeType
MimeWidget Text
dataStr) =
    Text -> Key
fromText (String -> Text
pack (forall a. Show a => a -> String
show MimeType
MimeWidget)) forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. a -> Maybe a -> a
fromMaybe ([(Key, Value)] -> Value
object []) (forall a. FromJSON a => ByteString -> Maybe a
decodeStrict (Text -> ByteString
Text.encodeUtf8 Text
dataStr) :: Maybe Value)
displayDataToJson (DisplayData MimeType
mimeType Text
dataStr) =
    Text -> Key
fromText (String -> Text
pack (forall a. Show a => a -> String
show MimeType
mimeType)) forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
dataStr
#else
displayDataToJson :: DisplayData -> (Text, Value)
displayDataToJson (DisplayData MimeJson dataStr) =
    pack (show MimeJson) .= fromMaybe (String "") (decodeStrict (Text.encodeUtf8 dataStr) :: Maybe Value)
displayDataToJson (DisplayData MimeVegalite dataStr) =
    pack (show MimeVegalite) .= fromMaybe (String "") (decodeStrict (Text.encodeUtf8 dataStr) :: Maybe Value)
displayDataToJson (DisplayData MimeVega dataStr) =
    pack (show MimeVega) .= fromMaybe (String "") (decodeStrict (Text.encodeUtf8 dataStr) :: Maybe Value)
displayDataToJson (DisplayData MimeWidget dataStr) =
    pack (show MimeWidget) .= fromMaybe (object []) (decodeStrict (Text.encodeUtf8 dataStr) :: Maybe Value)
displayDataToJson (DisplayData mimeType dataStr) =
    pack (show mimeType) .= String dataStr
#endif

string :: String -> String
string :: ShowS
string = forall a. a -> a
id

emptyMap :: Map String String
emptyMap :: Map String String
emptyMap = forall a. Monoid a => a
mempty