{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Use newtype instead of data" #-}

{- |
Module      : MCP.Protocol
Description : JSON-RPC protocol implementation for MCP version 2025-06-18
Copyright   : (C) 2025 Matthias Pall Gissurarson
License     : MIT
Maintainer  : mpg@mpg.is
Stability   : experimental
Portability : GHC

This module implements the JSON-RPC 2.0 protocol layer for MCP version 2025-06-18,
including request/response handling, message parsing and encoding, and protocol-level
error handling. Supports all MCP operations including initialization, resources,
tools, prompts, completion, sampling, elicitation, and notifications.

New in 2025-06-18:
- Enhanced completion requests with context parameters
- Elicitation system for interactive user input
- Sampling message restrictions for LLM compatibility
- Comprehensive _meta field support throughout protocol messages
- Resource template references with correct schema compliance
-}
module MCP.Protocol (
    -- * JSON-RPC Types
    JSONRPCRequest (..),
    JSONRPCResponse (..),
    JSONRPCError (..),
    JSONRPCNotification (..),
    JSONRPCMessage (..),
    JSONRPCErrorInfo (..),
    CompletionContext (..),

    -- * Client Request Types
    InitializeRequest (..),
    InitializeParams (..),
    PingRequest (..),
    PingParams (..),
    ListResourcesRequest (..),
    ListResourcesParams (..),
    ListResourceTemplatesRequest (..),
    ListResourceTemplatesParams (..),
    ReadResourceRequest (..),
    ReadResourceParams (..),
    SubscribeRequest (..),
    SubscribeParams (..),
    UnsubscribeRequest (..),
    UnsubscribeParams (..),
    ListPromptsRequest (..),
    ListPromptsParams (..),
    GetPromptRequest (..),
    GetPromptParams (..),
    ListToolsRequest (..),
    ListToolsParams (..),
    CallToolRequest (..),
    CallToolParams (..),
    SetLevelRequest (..),
    SetLevelParams (..),
    CompleteRequest (..),
    CompleteParams (..),
    CompletionArgument (..),
    Reference (..),

    -- * Server Request Types
    CreateMessageRequest (..),
    CreateMessageParams (..),
    ListRootsRequest (..),
    ListRootsParams (..),
    ElicitRequest (..),
    ElicitParams (..),

    -- * Response Types
    InitializeResult (..),
    ListResourcesResult (..),
    ListResourceTemplatesResult (..),
    ReadResourceResult (..),
    ListPromptsResult (..),
    GetPromptResult (..),
    ListToolsResult (..),
    CallToolResult (..),
    CompleteResult (..),
    CompletionResult (..),
    CreateMessageResult (..),
    ListRootsResult (..),
    ElicitResult (..),
    
    -- * Schema Types
    PrimitiveSchemaDefinition (..),
    StringSchema (..),
    NumberSchema (..),
    BooleanSchema (..),
    EnumSchema (..),

    -- * Notification Types
    CancelledNotification (..),
    CancelledParams (..),
    InitializedNotification (..),
    InitializedParams (..),
    ProgressNotification (..),
    ProgressParams (..),
    ResourceListChangedNotification (..),
    ResourceUpdatedNotification (..),
    ResourceUpdatedParams (..),
    PromptListChangedNotification (..),
    ToolListChangedNotification (..),
    LoggingMessageNotification (..),
    LoggingMessageParams (..),
    RootsListChangedNotification (..),

    -- * Union Types
    ClientRequest (..),
    ServerRequest (..),
    ClientNotification (..),
    ServerNotification (..),
) where

import Control.Applicative ((<|>))
import Data.Aeson hiding (Object)
import Data.Aeson.Types (Object)
import Data.Aeson.TH
import Data.Map (Map)
import Data.Text (Text)
import GHC.Generics

import MCP.Types

-- * JSON-RPC Types

-- | JSON-RPC error information
data JSONRPCErrorInfo = JSONRPCErrorInfo
    { JSONRPCErrorInfo -> Int
code :: Int
    , JSONRPCErrorInfo -> Text
message :: Text
    , JSONRPCErrorInfo -> Maybe Value
errorData :: Maybe Value
    }
    deriving stock (Int -> JSONRPCErrorInfo -> ShowS
[JSONRPCErrorInfo] -> ShowS
JSONRPCErrorInfo -> String
(Int -> JSONRPCErrorInfo -> ShowS)
-> (JSONRPCErrorInfo -> String)
-> ([JSONRPCErrorInfo] -> ShowS)
-> Show JSONRPCErrorInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JSONRPCErrorInfo -> ShowS
showsPrec :: Int -> JSONRPCErrorInfo -> ShowS
$cshow :: JSONRPCErrorInfo -> String
show :: JSONRPCErrorInfo -> String
$cshowList :: [JSONRPCErrorInfo] -> ShowS
showList :: [JSONRPCErrorInfo] -> ShowS
Show, JSONRPCErrorInfo -> JSONRPCErrorInfo -> Bool
(JSONRPCErrorInfo -> JSONRPCErrorInfo -> Bool)
-> (JSONRPCErrorInfo -> JSONRPCErrorInfo -> Bool)
-> Eq JSONRPCErrorInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JSONRPCErrorInfo -> JSONRPCErrorInfo -> Bool
== :: JSONRPCErrorInfo -> JSONRPCErrorInfo -> Bool
$c/= :: JSONRPCErrorInfo -> JSONRPCErrorInfo -> Bool
/= :: JSONRPCErrorInfo -> JSONRPCErrorInfo -> Bool
Eq, (forall x. JSONRPCErrorInfo -> Rep JSONRPCErrorInfo x)
-> (forall x. Rep JSONRPCErrorInfo x -> JSONRPCErrorInfo)
-> Generic JSONRPCErrorInfo
forall x. Rep JSONRPCErrorInfo x -> JSONRPCErrorInfo
forall x. JSONRPCErrorInfo -> Rep JSONRPCErrorInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JSONRPCErrorInfo -> Rep JSONRPCErrorInfo x
from :: forall x. JSONRPCErrorInfo -> Rep JSONRPCErrorInfo x
$cto :: forall x. Rep JSONRPCErrorInfo x -> JSONRPCErrorInfo
to :: forall x. Rep JSONRPCErrorInfo x -> JSONRPCErrorInfo
Generic)

instance ToJSON JSONRPCErrorInfo where
    toJSON :: JSONRPCErrorInfo -> Value
toJSON (JSONRPCErrorInfo Int
c Text
m Maybe Value
d) =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
            [ Key
"code" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
c
            , Key
"message" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
m
            ]
                [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Value -> [Pair]) -> Maybe Value -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Value
ed -> [Key
"data" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
ed]) Maybe Value
d

instance FromJSON JSONRPCErrorInfo where
    parseJSON :: Value -> Parser JSONRPCErrorInfo
parseJSON = String
-> (Object -> Parser JSONRPCErrorInfo)
-> Value
-> Parser JSONRPCErrorInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JSONRPCErrorInfo" ((Object -> Parser JSONRPCErrorInfo)
 -> Value -> Parser JSONRPCErrorInfo)
-> (Object -> Parser JSONRPCErrorInfo)
-> Value
-> Parser JSONRPCErrorInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (Int -> Text -> Maybe Value -> JSONRPCErrorInfo)
-> Parser Int -> Parser (Text -> Maybe Value -> JSONRPCErrorInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code" Parser (Text -> Maybe Value -> JSONRPCErrorInfo)
-> Parser Text -> Parser (Maybe Value -> JSONRPCErrorInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message" Parser (Maybe Value -> JSONRPCErrorInfo)
-> Parser (Maybe Value) -> Parser JSONRPCErrorInfo
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"data"

-- | A JSON-RPC request that expects a response
data JSONRPCRequest = JSONRPCRequest
    { JSONRPCRequest -> Text
jsonrpc :: Text -- Always "2.0"
    , JSONRPCRequest -> RequestId
id :: RequestId
    , JSONRPCRequest -> Text
method :: Text
    , JSONRPCRequest -> Maybe Value
params :: Maybe Value
    }
    deriving stock (Int -> JSONRPCRequest -> ShowS
[JSONRPCRequest] -> ShowS
JSONRPCRequest -> String
(Int -> JSONRPCRequest -> ShowS)
-> (JSONRPCRequest -> String)
-> ([JSONRPCRequest] -> ShowS)
-> Show JSONRPCRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JSONRPCRequest -> ShowS
showsPrec :: Int -> JSONRPCRequest -> ShowS
$cshow :: JSONRPCRequest -> String
show :: JSONRPCRequest -> String
$cshowList :: [JSONRPCRequest] -> ShowS
showList :: [JSONRPCRequest] -> ShowS
Show, JSONRPCRequest -> JSONRPCRequest -> Bool
(JSONRPCRequest -> JSONRPCRequest -> Bool)
-> (JSONRPCRequest -> JSONRPCRequest -> Bool) -> Eq JSONRPCRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JSONRPCRequest -> JSONRPCRequest -> Bool
== :: JSONRPCRequest -> JSONRPCRequest -> Bool
$c/= :: JSONRPCRequest -> JSONRPCRequest -> Bool
/= :: JSONRPCRequest -> JSONRPCRequest -> Bool
Eq, (forall x. JSONRPCRequest -> Rep JSONRPCRequest x)
-> (forall x. Rep JSONRPCRequest x -> JSONRPCRequest)
-> Generic JSONRPCRequest
forall x. Rep JSONRPCRequest x -> JSONRPCRequest
forall x. JSONRPCRequest -> Rep JSONRPCRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JSONRPCRequest -> Rep JSONRPCRequest x
from :: forall x. JSONRPCRequest -> Rep JSONRPCRequest x
$cto :: forall x. Rep JSONRPCRequest x -> JSONRPCRequest
to :: forall x. Rep JSONRPCRequest x -> JSONRPCRequest
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True} ''JSONRPCRequest)

-- | A successful JSON-RPC response
data JSONRPCResponse = JSONRPCResponse
    { JSONRPCResponse -> Text
jsonrpc :: Text -- Always "2.0"
    , JSONRPCResponse -> RequestId
id :: RequestId
    , JSONRPCResponse -> Value
result :: Value
    }
    deriving stock (Int -> JSONRPCResponse -> ShowS
[JSONRPCResponse] -> ShowS
JSONRPCResponse -> String
(Int -> JSONRPCResponse -> ShowS)
-> (JSONRPCResponse -> String)
-> ([JSONRPCResponse] -> ShowS)
-> Show JSONRPCResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JSONRPCResponse -> ShowS
showsPrec :: Int -> JSONRPCResponse -> ShowS
$cshow :: JSONRPCResponse -> String
show :: JSONRPCResponse -> String
$cshowList :: [JSONRPCResponse] -> ShowS
showList :: [JSONRPCResponse] -> ShowS
Show, JSONRPCResponse -> JSONRPCResponse -> Bool
(JSONRPCResponse -> JSONRPCResponse -> Bool)
-> (JSONRPCResponse -> JSONRPCResponse -> Bool)
-> Eq JSONRPCResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JSONRPCResponse -> JSONRPCResponse -> Bool
== :: JSONRPCResponse -> JSONRPCResponse -> Bool
$c/= :: JSONRPCResponse -> JSONRPCResponse -> Bool
/= :: JSONRPCResponse -> JSONRPCResponse -> Bool
Eq, (forall x. JSONRPCResponse -> Rep JSONRPCResponse x)
-> (forall x. Rep JSONRPCResponse x -> JSONRPCResponse)
-> Generic JSONRPCResponse
forall x. Rep JSONRPCResponse x -> JSONRPCResponse
forall x. JSONRPCResponse -> Rep JSONRPCResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JSONRPCResponse -> Rep JSONRPCResponse x
from :: forall x. JSONRPCResponse -> Rep JSONRPCResponse x
$cto :: forall x. Rep JSONRPCResponse x -> JSONRPCResponse
to :: forall x. Rep JSONRPCResponse x -> JSONRPCResponse
Generic)

$(deriveJSON defaultOptions ''JSONRPCResponse)

-- | A JSON-RPC error response
data JSONRPCError = JSONRPCError
    { JSONRPCError -> Text
jsonrpc :: Text -- Always "2.0"
    , JSONRPCError -> RequestId
id :: RequestId
    , JSONRPCError -> JSONRPCErrorInfo
error :: JSONRPCErrorInfo
    }
    deriving stock (Int -> JSONRPCError -> ShowS
[JSONRPCError] -> ShowS
JSONRPCError -> String
(Int -> JSONRPCError -> ShowS)
-> (JSONRPCError -> String)
-> ([JSONRPCError] -> ShowS)
-> Show JSONRPCError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JSONRPCError -> ShowS
showsPrec :: Int -> JSONRPCError -> ShowS
$cshow :: JSONRPCError -> String
show :: JSONRPCError -> String
$cshowList :: [JSONRPCError] -> ShowS
showList :: [JSONRPCError] -> ShowS
Show, JSONRPCError -> JSONRPCError -> Bool
(JSONRPCError -> JSONRPCError -> Bool)
-> (JSONRPCError -> JSONRPCError -> Bool) -> Eq JSONRPCError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JSONRPCError -> JSONRPCError -> Bool
== :: JSONRPCError -> JSONRPCError -> Bool
$c/= :: JSONRPCError -> JSONRPCError -> Bool
/= :: JSONRPCError -> JSONRPCError -> Bool
Eq, (forall x. JSONRPCError -> Rep JSONRPCError x)
-> (forall x. Rep JSONRPCError x -> JSONRPCError)
-> Generic JSONRPCError
forall x. Rep JSONRPCError x -> JSONRPCError
forall x. JSONRPCError -> Rep JSONRPCError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JSONRPCError -> Rep JSONRPCError x
from :: forall x. JSONRPCError -> Rep JSONRPCError x
$cto :: forall x. Rep JSONRPCError x -> JSONRPCError
to :: forall x. Rep JSONRPCError x -> JSONRPCError
Generic)

$(deriveJSON defaultOptions ''JSONRPCError)

-- | A JSON-RPC notification (no response expected)
data JSONRPCNotification = JSONRPCNotification
    { JSONRPCNotification -> Text
jsonrpc :: Text -- Always "2.0"
    , JSONRPCNotification -> Text
method :: Text
    , JSONRPCNotification -> Maybe Value
params :: Maybe Value
    }
    deriving stock (Int -> JSONRPCNotification -> ShowS
[JSONRPCNotification] -> ShowS
JSONRPCNotification -> String
(Int -> JSONRPCNotification -> ShowS)
-> (JSONRPCNotification -> String)
-> ([JSONRPCNotification] -> ShowS)
-> Show JSONRPCNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JSONRPCNotification -> ShowS
showsPrec :: Int -> JSONRPCNotification -> ShowS
$cshow :: JSONRPCNotification -> String
show :: JSONRPCNotification -> String
$cshowList :: [JSONRPCNotification] -> ShowS
showList :: [JSONRPCNotification] -> ShowS
Show, JSONRPCNotification -> JSONRPCNotification -> Bool
(JSONRPCNotification -> JSONRPCNotification -> Bool)
-> (JSONRPCNotification -> JSONRPCNotification -> Bool)
-> Eq JSONRPCNotification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JSONRPCNotification -> JSONRPCNotification -> Bool
== :: JSONRPCNotification -> JSONRPCNotification -> Bool
$c/= :: JSONRPCNotification -> JSONRPCNotification -> Bool
/= :: JSONRPCNotification -> JSONRPCNotification -> Bool
Eq, (forall x. JSONRPCNotification -> Rep JSONRPCNotification x)
-> (forall x. Rep JSONRPCNotification x -> JSONRPCNotification)
-> Generic JSONRPCNotification
forall x. Rep JSONRPCNotification x -> JSONRPCNotification
forall x. JSONRPCNotification -> Rep JSONRPCNotification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JSONRPCNotification -> Rep JSONRPCNotification x
from :: forall x. JSONRPCNotification -> Rep JSONRPCNotification x
$cto :: forall x. Rep JSONRPCNotification x -> JSONRPCNotification
to :: forall x. Rep JSONRPCNotification x -> JSONRPCNotification
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True} ''JSONRPCNotification)

-- | Any JSON-RPC message
data JSONRPCMessage
    = RequestMessage JSONRPCRequest
    | ResponseMessage JSONRPCResponse
    | ErrorMessage JSONRPCError
    | NotificationMessage JSONRPCNotification
    deriving stock (Int -> JSONRPCMessage -> ShowS
[JSONRPCMessage] -> ShowS
JSONRPCMessage -> String
(Int -> JSONRPCMessage -> ShowS)
-> (JSONRPCMessage -> String)
-> ([JSONRPCMessage] -> ShowS)
-> Show JSONRPCMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JSONRPCMessage -> ShowS
showsPrec :: Int -> JSONRPCMessage -> ShowS
$cshow :: JSONRPCMessage -> String
show :: JSONRPCMessage -> String
$cshowList :: [JSONRPCMessage] -> ShowS
showList :: [JSONRPCMessage] -> ShowS
Show, JSONRPCMessage -> JSONRPCMessage -> Bool
(JSONRPCMessage -> JSONRPCMessage -> Bool)
-> (JSONRPCMessage -> JSONRPCMessage -> Bool) -> Eq JSONRPCMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JSONRPCMessage -> JSONRPCMessage -> Bool
== :: JSONRPCMessage -> JSONRPCMessage -> Bool
$c/= :: JSONRPCMessage -> JSONRPCMessage -> Bool
/= :: JSONRPCMessage -> JSONRPCMessage -> Bool
Eq, (forall x. JSONRPCMessage -> Rep JSONRPCMessage x)
-> (forall x. Rep JSONRPCMessage x -> JSONRPCMessage)
-> Generic JSONRPCMessage
forall x. Rep JSONRPCMessage x -> JSONRPCMessage
forall x. JSONRPCMessage -> Rep JSONRPCMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JSONRPCMessage -> Rep JSONRPCMessage x
from :: forall x. JSONRPCMessage -> Rep JSONRPCMessage x
$cto :: forall x. Rep JSONRPCMessage x -> JSONRPCMessage
to :: forall x. Rep JSONRPCMessage x -> JSONRPCMessage
Generic)

instance ToJSON JSONRPCMessage where
    toJSON :: JSONRPCMessage -> Value
toJSON (RequestMessage JSONRPCRequest
r) = JSONRPCRequest -> Value
forall a. ToJSON a => a -> Value
toJSON JSONRPCRequest
r
    toJSON (ResponseMessage JSONRPCResponse
r) = JSONRPCResponse -> Value
forall a. ToJSON a => a -> Value
toJSON JSONRPCResponse
r
    toJSON (ErrorMessage JSONRPCError
e) = JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON JSONRPCError
e
    toJSON (NotificationMessage JSONRPCNotification
n) = JSONRPCNotification -> Value
forall a. ToJSON a => a -> Value
toJSON JSONRPCNotification
n

instance FromJSON JSONRPCMessage where
    parseJSON :: Value -> Parser JSONRPCMessage
parseJSON Value
v =
        (JSONRPCRequest -> JSONRPCMessage
RequestMessage (JSONRPCRequest -> JSONRPCMessage)
-> Parser JSONRPCRequest -> Parser JSONRPCMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser JSONRPCRequest
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser JSONRPCMessage
-> Parser JSONRPCMessage -> Parser JSONRPCMessage
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (JSONRPCResponse -> JSONRPCMessage
ResponseMessage (JSONRPCResponse -> JSONRPCMessage)
-> Parser JSONRPCResponse -> Parser JSONRPCMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser JSONRPCResponse
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser JSONRPCMessage
-> Parser JSONRPCMessage -> Parser JSONRPCMessage
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (JSONRPCError -> JSONRPCMessage
ErrorMessage (JSONRPCError -> JSONRPCMessage)
-> Parser JSONRPCError -> Parser JSONRPCMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser JSONRPCError
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser JSONRPCMessage
-> Parser JSONRPCMessage -> Parser JSONRPCMessage
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (JSONRPCNotification -> JSONRPCMessage
NotificationMessage (JSONRPCNotification -> JSONRPCMessage)
-> Parser JSONRPCNotification -> Parser JSONRPCMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser JSONRPCNotification
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)

-- * Client Request Types

-- | Initialize request parameters
data InitializeParams = InitializeParams
    { InitializeParams -> Text
protocolVersion :: Text
    , InitializeParams -> ClientCapabilities
capabilities :: ClientCapabilities
    , InitializeParams -> Implementation
clientInfo :: Implementation
    }
    deriving stock (Int -> InitializeParams -> ShowS
[InitializeParams] -> ShowS
InitializeParams -> String
(Int -> InitializeParams -> ShowS)
-> (InitializeParams -> String)
-> ([InitializeParams] -> ShowS)
-> Show InitializeParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InitializeParams -> ShowS
showsPrec :: Int -> InitializeParams -> ShowS
$cshow :: InitializeParams -> String
show :: InitializeParams -> String
$cshowList :: [InitializeParams] -> ShowS
showList :: [InitializeParams] -> ShowS
Show, InitializeParams -> InitializeParams -> Bool
(InitializeParams -> InitializeParams -> Bool)
-> (InitializeParams -> InitializeParams -> Bool)
-> Eq InitializeParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InitializeParams -> InitializeParams -> Bool
== :: InitializeParams -> InitializeParams -> Bool
$c/= :: InitializeParams -> InitializeParams -> Bool
/= :: InitializeParams -> InitializeParams -> Bool
Eq, (forall x. InitializeParams -> Rep InitializeParams x)
-> (forall x. Rep InitializeParams x -> InitializeParams)
-> Generic InitializeParams
forall x. Rep InitializeParams x -> InitializeParams
forall x. InitializeParams -> Rep InitializeParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InitializeParams -> Rep InitializeParams x
from :: forall x. InitializeParams -> Rep InitializeParams x
$cto :: forall x. Rep InitializeParams x -> InitializeParams
to :: forall x. Rep InitializeParams x -> InitializeParams
Generic)

$(deriveJSON defaultOptions ''InitializeParams)

-- | Initialize request
data InitializeRequest = InitializeRequest
    { InitializeRequest -> Text
method :: Text -- Always "initialize"
    , InitializeRequest -> InitializeParams
params :: InitializeParams
    }
    deriving stock (Int -> InitializeRequest -> ShowS
[InitializeRequest] -> ShowS
InitializeRequest -> String
(Int -> InitializeRequest -> ShowS)
-> (InitializeRequest -> String)
-> ([InitializeRequest] -> ShowS)
-> Show InitializeRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InitializeRequest -> ShowS
showsPrec :: Int -> InitializeRequest -> ShowS
$cshow :: InitializeRequest -> String
show :: InitializeRequest -> String
$cshowList :: [InitializeRequest] -> ShowS
showList :: [InitializeRequest] -> ShowS
Show, InitializeRequest -> InitializeRequest -> Bool
(InitializeRequest -> InitializeRequest -> Bool)
-> (InitializeRequest -> InitializeRequest -> Bool)
-> Eq InitializeRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InitializeRequest -> InitializeRequest -> Bool
== :: InitializeRequest -> InitializeRequest -> Bool
$c/= :: InitializeRequest -> InitializeRequest -> Bool
/= :: InitializeRequest -> InitializeRequest -> Bool
Eq, (forall x. InitializeRequest -> Rep InitializeRequest x)
-> (forall x. Rep InitializeRequest x -> InitializeRequest)
-> Generic InitializeRequest
forall x. Rep InitializeRequest x -> InitializeRequest
forall x. InitializeRequest -> Rep InitializeRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InitializeRequest -> Rep InitializeRequest x
from :: forall x. InitializeRequest -> Rep InitializeRequest x
$cto :: forall x. Rep InitializeRequest x -> InitializeRequest
to :: forall x. Rep InitializeRequest x -> InitializeRequest
Generic)

instance ToJSON InitializeRequest where
    toJSON :: InitializeRequest -> Value
toJSON (InitializeRequest Text
_ InitializeParams
p) =
        [Pair] -> Value
object
            [ Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"initialize" :: Text)
            , Key
"params" Key -> InitializeParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= InitializeParams
p
            ]

instance FromJSON InitializeRequest where
    parseJSON :: Value -> Parser InitializeRequest
parseJSON = String
-> (Object -> Parser InitializeRequest)
-> Value
-> Parser InitializeRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"InitializeRequest" ((Object -> Parser InitializeRequest)
 -> Value -> Parser InitializeRequest)
-> (Object -> Parser InitializeRequest)
-> Value
-> Parser InitializeRequest
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"initialize" :: Text)
            then Text -> InitializeParams -> InitializeRequest
InitializeRequest Text
m (InitializeParams -> InitializeRequest)
-> Parser InitializeParams -> Parser InitializeRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser InitializeParams
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
            else String -> Parser InitializeRequest
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'initialize'"

-- | Ping request parameters
data PingParams where
    PingParams :: {PingParams -> Maybe Metadata
_meta :: Maybe Metadata} -> PingParams
    deriving stock (Int -> PingParams -> ShowS
[PingParams] -> ShowS
PingParams -> String
(Int -> PingParams -> ShowS)
-> (PingParams -> String)
-> ([PingParams] -> ShowS)
-> Show PingParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PingParams -> ShowS
showsPrec :: Int -> PingParams -> ShowS
$cshow :: PingParams -> String
show :: PingParams -> String
$cshowList :: [PingParams] -> ShowS
showList :: [PingParams] -> ShowS
Show, PingParams -> PingParams -> Bool
(PingParams -> PingParams -> Bool)
-> (PingParams -> PingParams -> Bool) -> Eq PingParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PingParams -> PingParams -> Bool
== :: PingParams -> PingParams -> Bool
$c/= :: PingParams -> PingParams -> Bool
/= :: PingParams -> PingParams -> Bool
Eq, (forall x. PingParams -> Rep PingParams x)
-> (forall x. Rep PingParams x -> PingParams) -> Generic PingParams
forall x. Rep PingParams x -> PingParams
forall x. PingParams -> Rep PingParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PingParams -> Rep PingParams x
from :: forall x. PingParams -> Rep PingParams x
$cto :: forall x. Rep PingParams x -> PingParams
to :: forall x. Rep PingParams x -> PingParams
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True, fieldLabelModifier = \case { "_meta" -> "_meta"; x -> x }} ''PingParams)

-- | Ping request
data PingRequest = PingRequest
    { PingRequest -> Text
method :: Text -- Always "ping"
    , PingRequest -> Maybe PingParams
params :: Maybe PingParams
    }
    deriving stock (Int -> PingRequest -> ShowS
[PingRequest] -> ShowS
PingRequest -> String
(Int -> PingRequest -> ShowS)
-> (PingRequest -> String)
-> ([PingRequest] -> ShowS)
-> Show PingRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PingRequest -> ShowS
showsPrec :: Int -> PingRequest -> ShowS
$cshow :: PingRequest -> String
show :: PingRequest -> String
$cshowList :: [PingRequest] -> ShowS
showList :: [PingRequest] -> ShowS
Show, PingRequest -> PingRequest -> Bool
(PingRequest -> PingRequest -> Bool)
-> (PingRequest -> PingRequest -> Bool) -> Eq PingRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PingRequest -> PingRequest -> Bool
== :: PingRequest -> PingRequest -> Bool
$c/= :: PingRequest -> PingRequest -> Bool
/= :: PingRequest -> PingRequest -> Bool
Eq, (forall x. PingRequest -> Rep PingRequest x)
-> (forall x. Rep PingRequest x -> PingRequest)
-> Generic PingRequest
forall x. Rep PingRequest x -> PingRequest
forall x. PingRequest -> Rep PingRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PingRequest -> Rep PingRequest x
from :: forall x. PingRequest -> Rep PingRequest x
$cto :: forall x. Rep PingRequest x -> PingRequest
to :: forall x. Rep PingRequest x -> PingRequest
Generic)

instance ToJSON PingRequest where
    toJSON :: PingRequest -> Value
toJSON (PingRequest Text
_ Maybe PingParams
p) =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
            (Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"ping" :: Text)) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair] -> (PingParams -> [Pair]) -> Maybe PingParams -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\PingParams
pr -> [Key
"params" Key -> PingParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PingParams
pr]) Maybe PingParams
p

instance FromJSON PingRequest where
    parseJSON :: Value -> Parser PingRequest
parseJSON = String
-> (Object -> Parser PingRequest) -> Value -> Parser PingRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PingRequest" ((Object -> Parser PingRequest) -> Value -> Parser PingRequest)
-> (Object -> Parser PingRequest) -> Value -> Parser PingRequest
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"ping" :: Text)
            then Text -> Maybe PingParams -> PingRequest
PingRequest Text
m (Maybe PingParams -> PingRequest)
-> Parser (Maybe PingParams) -> Parser PingRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe PingParams)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params"
            else String -> Parser PingRequest
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'ping'"

-- | List resources request parameters
data ListResourcesParams where
    ListResourcesParams ::
        {ListResourcesParams -> Maybe Cursor
cursor :: Maybe Cursor} ->
        ListResourcesParams
    deriving stock (Int -> ListResourcesParams -> ShowS
[ListResourcesParams] -> ShowS
ListResourcesParams -> String
(Int -> ListResourcesParams -> ShowS)
-> (ListResourcesParams -> String)
-> ([ListResourcesParams] -> ShowS)
-> Show ListResourcesParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListResourcesParams -> ShowS
showsPrec :: Int -> ListResourcesParams -> ShowS
$cshow :: ListResourcesParams -> String
show :: ListResourcesParams -> String
$cshowList :: [ListResourcesParams] -> ShowS
showList :: [ListResourcesParams] -> ShowS
Show, ListResourcesParams -> ListResourcesParams -> Bool
(ListResourcesParams -> ListResourcesParams -> Bool)
-> (ListResourcesParams -> ListResourcesParams -> Bool)
-> Eq ListResourcesParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListResourcesParams -> ListResourcesParams -> Bool
== :: ListResourcesParams -> ListResourcesParams -> Bool
$c/= :: ListResourcesParams -> ListResourcesParams -> Bool
/= :: ListResourcesParams -> ListResourcesParams -> Bool
Eq, (forall x. ListResourcesParams -> Rep ListResourcesParams x)
-> (forall x. Rep ListResourcesParams x -> ListResourcesParams)
-> Generic ListResourcesParams
forall x. Rep ListResourcesParams x -> ListResourcesParams
forall x. ListResourcesParams -> Rep ListResourcesParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListResourcesParams -> Rep ListResourcesParams x
from :: forall x. ListResourcesParams -> Rep ListResourcesParams x
$cto :: forall x. Rep ListResourcesParams x -> ListResourcesParams
to :: forall x. Rep ListResourcesParams x -> ListResourcesParams
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True} ''ListResourcesParams)

-- | List resources request
data ListResourcesRequest = ListResourcesRequest
    { ListResourcesRequest -> Text
method :: Text -- Always "resources/list"
    , ListResourcesRequest -> Maybe ListResourcesParams
params :: Maybe ListResourcesParams
    }
    deriving stock (Int -> ListResourcesRequest -> ShowS
[ListResourcesRequest] -> ShowS
ListResourcesRequest -> String
(Int -> ListResourcesRequest -> ShowS)
-> (ListResourcesRequest -> String)
-> ([ListResourcesRequest] -> ShowS)
-> Show ListResourcesRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListResourcesRequest -> ShowS
showsPrec :: Int -> ListResourcesRequest -> ShowS
$cshow :: ListResourcesRequest -> String
show :: ListResourcesRequest -> String
$cshowList :: [ListResourcesRequest] -> ShowS
showList :: [ListResourcesRequest] -> ShowS
Show, ListResourcesRequest -> ListResourcesRequest -> Bool
(ListResourcesRequest -> ListResourcesRequest -> Bool)
-> (ListResourcesRequest -> ListResourcesRequest -> Bool)
-> Eq ListResourcesRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListResourcesRequest -> ListResourcesRequest -> Bool
== :: ListResourcesRequest -> ListResourcesRequest -> Bool
$c/= :: ListResourcesRequest -> ListResourcesRequest -> Bool
/= :: ListResourcesRequest -> ListResourcesRequest -> Bool
Eq, (forall x. ListResourcesRequest -> Rep ListResourcesRequest x)
-> (forall x. Rep ListResourcesRequest x -> ListResourcesRequest)
-> Generic ListResourcesRequest
forall x. Rep ListResourcesRequest x -> ListResourcesRequest
forall x. ListResourcesRequest -> Rep ListResourcesRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListResourcesRequest -> Rep ListResourcesRequest x
from :: forall x. ListResourcesRequest -> Rep ListResourcesRequest x
$cto :: forall x. Rep ListResourcesRequest x -> ListResourcesRequest
to :: forall x. Rep ListResourcesRequest x -> ListResourcesRequest
Generic)

instance ToJSON ListResourcesRequest where
    toJSON :: ListResourcesRequest -> Value
toJSON (ListResourcesRequest Text
_ Maybe ListResourcesParams
p) =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
            (Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"resources/list" :: Text)) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
-> (ListResourcesParams -> [Pair])
-> Maybe ListResourcesParams
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ListResourcesParams
pr -> [Key
"params" Key -> ListResourcesParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ListResourcesParams
pr]) Maybe ListResourcesParams
p

instance FromJSON ListResourcesRequest where
    parseJSON :: Value -> Parser ListResourcesRequest
parseJSON = String
-> (Object -> Parser ListResourcesRequest)
-> Value
-> Parser ListResourcesRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ListResourcesRequest" ((Object -> Parser ListResourcesRequest)
 -> Value -> Parser ListResourcesRequest)
-> (Object -> Parser ListResourcesRequest)
-> Value
-> Parser ListResourcesRequest
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"resources/list" :: Text)
            then Text -> Maybe ListResourcesParams -> ListResourcesRequest
ListResourcesRequest Text
m (Maybe ListResourcesParams -> ListResourcesRequest)
-> Parser (Maybe ListResourcesParams)
-> Parser ListResourcesRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe ListResourcesParams)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params"
            else String -> Parser ListResourcesRequest
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'resources/list'"

-- | List resource templates request parameters
data ListResourceTemplatesParams where
    ListResourceTemplatesParams ::
        {ListResourceTemplatesParams -> Maybe Cursor
cursor :: Maybe Cursor} ->
        ListResourceTemplatesParams
    deriving stock (Int -> ListResourceTemplatesParams -> ShowS
[ListResourceTemplatesParams] -> ShowS
ListResourceTemplatesParams -> String
(Int -> ListResourceTemplatesParams -> ShowS)
-> (ListResourceTemplatesParams -> String)
-> ([ListResourceTemplatesParams] -> ShowS)
-> Show ListResourceTemplatesParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListResourceTemplatesParams -> ShowS
showsPrec :: Int -> ListResourceTemplatesParams -> ShowS
$cshow :: ListResourceTemplatesParams -> String
show :: ListResourceTemplatesParams -> String
$cshowList :: [ListResourceTemplatesParams] -> ShowS
showList :: [ListResourceTemplatesParams] -> ShowS
Show, ListResourceTemplatesParams -> ListResourceTemplatesParams -> Bool
(ListResourceTemplatesParams
 -> ListResourceTemplatesParams -> Bool)
-> (ListResourceTemplatesParams
    -> ListResourceTemplatesParams -> Bool)
-> Eq ListResourceTemplatesParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListResourceTemplatesParams -> ListResourceTemplatesParams -> Bool
== :: ListResourceTemplatesParams -> ListResourceTemplatesParams -> Bool
$c/= :: ListResourceTemplatesParams -> ListResourceTemplatesParams -> Bool
/= :: ListResourceTemplatesParams -> ListResourceTemplatesParams -> Bool
Eq, (forall x.
 ListResourceTemplatesParams -> Rep ListResourceTemplatesParams x)
-> (forall x.
    Rep ListResourceTemplatesParams x -> ListResourceTemplatesParams)
-> Generic ListResourceTemplatesParams
forall x.
Rep ListResourceTemplatesParams x -> ListResourceTemplatesParams
forall x.
ListResourceTemplatesParams -> Rep ListResourceTemplatesParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ListResourceTemplatesParams -> Rep ListResourceTemplatesParams x
from :: forall x.
ListResourceTemplatesParams -> Rep ListResourceTemplatesParams x
$cto :: forall x.
Rep ListResourceTemplatesParams x -> ListResourceTemplatesParams
to :: forall x.
Rep ListResourceTemplatesParams x -> ListResourceTemplatesParams
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True} ''ListResourceTemplatesParams)

-- | List resource templates request
data ListResourceTemplatesRequest = ListResourceTemplatesRequest
    { ListResourceTemplatesRequest -> Text
method :: Text -- Always "resources/templates/list"
    , ListResourceTemplatesRequest -> Maybe ListResourceTemplatesParams
params :: Maybe ListResourceTemplatesParams
    }
    deriving stock (Int -> ListResourceTemplatesRequest -> ShowS
[ListResourceTemplatesRequest] -> ShowS
ListResourceTemplatesRequest -> String
(Int -> ListResourceTemplatesRequest -> ShowS)
-> (ListResourceTemplatesRequest -> String)
-> ([ListResourceTemplatesRequest] -> ShowS)
-> Show ListResourceTemplatesRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListResourceTemplatesRequest -> ShowS
showsPrec :: Int -> ListResourceTemplatesRequest -> ShowS
$cshow :: ListResourceTemplatesRequest -> String
show :: ListResourceTemplatesRequest -> String
$cshowList :: [ListResourceTemplatesRequest] -> ShowS
showList :: [ListResourceTemplatesRequest] -> ShowS
Show, ListResourceTemplatesRequest
-> ListResourceTemplatesRequest -> Bool
(ListResourceTemplatesRequest
 -> ListResourceTemplatesRequest -> Bool)
-> (ListResourceTemplatesRequest
    -> ListResourceTemplatesRequest -> Bool)
-> Eq ListResourceTemplatesRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListResourceTemplatesRequest
-> ListResourceTemplatesRequest -> Bool
== :: ListResourceTemplatesRequest
-> ListResourceTemplatesRequest -> Bool
$c/= :: ListResourceTemplatesRequest
-> ListResourceTemplatesRequest -> Bool
/= :: ListResourceTemplatesRequest
-> ListResourceTemplatesRequest -> Bool
Eq, (forall x.
 ListResourceTemplatesRequest -> Rep ListResourceTemplatesRequest x)
-> (forall x.
    Rep ListResourceTemplatesRequest x -> ListResourceTemplatesRequest)
-> Generic ListResourceTemplatesRequest
forall x.
Rep ListResourceTemplatesRequest x -> ListResourceTemplatesRequest
forall x.
ListResourceTemplatesRequest -> Rep ListResourceTemplatesRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ListResourceTemplatesRequest -> Rep ListResourceTemplatesRequest x
from :: forall x.
ListResourceTemplatesRequest -> Rep ListResourceTemplatesRequest x
$cto :: forall x.
Rep ListResourceTemplatesRequest x -> ListResourceTemplatesRequest
to :: forall x.
Rep ListResourceTemplatesRequest x -> ListResourceTemplatesRequest
Generic)

instance ToJSON ListResourceTemplatesRequest where
    toJSON :: ListResourceTemplatesRequest -> Value
toJSON (ListResourceTemplatesRequest Text
_ Maybe ListResourceTemplatesParams
p) =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
            (Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"resources/templates/list" :: Text)) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
-> (ListResourceTemplatesParams -> [Pair])
-> Maybe ListResourceTemplatesParams
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ListResourceTemplatesParams
pr -> [Key
"params" Key -> ListResourceTemplatesParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ListResourceTemplatesParams
pr]) Maybe ListResourceTemplatesParams
p

instance FromJSON ListResourceTemplatesRequest where
    parseJSON :: Value -> Parser ListResourceTemplatesRequest
parseJSON = String
-> (Object -> Parser ListResourceTemplatesRequest)
-> Value
-> Parser ListResourceTemplatesRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ListResourceTemplatesRequest" ((Object -> Parser ListResourceTemplatesRequest)
 -> Value -> Parser ListResourceTemplatesRequest)
-> (Object -> Parser ListResourceTemplatesRequest)
-> Value
-> Parser ListResourceTemplatesRequest
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"resources/templates/list" :: Text)
            then Text
-> Maybe ListResourceTemplatesParams
-> ListResourceTemplatesRequest
ListResourceTemplatesRequest Text
m (Maybe ListResourceTemplatesParams -> ListResourceTemplatesRequest)
-> Parser (Maybe ListResourceTemplatesParams)
-> Parser ListResourceTemplatesRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe ListResourceTemplatesParams)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params"
            else String -> Parser ListResourceTemplatesRequest
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'resources/templates/list'"

-- | Read resource request parameters
data ReadResourceParams where
    ReadResourceParams :: {ReadResourceParams -> Text
uri :: Text} -> ReadResourceParams
    deriving stock (Int -> ReadResourceParams -> ShowS
[ReadResourceParams] -> ShowS
ReadResourceParams -> String
(Int -> ReadResourceParams -> ShowS)
-> (ReadResourceParams -> String)
-> ([ReadResourceParams] -> ShowS)
-> Show ReadResourceParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReadResourceParams -> ShowS
showsPrec :: Int -> ReadResourceParams -> ShowS
$cshow :: ReadResourceParams -> String
show :: ReadResourceParams -> String
$cshowList :: [ReadResourceParams] -> ShowS
showList :: [ReadResourceParams] -> ShowS
Show, ReadResourceParams -> ReadResourceParams -> Bool
(ReadResourceParams -> ReadResourceParams -> Bool)
-> (ReadResourceParams -> ReadResourceParams -> Bool)
-> Eq ReadResourceParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReadResourceParams -> ReadResourceParams -> Bool
== :: ReadResourceParams -> ReadResourceParams -> Bool
$c/= :: ReadResourceParams -> ReadResourceParams -> Bool
/= :: ReadResourceParams -> ReadResourceParams -> Bool
Eq, (forall x. ReadResourceParams -> Rep ReadResourceParams x)
-> (forall x. Rep ReadResourceParams x -> ReadResourceParams)
-> Generic ReadResourceParams
forall x. Rep ReadResourceParams x -> ReadResourceParams
forall x. ReadResourceParams -> Rep ReadResourceParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReadResourceParams -> Rep ReadResourceParams x
from :: forall x. ReadResourceParams -> Rep ReadResourceParams x
$cto :: forall x. Rep ReadResourceParams x -> ReadResourceParams
to :: forall x. Rep ReadResourceParams x -> ReadResourceParams
Generic)

$(deriveJSON defaultOptions ''ReadResourceParams)

-- | Read resource request
data ReadResourceRequest = ReadResourceRequest
    { ReadResourceRequest -> Text
method :: Text -- Always "resources/read"
    , ReadResourceRequest -> ReadResourceParams
params :: ReadResourceParams
    }
    deriving stock (Int -> ReadResourceRequest -> ShowS
[ReadResourceRequest] -> ShowS
ReadResourceRequest -> String
(Int -> ReadResourceRequest -> ShowS)
-> (ReadResourceRequest -> String)
-> ([ReadResourceRequest] -> ShowS)
-> Show ReadResourceRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReadResourceRequest -> ShowS
showsPrec :: Int -> ReadResourceRequest -> ShowS
$cshow :: ReadResourceRequest -> String
show :: ReadResourceRequest -> String
$cshowList :: [ReadResourceRequest] -> ShowS
showList :: [ReadResourceRequest] -> ShowS
Show, ReadResourceRequest -> ReadResourceRequest -> Bool
(ReadResourceRequest -> ReadResourceRequest -> Bool)
-> (ReadResourceRequest -> ReadResourceRequest -> Bool)
-> Eq ReadResourceRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReadResourceRequest -> ReadResourceRequest -> Bool
== :: ReadResourceRequest -> ReadResourceRequest -> Bool
$c/= :: ReadResourceRequest -> ReadResourceRequest -> Bool
/= :: ReadResourceRequest -> ReadResourceRequest -> Bool
Eq, (forall x. ReadResourceRequest -> Rep ReadResourceRequest x)
-> (forall x. Rep ReadResourceRequest x -> ReadResourceRequest)
-> Generic ReadResourceRequest
forall x. Rep ReadResourceRequest x -> ReadResourceRequest
forall x. ReadResourceRequest -> Rep ReadResourceRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReadResourceRequest -> Rep ReadResourceRequest x
from :: forall x. ReadResourceRequest -> Rep ReadResourceRequest x
$cto :: forall x. Rep ReadResourceRequest x -> ReadResourceRequest
to :: forall x. Rep ReadResourceRequest x -> ReadResourceRequest
Generic)

instance ToJSON ReadResourceRequest where
    toJSON :: ReadResourceRequest -> Value
toJSON (ReadResourceRequest Text
_ ReadResourceParams
p) =
        [Pair] -> Value
object
            [ Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"resources/read" :: Text)
            , Key
"params" Key -> ReadResourceParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ReadResourceParams
p
            ]

instance FromJSON ReadResourceRequest where
    parseJSON :: Value -> Parser ReadResourceRequest
parseJSON = String
-> (Object -> Parser ReadResourceRequest)
-> Value
-> Parser ReadResourceRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ReadResourceRequest" ((Object -> Parser ReadResourceRequest)
 -> Value -> Parser ReadResourceRequest)
-> (Object -> Parser ReadResourceRequest)
-> Value
-> Parser ReadResourceRequest
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"resources/read" :: Text)
            then Text -> ReadResourceParams -> ReadResourceRequest
ReadResourceRequest Text
m (ReadResourceParams -> ReadResourceRequest)
-> Parser ReadResourceParams -> Parser ReadResourceRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ReadResourceParams
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
            else String -> Parser ReadResourceRequest
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'resources/read'"

-- | Subscribe request parameters
data SubscribeParams where
    SubscribeParams :: {SubscribeParams -> Text
uri :: Text} -> SubscribeParams
    deriving stock (Int -> SubscribeParams -> ShowS
[SubscribeParams] -> ShowS
SubscribeParams -> String
(Int -> SubscribeParams -> ShowS)
-> (SubscribeParams -> String)
-> ([SubscribeParams] -> ShowS)
-> Show SubscribeParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubscribeParams -> ShowS
showsPrec :: Int -> SubscribeParams -> ShowS
$cshow :: SubscribeParams -> String
show :: SubscribeParams -> String
$cshowList :: [SubscribeParams] -> ShowS
showList :: [SubscribeParams] -> ShowS
Show, SubscribeParams -> SubscribeParams -> Bool
(SubscribeParams -> SubscribeParams -> Bool)
-> (SubscribeParams -> SubscribeParams -> Bool)
-> Eq SubscribeParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubscribeParams -> SubscribeParams -> Bool
== :: SubscribeParams -> SubscribeParams -> Bool
$c/= :: SubscribeParams -> SubscribeParams -> Bool
/= :: SubscribeParams -> SubscribeParams -> Bool
Eq, (forall x. SubscribeParams -> Rep SubscribeParams x)
-> (forall x. Rep SubscribeParams x -> SubscribeParams)
-> Generic SubscribeParams
forall x. Rep SubscribeParams x -> SubscribeParams
forall x. SubscribeParams -> Rep SubscribeParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SubscribeParams -> Rep SubscribeParams x
from :: forall x. SubscribeParams -> Rep SubscribeParams x
$cto :: forall x. Rep SubscribeParams x -> SubscribeParams
to :: forall x. Rep SubscribeParams x -> SubscribeParams
Generic)

$(deriveJSON defaultOptions ''SubscribeParams)

-- | Subscribe request
data SubscribeRequest = SubscribeRequest
    { SubscribeRequest -> Text
method :: Text -- Always "resources/subscribe"
    , SubscribeRequest -> SubscribeParams
params :: SubscribeParams
    }
    deriving stock (Int -> SubscribeRequest -> ShowS
[SubscribeRequest] -> ShowS
SubscribeRequest -> String
(Int -> SubscribeRequest -> ShowS)
-> (SubscribeRequest -> String)
-> ([SubscribeRequest] -> ShowS)
-> Show SubscribeRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubscribeRequest -> ShowS
showsPrec :: Int -> SubscribeRequest -> ShowS
$cshow :: SubscribeRequest -> String
show :: SubscribeRequest -> String
$cshowList :: [SubscribeRequest] -> ShowS
showList :: [SubscribeRequest] -> ShowS
Show, SubscribeRequest -> SubscribeRequest -> Bool
(SubscribeRequest -> SubscribeRequest -> Bool)
-> (SubscribeRequest -> SubscribeRequest -> Bool)
-> Eq SubscribeRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubscribeRequest -> SubscribeRequest -> Bool
== :: SubscribeRequest -> SubscribeRequest -> Bool
$c/= :: SubscribeRequest -> SubscribeRequest -> Bool
/= :: SubscribeRequest -> SubscribeRequest -> Bool
Eq, (forall x. SubscribeRequest -> Rep SubscribeRequest x)
-> (forall x. Rep SubscribeRequest x -> SubscribeRequest)
-> Generic SubscribeRequest
forall x. Rep SubscribeRequest x -> SubscribeRequest
forall x. SubscribeRequest -> Rep SubscribeRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SubscribeRequest -> Rep SubscribeRequest x
from :: forall x. SubscribeRequest -> Rep SubscribeRequest x
$cto :: forall x. Rep SubscribeRequest x -> SubscribeRequest
to :: forall x. Rep SubscribeRequest x -> SubscribeRequest
Generic)

instance ToJSON SubscribeRequest where
    toJSON :: SubscribeRequest -> Value
toJSON (SubscribeRequest Text
_ SubscribeParams
p) =
        [Pair] -> Value
object
            [ Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"resources/subscribe" :: Text)
            , Key
"params" Key -> SubscribeParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SubscribeParams
p
            ]

instance FromJSON SubscribeRequest where
    parseJSON :: Value -> Parser SubscribeRequest
parseJSON = String
-> (Object -> Parser SubscribeRequest)
-> Value
-> Parser SubscribeRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SubscribeRequest" ((Object -> Parser SubscribeRequest)
 -> Value -> Parser SubscribeRequest)
-> (Object -> Parser SubscribeRequest)
-> Value
-> Parser SubscribeRequest
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"resources/subscribe" :: Text)
            then Text -> SubscribeParams -> SubscribeRequest
SubscribeRequest Text
m (SubscribeParams -> SubscribeRequest)
-> Parser SubscribeParams -> Parser SubscribeRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser SubscribeParams
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
            else String -> Parser SubscribeRequest
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'resources/subscribe'"

-- | Unsubscribe request parameters
data UnsubscribeParams where
    UnsubscribeParams :: {UnsubscribeParams -> Text
uri :: Text} -> UnsubscribeParams
    deriving stock (Int -> UnsubscribeParams -> ShowS
[UnsubscribeParams] -> ShowS
UnsubscribeParams -> String
(Int -> UnsubscribeParams -> ShowS)
-> (UnsubscribeParams -> String)
-> ([UnsubscribeParams] -> ShowS)
-> Show UnsubscribeParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnsubscribeParams -> ShowS
showsPrec :: Int -> UnsubscribeParams -> ShowS
$cshow :: UnsubscribeParams -> String
show :: UnsubscribeParams -> String
$cshowList :: [UnsubscribeParams] -> ShowS
showList :: [UnsubscribeParams] -> ShowS
Show, UnsubscribeParams -> UnsubscribeParams -> Bool
(UnsubscribeParams -> UnsubscribeParams -> Bool)
-> (UnsubscribeParams -> UnsubscribeParams -> Bool)
-> Eq UnsubscribeParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnsubscribeParams -> UnsubscribeParams -> Bool
== :: UnsubscribeParams -> UnsubscribeParams -> Bool
$c/= :: UnsubscribeParams -> UnsubscribeParams -> Bool
/= :: UnsubscribeParams -> UnsubscribeParams -> Bool
Eq, (forall x. UnsubscribeParams -> Rep UnsubscribeParams x)
-> (forall x. Rep UnsubscribeParams x -> UnsubscribeParams)
-> Generic UnsubscribeParams
forall x. Rep UnsubscribeParams x -> UnsubscribeParams
forall x. UnsubscribeParams -> Rep UnsubscribeParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UnsubscribeParams -> Rep UnsubscribeParams x
from :: forall x. UnsubscribeParams -> Rep UnsubscribeParams x
$cto :: forall x. Rep UnsubscribeParams x -> UnsubscribeParams
to :: forall x. Rep UnsubscribeParams x -> UnsubscribeParams
Generic)

$(deriveJSON defaultOptions ''UnsubscribeParams)

-- | Unsubscribe request
data UnsubscribeRequest = UnsubscribeRequest
    { UnsubscribeRequest -> Text
method :: Text -- Always "resources/unsubscribe"
    , UnsubscribeRequest -> UnsubscribeParams
params :: UnsubscribeParams
    }
    deriving stock (Int -> UnsubscribeRequest -> ShowS
[UnsubscribeRequest] -> ShowS
UnsubscribeRequest -> String
(Int -> UnsubscribeRequest -> ShowS)
-> (UnsubscribeRequest -> String)
-> ([UnsubscribeRequest] -> ShowS)
-> Show UnsubscribeRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnsubscribeRequest -> ShowS
showsPrec :: Int -> UnsubscribeRequest -> ShowS
$cshow :: UnsubscribeRequest -> String
show :: UnsubscribeRequest -> String
$cshowList :: [UnsubscribeRequest] -> ShowS
showList :: [UnsubscribeRequest] -> ShowS
Show, UnsubscribeRequest -> UnsubscribeRequest -> Bool
(UnsubscribeRequest -> UnsubscribeRequest -> Bool)
-> (UnsubscribeRequest -> UnsubscribeRequest -> Bool)
-> Eq UnsubscribeRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnsubscribeRequest -> UnsubscribeRequest -> Bool
== :: UnsubscribeRequest -> UnsubscribeRequest -> Bool
$c/= :: UnsubscribeRequest -> UnsubscribeRequest -> Bool
/= :: UnsubscribeRequest -> UnsubscribeRequest -> Bool
Eq, (forall x. UnsubscribeRequest -> Rep UnsubscribeRequest x)
-> (forall x. Rep UnsubscribeRequest x -> UnsubscribeRequest)
-> Generic UnsubscribeRequest
forall x. Rep UnsubscribeRequest x -> UnsubscribeRequest
forall x. UnsubscribeRequest -> Rep UnsubscribeRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UnsubscribeRequest -> Rep UnsubscribeRequest x
from :: forall x. UnsubscribeRequest -> Rep UnsubscribeRequest x
$cto :: forall x. Rep UnsubscribeRequest x -> UnsubscribeRequest
to :: forall x. Rep UnsubscribeRequest x -> UnsubscribeRequest
Generic)

instance ToJSON UnsubscribeRequest where
    toJSON :: UnsubscribeRequest -> Value
toJSON (UnsubscribeRequest Text
_ UnsubscribeParams
p) =
        [Pair] -> Value
object
            [ Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"resources/unsubscribe" :: Text)
            , Key
"params" Key -> UnsubscribeParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UnsubscribeParams
p
            ]

instance FromJSON UnsubscribeRequest where
    parseJSON :: Value -> Parser UnsubscribeRequest
parseJSON = String
-> (Object -> Parser UnsubscribeRequest)
-> Value
-> Parser UnsubscribeRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UnsubscribeRequest" ((Object -> Parser UnsubscribeRequest)
 -> Value -> Parser UnsubscribeRequest)
-> (Object -> Parser UnsubscribeRequest)
-> Value
-> Parser UnsubscribeRequest
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"resources/unsubscribe" :: Text)
            then Text -> UnsubscribeParams -> UnsubscribeRequest
UnsubscribeRequest Text
m (UnsubscribeParams -> UnsubscribeRequest)
-> Parser UnsubscribeParams -> Parser UnsubscribeRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser UnsubscribeParams
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
            else String -> Parser UnsubscribeRequest
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'resources/unsubscribe'"

-- | List prompts request parameters
data ListPromptsParams where
    ListPromptsParams :: {ListPromptsParams -> Maybe Cursor
cursor :: Maybe Cursor} -> ListPromptsParams
    deriving stock (Int -> ListPromptsParams -> ShowS
[ListPromptsParams] -> ShowS
ListPromptsParams -> String
(Int -> ListPromptsParams -> ShowS)
-> (ListPromptsParams -> String)
-> ([ListPromptsParams] -> ShowS)
-> Show ListPromptsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListPromptsParams -> ShowS
showsPrec :: Int -> ListPromptsParams -> ShowS
$cshow :: ListPromptsParams -> String
show :: ListPromptsParams -> String
$cshowList :: [ListPromptsParams] -> ShowS
showList :: [ListPromptsParams] -> ShowS
Show, ListPromptsParams -> ListPromptsParams -> Bool
(ListPromptsParams -> ListPromptsParams -> Bool)
-> (ListPromptsParams -> ListPromptsParams -> Bool)
-> Eq ListPromptsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListPromptsParams -> ListPromptsParams -> Bool
== :: ListPromptsParams -> ListPromptsParams -> Bool
$c/= :: ListPromptsParams -> ListPromptsParams -> Bool
/= :: ListPromptsParams -> ListPromptsParams -> Bool
Eq, (forall x. ListPromptsParams -> Rep ListPromptsParams x)
-> (forall x. Rep ListPromptsParams x -> ListPromptsParams)
-> Generic ListPromptsParams
forall x. Rep ListPromptsParams x -> ListPromptsParams
forall x. ListPromptsParams -> Rep ListPromptsParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListPromptsParams -> Rep ListPromptsParams x
from :: forall x. ListPromptsParams -> Rep ListPromptsParams x
$cto :: forall x. Rep ListPromptsParams x -> ListPromptsParams
to :: forall x. Rep ListPromptsParams x -> ListPromptsParams
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True} ''ListPromptsParams)

-- | List prompts request
data ListPromptsRequest = ListPromptsRequest
    { ListPromptsRequest -> Text
method :: Text -- Always "prompts/list"
    , ListPromptsRequest -> Maybe ListPromptsParams
params :: Maybe ListPromptsParams
    }
    deriving stock (Int -> ListPromptsRequest -> ShowS
[ListPromptsRequest] -> ShowS
ListPromptsRequest -> String
(Int -> ListPromptsRequest -> ShowS)
-> (ListPromptsRequest -> String)
-> ([ListPromptsRequest] -> ShowS)
-> Show ListPromptsRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListPromptsRequest -> ShowS
showsPrec :: Int -> ListPromptsRequest -> ShowS
$cshow :: ListPromptsRequest -> String
show :: ListPromptsRequest -> String
$cshowList :: [ListPromptsRequest] -> ShowS
showList :: [ListPromptsRequest] -> ShowS
Show, ListPromptsRequest -> ListPromptsRequest -> Bool
(ListPromptsRequest -> ListPromptsRequest -> Bool)
-> (ListPromptsRequest -> ListPromptsRequest -> Bool)
-> Eq ListPromptsRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListPromptsRequest -> ListPromptsRequest -> Bool
== :: ListPromptsRequest -> ListPromptsRequest -> Bool
$c/= :: ListPromptsRequest -> ListPromptsRequest -> Bool
/= :: ListPromptsRequest -> ListPromptsRequest -> Bool
Eq, (forall x. ListPromptsRequest -> Rep ListPromptsRequest x)
-> (forall x. Rep ListPromptsRequest x -> ListPromptsRequest)
-> Generic ListPromptsRequest
forall x. Rep ListPromptsRequest x -> ListPromptsRequest
forall x. ListPromptsRequest -> Rep ListPromptsRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListPromptsRequest -> Rep ListPromptsRequest x
from :: forall x. ListPromptsRequest -> Rep ListPromptsRequest x
$cto :: forall x. Rep ListPromptsRequest x -> ListPromptsRequest
to :: forall x. Rep ListPromptsRequest x -> ListPromptsRequest
Generic)

instance ToJSON ListPromptsRequest where
    toJSON :: ListPromptsRequest -> Value
toJSON (ListPromptsRequest Text
_ Maybe ListPromptsParams
p) =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
            (Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"prompts/list" :: Text)) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
-> (ListPromptsParams -> [Pair])
-> Maybe ListPromptsParams
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ListPromptsParams
pr -> [Key
"params" Key -> ListPromptsParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ListPromptsParams
pr]) Maybe ListPromptsParams
p

instance FromJSON ListPromptsRequest where
    parseJSON :: Value -> Parser ListPromptsRequest
parseJSON = String
-> (Object -> Parser ListPromptsRequest)
-> Value
-> Parser ListPromptsRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ListPromptsRequest" ((Object -> Parser ListPromptsRequest)
 -> Value -> Parser ListPromptsRequest)
-> (Object -> Parser ListPromptsRequest)
-> Value
-> Parser ListPromptsRequest
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"prompts/list" :: Text)
            then Text -> Maybe ListPromptsParams -> ListPromptsRequest
ListPromptsRequest Text
m (Maybe ListPromptsParams -> ListPromptsRequest)
-> Parser (Maybe ListPromptsParams) -> Parser ListPromptsRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe ListPromptsParams)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params"
            else String -> Parser ListPromptsRequest
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'prompts/list'"

-- | Get prompt request parameters
data GetPromptParams = GetPromptParams
    { GetPromptParams -> Text
name :: Text
    , GetPromptParams -> Maybe (Map Text Text)
arguments :: Maybe (Map Text Text)
    }
    deriving stock (Int -> GetPromptParams -> ShowS
[GetPromptParams] -> ShowS
GetPromptParams -> String
(Int -> GetPromptParams -> ShowS)
-> (GetPromptParams -> String)
-> ([GetPromptParams] -> ShowS)
-> Show GetPromptParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetPromptParams -> ShowS
showsPrec :: Int -> GetPromptParams -> ShowS
$cshow :: GetPromptParams -> String
show :: GetPromptParams -> String
$cshowList :: [GetPromptParams] -> ShowS
showList :: [GetPromptParams] -> ShowS
Show, GetPromptParams -> GetPromptParams -> Bool
(GetPromptParams -> GetPromptParams -> Bool)
-> (GetPromptParams -> GetPromptParams -> Bool)
-> Eq GetPromptParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetPromptParams -> GetPromptParams -> Bool
== :: GetPromptParams -> GetPromptParams -> Bool
$c/= :: GetPromptParams -> GetPromptParams -> Bool
/= :: GetPromptParams -> GetPromptParams -> Bool
Eq, (forall x. GetPromptParams -> Rep GetPromptParams x)
-> (forall x. Rep GetPromptParams x -> GetPromptParams)
-> Generic GetPromptParams
forall x. Rep GetPromptParams x -> GetPromptParams
forall x. GetPromptParams -> Rep GetPromptParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetPromptParams -> Rep GetPromptParams x
from :: forall x. GetPromptParams -> Rep GetPromptParams x
$cto :: forall x. Rep GetPromptParams x -> GetPromptParams
to :: forall x. Rep GetPromptParams x -> GetPromptParams
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True} ''GetPromptParams)

-- | Get prompt request
data GetPromptRequest = GetPromptRequest
    { GetPromptRequest -> Text
method :: Text -- Always "prompts/get"
    , GetPromptRequest -> GetPromptParams
params :: GetPromptParams
    }
    deriving stock (Int -> GetPromptRequest -> ShowS
[GetPromptRequest] -> ShowS
GetPromptRequest -> String
(Int -> GetPromptRequest -> ShowS)
-> (GetPromptRequest -> String)
-> ([GetPromptRequest] -> ShowS)
-> Show GetPromptRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetPromptRequest -> ShowS
showsPrec :: Int -> GetPromptRequest -> ShowS
$cshow :: GetPromptRequest -> String
show :: GetPromptRequest -> String
$cshowList :: [GetPromptRequest] -> ShowS
showList :: [GetPromptRequest] -> ShowS
Show, GetPromptRequest -> GetPromptRequest -> Bool
(GetPromptRequest -> GetPromptRequest -> Bool)
-> (GetPromptRequest -> GetPromptRequest -> Bool)
-> Eq GetPromptRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetPromptRequest -> GetPromptRequest -> Bool
== :: GetPromptRequest -> GetPromptRequest -> Bool
$c/= :: GetPromptRequest -> GetPromptRequest -> Bool
/= :: GetPromptRequest -> GetPromptRequest -> Bool
Eq, (forall x. GetPromptRequest -> Rep GetPromptRequest x)
-> (forall x. Rep GetPromptRequest x -> GetPromptRequest)
-> Generic GetPromptRequest
forall x. Rep GetPromptRequest x -> GetPromptRequest
forall x. GetPromptRequest -> Rep GetPromptRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetPromptRequest -> Rep GetPromptRequest x
from :: forall x. GetPromptRequest -> Rep GetPromptRequest x
$cto :: forall x. Rep GetPromptRequest x -> GetPromptRequest
to :: forall x. Rep GetPromptRequest x -> GetPromptRequest
Generic)

instance ToJSON GetPromptRequest where
    toJSON :: GetPromptRequest -> Value
toJSON (GetPromptRequest Text
_ GetPromptParams
p) =
        [Pair] -> Value
object
            [ Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"prompts/get" :: Text)
            , Key
"params" Key -> GetPromptParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GetPromptParams
p
            ]

instance FromJSON GetPromptRequest where
    parseJSON :: Value -> Parser GetPromptRequest
parseJSON = String
-> (Object -> Parser GetPromptRequest)
-> Value
-> Parser GetPromptRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GetPromptRequest" ((Object -> Parser GetPromptRequest)
 -> Value -> Parser GetPromptRequest)
-> (Object -> Parser GetPromptRequest)
-> Value
-> Parser GetPromptRequest
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"prompts/get" :: Text)
            then Text -> GetPromptParams -> GetPromptRequest
GetPromptRequest Text
m (GetPromptParams -> GetPromptRequest)
-> Parser GetPromptParams -> Parser GetPromptRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser GetPromptParams
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
            else String -> Parser GetPromptRequest
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'prompts/get'"

-- | List tools request parameters
data ListToolsParams where
    ListToolsParams :: {ListToolsParams -> Maybe Cursor
cursor :: Maybe Cursor} -> ListToolsParams
    deriving stock (Int -> ListToolsParams -> ShowS
[ListToolsParams] -> ShowS
ListToolsParams -> String
(Int -> ListToolsParams -> ShowS)
-> (ListToolsParams -> String)
-> ([ListToolsParams] -> ShowS)
-> Show ListToolsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListToolsParams -> ShowS
showsPrec :: Int -> ListToolsParams -> ShowS
$cshow :: ListToolsParams -> String
show :: ListToolsParams -> String
$cshowList :: [ListToolsParams] -> ShowS
showList :: [ListToolsParams] -> ShowS
Show, ListToolsParams -> ListToolsParams -> Bool
(ListToolsParams -> ListToolsParams -> Bool)
-> (ListToolsParams -> ListToolsParams -> Bool)
-> Eq ListToolsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListToolsParams -> ListToolsParams -> Bool
== :: ListToolsParams -> ListToolsParams -> Bool
$c/= :: ListToolsParams -> ListToolsParams -> Bool
/= :: ListToolsParams -> ListToolsParams -> Bool
Eq, (forall x. ListToolsParams -> Rep ListToolsParams x)
-> (forall x. Rep ListToolsParams x -> ListToolsParams)
-> Generic ListToolsParams
forall x. Rep ListToolsParams x -> ListToolsParams
forall x. ListToolsParams -> Rep ListToolsParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListToolsParams -> Rep ListToolsParams x
from :: forall x. ListToolsParams -> Rep ListToolsParams x
$cto :: forall x. Rep ListToolsParams x -> ListToolsParams
to :: forall x. Rep ListToolsParams x -> ListToolsParams
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True} ''ListToolsParams)

-- | List tools request
data ListToolsRequest = ListToolsRequest
    { ListToolsRequest -> Text
method :: Text -- Always "tools/list"
    , ListToolsRequest -> Maybe ListToolsParams
params :: Maybe ListToolsParams
    }
    deriving stock (Int -> ListToolsRequest -> ShowS
[ListToolsRequest] -> ShowS
ListToolsRequest -> String
(Int -> ListToolsRequest -> ShowS)
-> (ListToolsRequest -> String)
-> ([ListToolsRequest] -> ShowS)
-> Show ListToolsRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListToolsRequest -> ShowS
showsPrec :: Int -> ListToolsRequest -> ShowS
$cshow :: ListToolsRequest -> String
show :: ListToolsRequest -> String
$cshowList :: [ListToolsRequest] -> ShowS
showList :: [ListToolsRequest] -> ShowS
Show, ListToolsRequest -> ListToolsRequest -> Bool
(ListToolsRequest -> ListToolsRequest -> Bool)
-> (ListToolsRequest -> ListToolsRequest -> Bool)
-> Eq ListToolsRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListToolsRequest -> ListToolsRequest -> Bool
== :: ListToolsRequest -> ListToolsRequest -> Bool
$c/= :: ListToolsRequest -> ListToolsRequest -> Bool
/= :: ListToolsRequest -> ListToolsRequest -> Bool
Eq, (forall x. ListToolsRequest -> Rep ListToolsRequest x)
-> (forall x. Rep ListToolsRequest x -> ListToolsRequest)
-> Generic ListToolsRequest
forall x. Rep ListToolsRequest x -> ListToolsRequest
forall x. ListToolsRequest -> Rep ListToolsRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListToolsRequest -> Rep ListToolsRequest x
from :: forall x. ListToolsRequest -> Rep ListToolsRequest x
$cto :: forall x. Rep ListToolsRequest x -> ListToolsRequest
to :: forall x. Rep ListToolsRequest x -> ListToolsRequest
Generic)

instance ToJSON ListToolsRequest where
    toJSON :: ListToolsRequest -> Value
toJSON (ListToolsRequest Text
_ Maybe ListToolsParams
p) =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
            (Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"tools/list" :: Text)) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
-> (ListToolsParams -> [Pair]) -> Maybe ListToolsParams -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ListToolsParams
pr -> [Key
"params" Key -> ListToolsParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ListToolsParams
pr]) Maybe ListToolsParams
p

instance FromJSON ListToolsRequest where
    parseJSON :: Value -> Parser ListToolsRequest
parseJSON = String
-> (Object -> Parser ListToolsRequest)
-> Value
-> Parser ListToolsRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ListToolsRequest" ((Object -> Parser ListToolsRequest)
 -> Value -> Parser ListToolsRequest)
-> (Object -> Parser ListToolsRequest)
-> Value
-> Parser ListToolsRequest
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"tools/list" :: Text)
            then Text -> Maybe ListToolsParams -> ListToolsRequest
ListToolsRequest Text
m (Maybe ListToolsParams -> ListToolsRequest)
-> Parser (Maybe ListToolsParams) -> Parser ListToolsRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe ListToolsParams)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params"
            else String -> Parser ListToolsRequest
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'tools/list'"

-- | Call tool request parameters
data CallToolParams = CallToolParams
    { CallToolParams -> Text
name :: Text
    , CallToolParams -> Maybe (Map Text Value)
arguments :: Maybe (Map Text Value)
    }
    deriving stock (Int -> CallToolParams -> ShowS
[CallToolParams] -> ShowS
CallToolParams -> String
(Int -> CallToolParams -> ShowS)
-> (CallToolParams -> String)
-> ([CallToolParams] -> ShowS)
-> Show CallToolParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CallToolParams -> ShowS
showsPrec :: Int -> CallToolParams -> ShowS
$cshow :: CallToolParams -> String
show :: CallToolParams -> String
$cshowList :: [CallToolParams] -> ShowS
showList :: [CallToolParams] -> ShowS
Show, CallToolParams -> CallToolParams -> Bool
(CallToolParams -> CallToolParams -> Bool)
-> (CallToolParams -> CallToolParams -> Bool) -> Eq CallToolParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CallToolParams -> CallToolParams -> Bool
== :: CallToolParams -> CallToolParams -> Bool
$c/= :: CallToolParams -> CallToolParams -> Bool
/= :: CallToolParams -> CallToolParams -> Bool
Eq, (forall x. CallToolParams -> Rep CallToolParams x)
-> (forall x. Rep CallToolParams x -> CallToolParams)
-> Generic CallToolParams
forall x. Rep CallToolParams x -> CallToolParams
forall x. CallToolParams -> Rep CallToolParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CallToolParams -> Rep CallToolParams x
from :: forall x. CallToolParams -> Rep CallToolParams x
$cto :: forall x. Rep CallToolParams x -> CallToolParams
to :: forall x. Rep CallToolParams x -> CallToolParams
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True} ''CallToolParams)

-- | Call tool request
data CallToolRequest = CallToolRequest
    { CallToolRequest -> Text
method :: Text -- Always "tools/call"
    , CallToolRequest -> CallToolParams
params :: CallToolParams
    }
    deriving stock (Int -> CallToolRequest -> ShowS
[CallToolRequest] -> ShowS
CallToolRequest -> String
(Int -> CallToolRequest -> ShowS)
-> (CallToolRequest -> String)
-> ([CallToolRequest] -> ShowS)
-> Show CallToolRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CallToolRequest -> ShowS
showsPrec :: Int -> CallToolRequest -> ShowS
$cshow :: CallToolRequest -> String
show :: CallToolRequest -> String
$cshowList :: [CallToolRequest] -> ShowS
showList :: [CallToolRequest] -> ShowS
Show, CallToolRequest -> CallToolRequest -> Bool
(CallToolRequest -> CallToolRequest -> Bool)
-> (CallToolRequest -> CallToolRequest -> Bool)
-> Eq CallToolRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CallToolRequest -> CallToolRequest -> Bool
== :: CallToolRequest -> CallToolRequest -> Bool
$c/= :: CallToolRequest -> CallToolRequest -> Bool
/= :: CallToolRequest -> CallToolRequest -> Bool
Eq, (forall x. CallToolRequest -> Rep CallToolRequest x)
-> (forall x. Rep CallToolRequest x -> CallToolRequest)
-> Generic CallToolRequest
forall x. Rep CallToolRequest x -> CallToolRequest
forall x. CallToolRequest -> Rep CallToolRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CallToolRequest -> Rep CallToolRequest x
from :: forall x. CallToolRequest -> Rep CallToolRequest x
$cto :: forall x. Rep CallToolRequest x -> CallToolRequest
to :: forall x. Rep CallToolRequest x -> CallToolRequest
Generic)

instance ToJSON CallToolRequest where
    toJSON :: CallToolRequest -> Value
toJSON (CallToolRequest Text
_ CallToolParams
p) =
        [Pair] -> Value
object
            [ Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"tools/call" :: Text)
            , Key
"params" Key -> CallToolParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CallToolParams
p
            ]

instance FromJSON CallToolRequest where
    parseJSON :: Value -> Parser CallToolRequest
parseJSON = String
-> (Object -> Parser CallToolRequest)
-> Value
-> Parser CallToolRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CallToolRequest" ((Object -> Parser CallToolRequest)
 -> Value -> Parser CallToolRequest)
-> (Object -> Parser CallToolRequest)
-> Value
-> Parser CallToolRequest
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"tools/call" :: Text)
            then Text -> CallToolParams -> CallToolRequest
CallToolRequest Text
m (CallToolParams -> CallToolRequest)
-> Parser CallToolParams -> Parser CallToolRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser CallToolParams
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
            else String -> Parser CallToolRequest
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'tools/call'"

-- | Set level request parameters
data SetLevelParams where
    SetLevelParams :: {SetLevelParams -> LoggingLevel
level :: LoggingLevel} -> SetLevelParams
    deriving stock (Int -> SetLevelParams -> ShowS
[SetLevelParams] -> ShowS
SetLevelParams -> String
(Int -> SetLevelParams -> ShowS)
-> (SetLevelParams -> String)
-> ([SetLevelParams] -> ShowS)
-> Show SetLevelParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetLevelParams -> ShowS
showsPrec :: Int -> SetLevelParams -> ShowS
$cshow :: SetLevelParams -> String
show :: SetLevelParams -> String
$cshowList :: [SetLevelParams] -> ShowS
showList :: [SetLevelParams] -> ShowS
Show, SetLevelParams -> SetLevelParams -> Bool
(SetLevelParams -> SetLevelParams -> Bool)
-> (SetLevelParams -> SetLevelParams -> Bool) -> Eq SetLevelParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SetLevelParams -> SetLevelParams -> Bool
== :: SetLevelParams -> SetLevelParams -> Bool
$c/= :: SetLevelParams -> SetLevelParams -> Bool
/= :: SetLevelParams -> SetLevelParams -> Bool
Eq, (forall x. SetLevelParams -> Rep SetLevelParams x)
-> (forall x. Rep SetLevelParams x -> SetLevelParams)
-> Generic SetLevelParams
forall x. Rep SetLevelParams x -> SetLevelParams
forall x. SetLevelParams -> Rep SetLevelParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SetLevelParams -> Rep SetLevelParams x
from :: forall x. SetLevelParams -> Rep SetLevelParams x
$cto :: forall x. Rep SetLevelParams x -> SetLevelParams
to :: forall x. Rep SetLevelParams x -> SetLevelParams
Generic)

$(deriveJSON defaultOptions ''SetLevelParams)

-- | Set level request
data SetLevelRequest = SetLevelRequest
    { SetLevelRequest -> Text
method :: Text -- Always "logging/setLevel"
    , SetLevelRequest -> SetLevelParams
params :: SetLevelParams
    }
    deriving stock (Int -> SetLevelRequest -> ShowS
[SetLevelRequest] -> ShowS
SetLevelRequest -> String
(Int -> SetLevelRequest -> ShowS)
-> (SetLevelRequest -> String)
-> ([SetLevelRequest] -> ShowS)
-> Show SetLevelRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetLevelRequest -> ShowS
showsPrec :: Int -> SetLevelRequest -> ShowS
$cshow :: SetLevelRequest -> String
show :: SetLevelRequest -> String
$cshowList :: [SetLevelRequest] -> ShowS
showList :: [SetLevelRequest] -> ShowS
Show, SetLevelRequest -> SetLevelRequest -> Bool
(SetLevelRequest -> SetLevelRequest -> Bool)
-> (SetLevelRequest -> SetLevelRequest -> Bool)
-> Eq SetLevelRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SetLevelRequest -> SetLevelRequest -> Bool
== :: SetLevelRequest -> SetLevelRequest -> Bool
$c/= :: SetLevelRequest -> SetLevelRequest -> Bool
/= :: SetLevelRequest -> SetLevelRequest -> Bool
Eq, (forall x. SetLevelRequest -> Rep SetLevelRequest x)
-> (forall x. Rep SetLevelRequest x -> SetLevelRequest)
-> Generic SetLevelRequest
forall x. Rep SetLevelRequest x -> SetLevelRequest
forall x. SetLevelRequest -> Rep SetLevelRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SetLevelRequest -> Rep SetLevelRequest x
from :: forall x. SetLevelRequest -> Rep SetLevelRequest x
$cto :: forall x. Rep SetLevelRequest x -> SetLevelRequest
to :: forall x. Rep SetLevelRequest x -> SetLevelRequest
Generic)

instance ToJSON SetLevelRequest where
    toJSON :: SetLevelRequest -> Value
toJSON (SetLevelRequest Text
_ SetLevelParams
p) =
        [Pair] -> Value
object
            [ Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"logging/setLevel" :: Text)
            , Key
"params" Key -> SetLevelParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SetLevelParams
p
            ]

instance FromJSON SetLevelRequest where
    parseJSON :: Value -> Parser SetLevelRequest
parseJSON = String
-> (Object -> Parser SetLevelRequest)
-> Value
-> Parser SetLevelRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SetLevelRequest" ((Object -> Parser SetLevelRequest)
 -> Value -> Parser SetLevelRequest)
-> (Object -> Parser SetLevelRequest)
-> Value
-> Parser SetLevelRequest
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"logging/setLevel" :: Text)
            then Text -> SetLevelParams -> SetLevelRequest
SetLevelRequest Text
m (SetLevelParams -> SetLevelRequest)
-> Parser SetLevelParams -> Parser SetLevelRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser SetLevelParams
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
            else String -> Parser SetLevelRequest
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'logging/setLevel'"

-- | Completion argument
data CompletionArgument = CompletionArgument
    { CompletionArgument -> Text
name :: Text
    , CompletionArgument -> Text
value :: Text
    }
    deriving stock (Int -> CompletionArgument -> ShowS
[CompletionArgument] -> ShowS
CompletionArgument -> String
(Int -> CompletionArgument -> ShowS)
-> (CompletionArgument -> String)
-> ([CompletionArgument] -> ShowS)
-> Show CompletionArgument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompletionArgument -> ShowS
showsPrec :: Int -> CompletionArgument -> ShowS
$cshow :: CompletionArgument -> String
show :: CompletionArgument -> String
$cshowList :: [CompletionArgument] -> ShowS
showList :: [CompletionArgument] -> ShowS
Show, CompletionArgument -> CompletionArgument -> Bool
(CompletionArgument -> CompletionArgument -> Bool)
-> (CompletionArgument -> CompletionArgument -> Bool)
-> Eq CompletionArgument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompletionArgument -> CompletionArgument -> Bool
== :: CompletionArgument -> CompletionArgument -> Bool
$c/= :: CompletionArgument -> CompletionArgument -> Bool
/= :: CompletionArgument -> CompletionArgument -> Bool
Eq, (forall x. CompletionArgument -> Rep CompletionArgument x)
-> (forall x. Rep CompletionArgument x -> CompletionArgument)
-> Generic CompletionArgument
forall x. Rep CompletionArgument x -> CompletionArgument
forall x. CompletionArgument -> Rep CompletionArgument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CompletionArgument -> Rep CompletionArgument x
from :: forall x. CompletionArgument -> Rep CompletionArgument x
$cto :: forall x. Rep CompletionArgument x -> CompletionArgument
to :: forall x. Rep CompletionArgument x -> CompletionArgument
Generic)

$(deriveJSON defaultOptions ''CompletionArgument)

-- | Reference (prompt or resource template)
data Reference
    = PromptRef PromptReference
    | ResourceTemplateRef ResourceTemplateReference
    deriving stock (Int -> Reference -> ShowS
[Reference] -> ShowS
Reference -> String
(Int -> Reference -> ShowS)
-> (Reference -> String)
-> ([Reference] -> ShowS)
-> Show Reference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Reference -> ShowS
showsPrec :: Int -> Reference -> ShowS
$cshow :: Reference -> String
show :: Reference -> String
$cshowList :: [Reference] -> ShowS
showList :: [Reference] -> ShowS
Show, Reference -> Reference -> Bool
(Reference -> Reference -> Bool)
-> (Reference -> Reference -> Bool) -> Eq Reference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Reference -> Reference -> Bool
== :: Reference -> Reference -> Bool
$c/= :: Reference -> Reference -> Bool
/= :: Reference -> Reference -> Bool
Eq, (forall x. Reference -> Rep Reference x)
-> (forall x. Rep Reference x -> Reference) -> Generic Reference
forall x. Rep Reference x -> Reference
forall x. Reference -> Rep Reference x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Reference -> Rep Reference x
from :: forall x. Reference -> Rep Reference x
$cto :: forall x. Rep Reference x -> Reference
to :: forall x. Rep Reference x -> Reference
Generic)

instance ToJSON Reference where
    toJSON :: Reference -> Value
toJSON (PromptRef PromptReference
p) = PromptReference -> Value
forall a. ToJSON a => a -> Value
toJSON PromptReference
p
    toJSON (ResourceTemplateRef ResourceTemplateReference
r) = ResourceTemplateReference -> Value
forall a. ToJSON a => a -> Value
toJSON ResourceTemplateReference
r

instance FromJSON Reference where
    parseJSON :: Value -> Parser Reference
parseJSON Value
v =
        (PromptReference -> Reference
PromptRef (PromptReference -> Reference)
-> Parser PromptReference -> Parser Reference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser PromptReference
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser Reference -> Parser Reference -> Parser Reference
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ResourceTemplateReference -> Reference
ResourceTemplateRef (ResourceTemplateReference -> Reference)
-> Parser ResourceTemplateReference -> Parser Reference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ResourceTemplateReference
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)

-- | Context for completion requests
data CompletionContext = CompletionContext
    { CompletionContext -> Maybe (Map Text Text)
arguments :: Maybe (Map Text Text)
    }
    deriving stock (Int -> CompletionContext -> ShowS
[CompletionContext] -> ShowS
CompletionContext -> String
(Int -> CompletionContext -> ShowS)
-> (CompletionContext -> String)
-> ([CompletionContext] -> ShowS)
-> Show CompletionContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompletionContext -> ShowS
showsPrec :: Int -> CompletionContext -> ShowS
$cshow :: CompletionContext -> String
show :: CompletionContext -> String
$cshowList :: [CompletionContext] -> ShowS
showList :: [CompletionContext] -> ShowS
Show, CompletionContext -> CompletionContext -> Bool
(CompletionContext -> CompletionContext -> Bool)
-> (CompletionContext -> CompletionContext -> Bool)
-> Eq CompletionContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompletionContext -> CompletionContext -> Bool
== :: CompletionContext -> CompletionContext -> Bool
$c/= :: CompletionContext -> CompletionContext -> Bool
/= :: CompletionContext -> CompletionContext -> Bool
Eq, (forall x. CompletionContext -> Rep CompletionContext x)
-> (forall x. Rep CompletionContext x -> CompletionContext)
-> Generic CompletionContext
forall x. Rep CompletionContext x -> CompletionContext
forall x. CompletionContext -> Rep CompletionContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CompletionContext -> Rep CompletionContext x
from :: forall x. CompletionContext -> Rep CompletionContext x
$cto :: forall x. Rep CompletionContext x -> CompletionContext
to :: forall x. Rep CompletionContext x -> CompletionContext
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True} ''CompletionContext)

-- | Parameters for a completion request
data CompleteParams = CompleteParams
    { CompleteParams -> Reference
ref :: Reference -- ^ Reference to prompt or resource template for completion
    , CompleteParams -> CompletionArgument
argument :: CompletionArgument -- ^ The argument to get completions for
    , CompleteParams -> Maybe CompletionContext
context :: Maybe CompletionContext -- ^ Additional context for completion
    }
    deriving stock (Int -> CompleteParams -> ShowS
[CompleteParams] -> ShowS
CompleteParams -> String
(Int -> CompleteParams -> ShowS)
-> (CompleteParams -> String)
-> ([CompleteParams] -> ShowS)
-> Show CompleteParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompleteParams -> ShowS
showsPrec :: Int -> CompleteParams -> ShowS
$cshow :: CompleteParams -> String
show :: CompleteParams -> String
$cshowList :: [CompleteParams] -> ShowS
showList :: [CompleteParams] -> ShowS
Show, CompleteParams -> CompleteParams -> Bool
(CompleteParams -> CompleteParams -> Bool)
-> (CompleteParams -> CompleteParams -> Bool) -> Eq CompleteParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompleteParams -> CompleteParams -> Bool
== :: CompleteParams -> CompleteParams -> Bool
$c/= :: CompleteParams -> CompleteParams -> Bool
/= :: CompleteParams -> CompleteParams -> Bool
Eq, (forall x. CompleteParams -> Rep CompleteParams x)
-> (forall x. Rep CompleteParams x -> CompleteParams)
-> Generic CompleteParams
forall x. Rep CompleteParams x -> CompleteParams
forall x. CompleteParams -> Rep CompleteParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CompleteParams -> Rep CompleteParams x
from :: forall x. CompleteParams -> Rep CompleteParams x
$cto :: forall x. Rep CompleteParams x -> CompleteParams
to :: forall x. Rep CompleteParams x -> CompleteParams
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True} ''CompleteParams)

-- | Complete request
data CompleteRequest = CompleteRequest
    { CompleteRequest -> Text
method :: Text -- Always "completion/complete"
    , CompleteRequest -> CompleteParams
params :: CompleteParams
    }
    deriving stock (Int -> CompleteRequest -> ShowS
[CompleteRequest] -> ShowS
CompleteRequest -> String
(Int -> CompleteRequest -> ShowS)
-> (CompleteRequest -> String)
-> ([CompleteRequest] -> ShowS)
-> Show CompleteRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompleteRequest -> ShowS
showsPrec :: Int -> CompleteRequest -> ShowS
$cshow :: CompleteRequest -> String
show :: CompleteRequest -> String
$cshowList :: [CompleteRequest] -> ShowS
showList :: [CompleteRequest] -> ShowS
Show, CompleteRequest -> CompleteRequest -> Bool
(CompleteRequest -> CompleteRequest -> Bool)
-> (CompleteRequest -> CompleteRequest -> Bool)
-> Eq CompleteRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompleteRequest -> CompleteRequest -> Bool
== :: CompleteRequest -> CompleteRequest -> Bool
$c/= :: CompleteRequest -> CompleteRequest -> Bool
/= :: CompleteRequest -> CompleteRequest -> Bool
Eq, (forall x. CompleteRequest -> Rep CompleteRequest x)
-> (forall x. Rep CompleteRequest x -> CompleteRequest)
-> Generic CompleteRequest
forall x. Rep CompleteRequest x -> CompleteRequest
forall x. CompleteRequest -> Rep CompleteRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CompleteRequest -> Rep CompleteRequest x
from :: forall x. CompleteRequest -> Rep CompleteRequest x
$cto :: forall x. Rep CompleteRequest x -> CompleteRequest
to :: forall x. Rep CompleteRequest x -> CompleteRequest
Generic)

instance ToJSON CompleteRequest where
    toJSON :: CompleteRequest -> Value
toJSON (CompleteRequest Text
_ CompleteParams
p) =
        [Pair] -> Value
object
            [ Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"completion/complete" :: Text)
            , Key
"params" Key -> CompleteParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CompleteParams
p
            ]

instance FromJSON CompleteRequest where
    parseJSON :: Value -> Parser CompleteRequest
parseJSON = String
-> (Object -> Parser CompleteRequest)
-> Value
-> Parser CompleteRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CompleteRequest" ((Object -> Parser CompleteRequest)
 -> Value -> Parser CompleteRequest)
-> (Object -> Parser CompleteRequest)
-> Value
-> Parser CompleteRequest
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"completion/complete" :: Text)
            then Text -> CompleteParams -> CompleteRequest
CompleteRequest Text
m (CompleteParams -> CompleteRequest)
-> Parser CompleteParams -> Parser CompleteRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser CompleteParams
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
            else String -> Parser CompleteRequest
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'completion/complete'"

-- * Server Request Types

-- | Create message request parameters
data CreateMessageParams = CreateMessageParams
    { CreateMessageParams -> Int
maxTokens :: Int
    , CreateMessageParams -> [SamplingMessage]
messages :: [SamplingMessage]
    , CreateMessageParams -> Maybe ModelPreferences
modelPreferences :: Maybe ModelPreferences
    , CreateMessageParams -> Maybe Text
systemPrompt :: Maybe Text
    , CreateMessageParams -> Maybe IncludeContext
includeContext :: Maybe IncludeContext
    , CreateMessageParams -> Maybe Double
temperature :: Maybe Double
    , CreateMessageParams -> Maybe [Text]
stopSequences :: Maybe [Text]
    , CreateMessageParams -> Maybe (Map Text Value)
metadata :: Maybe (Map Text Value)
    }
    deriving stock (Int -> CreateMessageParams -> ShowS
[CreateMessageParams] -> ShowS
CreateMessageParams -> String
(Int -> CreateMessageParams -> ShowS)
-> (CreateMessageParams -> String)
-> ([CreateMessageParams] -> ShowS)
-> Show CreateMessageParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateMessageParams -> ShowS
showsPrec :: Int -> CreateMessageParams -> ShowS
$cshow :: CreateMessageParams -> String
show :: CreateMessageParams -> String
$cshowList :: [CreateMessageParams] -> ShowS
showList :: [CreateMessageParams] -> ShowS
Show, CreateMessageParams -> CreateMessageParams -> Bool
(CreateMessageParams -> CreateMessageParams -> Bool)
-> (CreateMessageParams -> CreateMessageParams -> Bool)
-> Eq CreateMessageParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateMessageParams -> CreateMessageParams -> Bool
== :: CreateMessageParams -> CreateMessageParams -> Bool
$c/= :: CreateMessageParams -> CreateMessageParams -> Bool
/= :: CreateMessageParams -> CreateMessageParams -> Bool
Eq, (forall x. CreateMessageParams -> Rep CreateMessageParams x)
-> (forall x. Rep CreateMessageParams x -> CreateMessageParams)
-> Generic CreateMessageParams
forall x. Rep CreateMessageParams x -> CreateMessageParams
forall x. CreateMessageParams -> Rep CreateMessageParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateMessageParams -> Rep CreateMessageParams x
from :: forall x. CreateMessageParams -> Rep CreateMessageParams x
$cto :: forall x. Rep CreateMessageParams x -> CreateMessageParams
to :: forall x. Rep CreateMessageParams x -> CreateMessageParams
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True} ''CreateMessageParams)

-- | Create message request
data CreateMessageRequest = CreateMessageRequest
    { CreateMessageRequest -> Text
method :: Text -- Always "sampling/createMessage"
    , CreateMessageRequest -> CreateMessageParams
params :: CreateMessageParams
    }
    deriving stock (Int -> CreateMessageRequest -> ShowS
[CreateMessageRequest] -> ShowS
CreateMessageRequest -> String
(Int -> CreateMessageRequest -> ShowS)
-> (CreateMessageRequest -> String)
-> ([CreateMessageRequest] -> ShowS)
-> Show CreateMessageRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateMessageRequest -> ShowS
showsPrec :: Int -> CreateMessageRequest -> ShowS
$cshow :: CreateMessageRequest -> String
show :: CreateMessageRequest -> String
$cshowList :: [CreateMessageRequest] -> ShowS
showList :: [CreateMessageRequest] -> ShowS
Show, CreateMessageRequest -> CreateMessageRequest -> Bool
(CreateMessageRequest -> CreateMessageRequest -> Bool)
-> (CreateMessageRequest -> CreateMessageRequest -> Bool)
-> Eq CreateMessageRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateMessageRequest -> CreateMessageRequest -> Bool
== :: CreateMessageRequest -> CreateMessageRequest -> Bool
$c/= :: CreateMessageRequest -> CreateMessageRequest -> Bool
/= :: CreateMessageRequest -> CreateMessageRequest -> Bool
Eq, (forall x. CreateMessageRequest -> Rep CreateMessageRequest x)
-> (forall x. Rep CreateMessageRequest x -> CreateMessageRequest)
-> Generic CreateMessageRequest
forall x. Rep CreateMessageRequest x -> CreateMessageRequest
forall x. CreateMessageRequest -> Rep CreateMessageRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateMessageRequest -> Rep CreateMessageRequest x
from :: forall x. CreateMessageRequest -> Rep CreateMessageRequest x
$cto :: forall x. Rep CreateMessageRequest x -> CreateMessageRequest
to :: forall x. Rep CreateMessageRequest x -> CreateMessageRequest
Generic)

instance ToJSON CreateMessageRequest where
    toJSON :: CreateMessageRequest -> Value
toJSON (CreateMessageRequest Text
_ CreateMessageParams
p) =
        [Pair] -> Value
object
            [ Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"sampling/createMessage" :: Text)
            , Key
"params" Key -> CreateMessageParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CreateMessageParams
p
            ]

instance FromJSON CreateMessageRequest where
    parseJSON :: Value -> Parser CreateMessageRequest
parseJSON = String
-> (Object -> Parser CreateMessageRequest)
-> Value
-> Parser CreateMessageRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CreateMessageRequest" ((Object -> Parser CreateMessageRequest)
 -> Value -> Parser CreateMessageRequest)
-> (Object -> Parser CreateMessageRequest)
-> Value
-> Parser CreateMessageRequest
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"sampling/createMessage" :: Text)
            then Text -> CreateMessageParams -> CreateMessageRequest
CreateMessageRequest Text
m (CreateMessageParams -> CreateMessageRequest)
-> Parser CreateMessageParams -> Parser CreateMessageRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser CreateMessageParams
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
            else String -> Parser CreateMessageRequest
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'sampling/createMessage'"

-- | List roots request parameters
data ListRootsParams where
    ListRootsParams :: {ListRootsParams -> Maybe Metadata
_meta :: Maybe Metadata} -> ListRootsParams
    deriving stock (Int -> ListRootsParams -> ShowS
[ListRootsParams] -> ShowS
ListRootsParams -> String
(Int -> ListRootsParams -> ShowS)
-> (ListRootsParams -> String)
-> ([ListRootsParams] -> ShowS)
-> Show ListRootsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListRootsParams -> ShowS
showsPrec :: Int -> ListRootsParams -> ShowS
$cshow :: ListRootsParams -> String
show :: ListRootsParams -> String
$cshowList :: [ListRootsParams] -> ShowS
showList :: [ListRootsParams] -> ShowS
Show, ListRootsParams -> ListRootsParams -> Bool
(ListRootsParams -> ListRootsParams -> Bool)
-> (ListRootsParams -> ListRootsParams -> Bool)
-> Eq ListRootsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListRootsParams -> ListRootsParams -> Bool
== :: ListRootsParams -> ListRootsParams -> Bool
$c/= :: ListRootsParams -> ListRootsParams -> Bool
/= :: ListRootsParams -> ListRootsParams -> Bool
Eq, (forall x. ListRootsParams -> Rep ListRootsParams x)
-> (forall x. Rep ListRootsParams x -> ListRootsParams)
-> Generic ListRootsParams
forall x. Rep ListRootsParams x -> ListRootsParams
forall x. ListRootsParams -> Rep ListRootsParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListRootsParams -> Rep ListRootsParams x
from :: forall x. ListRootsParams -> Rep ListRootsParams x
$cto :: forall x. Rep ListRootsParams x -> ListRootsParams
to :: forall x. Rep ListRootsParams x -> ListRootsParams
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True, fieldLabelModifier = \case { "_meta" -> "_meta"; x -> x }} ''ListRootsParams)

-- | List roots request
data ListRootsRequest = ListRootsRequest
    { ListRootsRequest -> Text
method :: Text -- Always "roots/list"
    , ListRootsRequest -> Maybe ListRootsParams
params :: Maybe ListRootsParams
    }
    deriving stock (Int -> ListRootsRequest -> ShowS
[ListRootsRequest] -> ShowS
ListRootsRequest -> String
(Int -> ListRootsRequest -> ShowS)
-> (ListRootsRequest -> String)
-> ([ListRootsRequest] -> ShowS)
-> Show ListRootsRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListRootsRequest -> ShowS
showsPrec :: Int -> ListRootsRequest -> ShowS
$cshow :: ListRootsRequest -> String
show :: ListRootsRequest -> String
$cshowList :: [ListRootsRequest] -> ShowS
showList :: [ListRootsRequest] -> ShowS
Show, ListRootsRequest -> ListRootsRequest -> Bool
(ListRootsRequest -> ListRootsRequest -> Bool)
-> (ListRootsRequest -> ListRootsRequest -> Bool)
-> Eq ListRootsRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListRootsRequest -> ListRootsRequest -> Bool
== :: ListRootsRequest -> ListRootsRequest -> Bool
$c/= :: ListRootsRequest -> ListRootsRequest -> Bool
/= :: ListRootsRequest -> ListRootsRequest -> Bool
Eq, (forall x. ListRootsRequest -> Rep ListRootsRequest x)
-> (forall x. Rep ListRootsRequest x -> ListRootsRequest)
-> Generic ListRootsRequest
forall x. Rep ListRootsRequest x -> ListRootsRequest
forall x. ListRootsRequest -> Rep ListRootsRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListRootsRequest -> Rep ListRootsRequest x
from :: forall x. ListRootsRequest -> Rep ListRootsRequest x
$cto :: forall x. Rep ListRootsRequest x -> ListRootsRequest
to :: forall x. Rep ListRootsRequest x -> ListRootsRequest
Generic)

instance ToJSON ListRootsRequest where
    toJSON :: ListRootsRequest -> Value
toJSON (ListRootsRequest Text
_ Maybe ListRootsParams
p) =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
            (Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"roots/list" :: Text)) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
-> (ListRootsParams -> [Pair]) -> Maybe ListRootsParams -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ListRootsParams
pr -> [Key
"params" Key -> ListRootsParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ListRootsParams
pr]) Maybe ListRootsParams
p

instance FromJSON ListRootsRequest where
    parseJSON :: Value -> Parser ListRootsRequest
parseJSON = String
-> (Object -> Parser ListRootsRequest)
-> Value
-> Parser ListRootsRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ListRootsRequest" ((Object -> Parser ListRootsRequest)
 -> Value -> Parser ListRootsRequest)
-> (Object -> Parser ListRootsRequest)
-> Value
-> Parser ListRootsRequest
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"roots/list" :: Text)
            then Text -> Maybe ListRootsParams -> ListRootsRequest
ListRootsRequest Text
m (Maybe ListRootsParams -> ListRootsRequest)
-> Parser (Maybe ListRootsParams) -> Parser ListRootsRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe ListRootsParams)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params"
            else String -> Parser ListRootsRequest
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'roots/list'"

-- * Response Types

-- | Initialize result
data InitializeResult = InitializeResult
    { InitializeResult -> Text
protocolVersion :: Text
    , InitializeResult -> ServerCapabilities
capabilities :: ServerCapabilities
    , InitializeResult -> Implementation
serverInfo :: Implementation
    , InitializeResult -> Maybe Text
instructions :: Maybe Text
    , InitializeResult -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> InitializeResult -> ShowS
[InitializeResult] -> ShowS
InitializeResult -> String
(Int -> InitializeResult -> ShowS)
-> (InitializeResult -> String)
-> ([InitializeResult] -> ShowS)
-> Show InitializeResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InitializeResult -> ShowS
showsPrec :: Int -> InitializeResult -> ShowS
$cshow :: InitializeResult -> String
show :: InitializeResult -> String
$cshowList :: [InitializeResult] -> ShowS
showList :: [InitializeResult] -> ShowS
Show, InitializeResult -> InitializeResult -> Bool
(InitializeResult -> InitializeResult -> Bool)
-> (InitializeResult -> InitializeResult -> Bool)
-> Eq InitializeResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InitializeResult -> InitializeResult -> Bool
== :: InitializeResult -> InitializeResult -> Bool
$c/= :: InitializeResult -> InitializeResult -> Bool
/= :: InitializeResult -> InitializeResult -> Bool
Eq, (forall x. InitializeResult -> Rep InitializeResult x)
-> (forall x. Rep InitializeResult x -> InitializeResult)
-> Generic InitializeResult
forall x. Rep InitializeResult x -> InitializeResult
forall x. InitializeResult -> Rep InitializeResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InitializeResult -> Rep InitializeResult x
from :: forall x. InitializeResult -> Rep InitializeResult x
$cto :: forall x. Rep InitializeResult x -> InitializeResult
to :: forall x. Rep InitializeResult x -> InitializeResult
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True, fieldLabelModifier = \case { "_meta" -> "_meta"; x -> x }} ''InitializeResult)

-- | List resources result
data ListResourcesResult = ListResourcesResult
    { ListResourcesResult -> [Resource]
resources :: [Resource]
    , ListResourcesResult -> Maybe Cursor
nextCursor :: Maybe Cursor
    , ListResourcesResult -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> ListResourcesResult -> ShowS
[ListResourcesResult] -> ShowS
ListResourcesResult -> String
(Int -> ListResourcesResult -> ShowS)
-> (ListResourcesResult -> String)
-> ([ListResourcesResult] -> ShowS)
-> Show ListResourcesResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListResourcesResult -> ShowS
showsPrec :: Int -> ListResourcesResult -> ShowS
$cshow :: ListResourcesResult -> String
show :: ListResourcesResult -> String
$cshowList :: [ListResourcesResult] -> ShowS
showList :: [ListResourcesResult] -> ShowS
Show, ListResourcesResult -> ListResourcesResult -> Bool
(ListResourcesResult -> ListResourcesResult -> Bool)
-> (ListResourcesResult -> ListResourcesResult -> Bool)
-> Eq ListResourcesResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListResourcesResult -> ListResourcesResult -> Bool
== :: ListResourcesResult -> ListResourcesResult -> Bool
$c/= :: ListResourcesResult -> ListResourcesResult -> Bool
/= :: ListResourcesResult -> ListResourcesResult -> Bool
Eq, (forall x. ListResourcesResult -> Rep ListResourcesResult x)
-> (forall x. Rep ListResourcesResult x -> ListResourcesResult)
-> Generic ListResourcesResult
forall x. Rep ListResourcesResult x -> ListResourcesResult
forall x. ListResourcesResult -> Rep ListResourcesResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListResourcesResult -> Rep ListResourcesResult x
from :: forall x. ListResourcesResult -> Rep ListResourcesResult x
$cto :: forall x. Rep ListResourcesResult x -> ListResourcesResult
to :: forall x. Rep ListResourcesResult x -> ListResourcesResult
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True, fieldLabelModifier = \case { "_meta" -> "_meta"; x -> x }} ''ListResourcesResult)

-- | List resource templates result
data ListResourceTemplatesResult = ListResourceTemplatesResult
    { ListResourceTemplatesResult -> [ResourceTemplate]
resourceTemplates :: [ResourceTemplate]
    , ListResourceTemplatesResult -> Maybe Cursor
nextCursor :: Maybe Cursor
    , ListResourceTemplatesResult -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> ListResourceTemplatesResult -> ShowS
[ListResourceTemplatesResult] -> ShowS
ListResourceTemplatesResult -> String
(Int -> ListResourceTemplatesResult -> ShowS)
-> (ListResourceTemplatesResult -> String)
-> ([ListResourceTemplatesResult] -> ShowS)
-> Show ListResourceTemplatesResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListResourceTemplatesResult -> ShowS
showsPrec :: Int -> ListResourceTemplatesResult -> ShowS
$cshow :: ListResourceTemplatesResult -> String
show :: ListResourceTemplatesResult -> String
$cshowList :: [ListResourceTemplatesResult] -> ShowS
showList :: [ListResourceTemplatesResult] -> ShowS
Show, ListResourceTemplatesResult -> ListResourceTemplatesResult -> Bool
(ListResourceTemplatesResult
 -> ListResourceTemplatesResult -> Bool)
-> (ListResourceTemplatesResult
    -> ListResourceTemplatesResult -> Bool)
-> Eq ListResourceTemplatesResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListResourceTemplatesResult -> ListResourceTemplatesResult -> Bool
== :: ListResourceTemplatesResult -> ListResourceTemplatesResult -> Bool
$c/= :: ListResourceTemplatesResult -> ListResourceTemplatesResult -> Bool
/= :: ListResourceTemplatesResult -> ListResourceTemplatesResult -> Bool
Eq, (forall x.
 ListResourceTemplatesResult -> Rep ListResourceTemplatesResult x)
-> (forall x.
    Rep ListResourceTemplatesResult x -> ListResourceTemplatesResult)
-> Generic ListResourceTemplatesResult
forall x.
Rep ListResourceTemplatesResult x -> ListResourceTemplatesResult
forall x.
ListResourceTemplatesResult -> Rep ListResourceTemplatesResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ListResourceTemplatesResult -> Rep ListResourceTemplatesResult x
from :: forall x.
ListResourceTemplatesResult -> Rep ListResourceTemplatesResult x
$cto :: forall x.
Rep ListResourceTemplatesResult x -> ListResourceTemplatesResult
to :: forall x.
Rep ListResourceTemplatesResult x -> ListResourceTemplatesResult
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True, fieldLabelModifier = \case { "_meta" -> "_meta"; x -> x }} ''ListResourceTemplatesResult)

-- | Read resource result
data ReadResourceResult = ReadResourceResult
    { ReadResourceResult -> [ResourceContents]
contents :: [ResourceContents]
    , ReadResourceResult -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> ReadResourceResult -> ShowS
[ReadResourceResult] -> ShowS
ReadResourceResult -> String
(Int -> ReadResourceResult -> ShowS)
-> (ReadResourceResult -> String)
-> ([ReadResourceResult] -> ShowS)
-> Show ReadResourceResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReadResourceResult -> ShowS
showsPrec :: Int -> ReadResourceResult -> ShowS
$cshow :: ReadResourceResult -> String
show :: ReadResourceResult -> String
$cshowList :: [ReadResourceResult] -> ShowS
showList :: [ReadResourceResult] -> ShowS
Show, ReadResourceResult -> ReadResourceResult -> Bool
(ReadResourceResult -> ReadResourceResult -> Bool)
-> (ReadResourceResult -> ReadResourceResult -> Bool)
-> Eq ReadResourceResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReadResourceResult -> ReadResourceResult -> Bool
== :: ReadResourceResult -> ReadResourceResult -> Bool
$c/= :: ReadResourceResult -> ReadResourceResult -> Bool
/= :: ReadResourceResult -> ReadResourceResult -> Bool
Eq, (forall x. ReadResourceResult -> Rep ReadResourceResult x)
-> (forall x. Rep ReadResourceResult x -> ReadResourceResult)
-> Generic ReadResourceResult
forall x. Rep ReadResourceResult x -> ReadResourceResult
forall x. ReadResourceResult -> Rep ReadResourceResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReadResourceResult -> Rep ReadResourceResult x
from :: forall x. ReadResourceResult -> Rep ReadResourceResult x
$cto :: forall x. Rep ReadResourceResult x -> ReadResourceResult
to :: forall x. Rep ReadResourceResult x -> ReadResourceResult
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True, fieldLabelModifier = \case { "_meta" -> "_meta"; x -> x }} ''ReadResourceResult)

-- | List prompts result
data ListPromptsResult = ListPromptsResult
    { ListPromptsResult -> [Prompt]
prompts :: [Prompt]
    , ListPromptsResult -> Maybe Cursor
nextCursor :: Maybe Cursor
    , ListPromptsResult -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> ListPromptsResult -> ShowS
[ListPromptsResult] -> ShowS
ListPromptsResult -> String
(Int -> ListPromptsResult -> ShowS)
-> (ListPromptsResult -> String)
-> ([ListPromptsResult] -> ShowS)
-> Show ListPromptsResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListPromptsResult -> ShowS
showsPrec :: Int -> ListPromptsResult -> ShowS
$cshow :: ListPromptsResult -> String
show :: ListPromptsResult -> String
$cshowList :: [ListPromptsResult] -> ShowS
showList :: [ListPromptsResult] -> ShowS
Show, ListPromptsResult -> ListPromptsResult -> Bool
(ListPromptsResult -> ListPromptsResult -> Bool)
-> (ListPromptsResult -> ListPromptsResult -> Bool)
-> Eq ListPromptsResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListPromptsResult -> ListPromptsResult -> Bool
== :: ListPromptsResult -> ListPromptsResult -> Bool
$c/= :: ListPromptsResult -> ListPromptsResult -> Bool
/= :: ListPromptsResult -> ListPromptsResult -> Bool
Eq, (forall x. ListPromptsResult -> Rep ListPromptsResult x)
-> (forall x. Rep ListPromptsResult x -> ListPromptsResult)
-> Generic ListPromptsResult
forall x. Rep ListPromptsResult x -> ListPromptsResult
forall x. ListPromptsResult -> Rep ListPromptsResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListPromptsResult -> Rep ListPromptsResult x
from :: forall x. ListPromptsResult -> Rep ListPromptsResult x
$cto :: forall x. Rep ListPromptsResult x -> ListPromptsResult
to :: forall x. Rep ListPromptsResult x -> ListPromptsResult
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True, fieldLabelModifier = \case { "_meta" -> "_meta"; x -> x }} ''ListPromptsResult)

-- | Get prompt result
data GetPromptResult = GetPromptResult
    { GetPromptResult -> Maybe Text
description :: Maybe Text
    , GetPromptResult -> [PromptMessage]
messages :: [PromptMessage]
    , GetPromptResult -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> GetPromptResult -> ShowS
[GetPromptResult] -> ShowS
GetPromptResult -> String
(Int -> GetPromptResult -> ShowS)
-> (GetPromptResult -> String)
-> ([GetPromptResult] -> ShowS)
-> Show GetPromptResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetPromptResult -> ShowS
showsPrec :: Int -> GetPromptResult -> ShowS
$cshow :: GetPromptResult -> String
show :: GetPromptResult -> String
$cshowList :: [GetPromptResult] -> ShowS
showList :: [GetPromptResult] -> ShowS
Show, GetPromptResult -> GetPromptResult -> Bool
(GetPromptResult -> GetPromptResult -> Bool)
-> (GetPromptResult -> GetPromptResult -> Bool)
-> Eq GetPromptResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetPromptResult -> GetPromptResult -> Bool
== :: GetPromptResult -> GetPromptResult -> Bool
$c/= :: GetPromptResult -> GetPromptResult -> Bool
/= :: GetPromptResult -> GetPromptResult -> Bool
Eq, (forall x. GetPromptResult -> Rep GetPromptResult x)
-> (forall x. Rep GetPromptResult x -> GetPromptResult)
-> Generic GetPromptResult
forall x. Rep GetPromptResult x -> GetPromptResult
forall x. GetPromptResult -> Rep GetPromptResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetPromptResult -> Rep GetPromptResult x
from :: forall x. GetPromptResult -> Rep GetPromptResult x
$cto :: forall x. Rep GetPromptResult x -> GetPromptResult
to :: forall x. Rep GetPromptResult x -> GetPromptResult
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True, fieldLabelModifier = \case { "_meta" -> "_meta"; x -> x }} ''GetPromptResult)

-- | List tools result
data ListToolsResult = ListToolsResult
    { ListToolsResult -> [Tool]
tools :: [Tool]
    , ListToolsResult -> Maybe Cursor
nextCursor :: Maybe Cursor
    , ListToolsResult -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> ListToolsResult -> ShowS
[ListToolsResult] -> ShowS
ListToolsResult -> String
(Int -> ListToolsResult -> ShowS)
-> (ListToolsResult -> String)
-> ([ListToolsResult] -> ShowS)
-> Show ListToolsResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListToolsResult -> ShowS
showsPrec :: Int -> ListToolsResult -> ShowS
$cshow :: ListToolsResult -> String
show :: ListToolsResult -> String
$cshowList :: [ListToolsResult] -> ShowS
showList :: [ListToolsResult] -> ShowS
Show, ListToolsResult -> ListToolsResult -> Bool
(ListToolsResult -> ListToolsResult -> Bool)
-> (ListToolsResult -> ListToolsResult -> Bool)
-> Eq ListToolsResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListToolsResult -> ListToolsResult -> Bool
== :: ListToolsResult -> ListToolsResult -> Bool
$c/= :: ListToolsResult -> ListToolsResult -> Bool
/= :: ListToolsResult -> ListToolsResult -> Bool
Eq, (forall x. ListToolsResult -> Rep ListToolsResult x)
-> (forall x. Rep ListToolsResult x -> ListToolsResult)
-> Generic ListToolsResult
forall x. Rep ListToolsResult x -> ListToolsResult
forall x. ListToolsResult -> Rep ListToolsResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListToolsResult -> Rep ListToolsResult x
from :: forall x. ListToolsResult -> Rep ListToolsResult x
$cto :: forall x. Rep ListToolsResult x -> ListToolsResult
to :: forall x. Rep ListToolsResult x -> ListToolsResult
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True, fieldLabelModifier = \case { "_meta" -> "_meta"; x -> x }} ''ListToolsResult)

-- | Call tool result
data CallToolResult = CallToolResult
    { CallToolResult -> [Content]
content :: [Content]
    , CallToolResult -> Maybe Value
structuredContent :: Maybe Value
    , CallToolResult -> Maybe Bool
isError :: Maybe Bool
    , CallToolResult -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> CallToolResult -> ShowS
[CallToolResult] -> ShowS
CallToolResult -> String
(Int -> CallToolResult -> ShowS)
-> (CallToolResult -> String)
-> ([CallToolResult] -> ShowS)
-> Show CallToolResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CallToolResult -> ShowS
showsPrec :: Int -> CallToolResult -> ShowS
$cshow :: CallToolResult -> String
show :: CallToolResult -> String
$cshowList :: [CallToolResult] -> ShowS
showList :: [CallToolResult] -> ShowS
Show, CallToolResult -> CallToolResult -> Bool
(CallToolResult -> CallToolResult -> Bool)
-> (CallToolResult -> CallToolResult -> Bool) -> Eq CallToolResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CallToolResult -> CallToolResult -> Bool
== :: CallToolResult -> CallToolResult -> Bool
$c/= :: CallToolResult -> CallToolResult -> Bool
/= :: CallToolResult -> CallToolResult -> Bool
Eq, (forall x. CallToolResult -> Rep CallToolResult x)
-> (forall x. Rep CallToolResult x -> CallToolResult)
-> Generic CallToolResult
forall x. Rep CallToolResult x -> CallToolResult
forall x. CallToolResult -> Rep CallToolResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CallToolResult -> Rep CallToolResult x
from :: forall x. CallToolResult -> Rep CallToolResult x
$cto :: forall x. Rep CallToolResult x -> CallToolResult
to :: forall x. Rep CallToolResult x -> CallToolResult
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True, fieldLabelModifier = \case { "_meta" -> "_meta"; x -> x }} ''CallToolResult)

-- | Completion result inner type
data CompletionResult = CompletionResult
    { CompletionResult -> [Text]
values :: [Text]
    , CompletionResult -> Maybe Int
total :: Maybe Int
    , CompletionResult -> Maybe Bool
hasMore :: Maybe Bool
    }
    deriving stock (Int -> CompletionResult -> ShowS
[CompletionResult] -> ShowS
CompletionResult -> String
(Int -> CompletionResult -> ShowS)
-> (CompletionResult -> String)
-> ([CompletionResult] -> ShowS)
-> Show CompletionResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompletionResult -> ShowS
showsPrec :: Int -> CompletionResult -> ShowS
$cshow :: CompletionResult -> String
show :: CompletionResult -> String
$cshowList :: [CompletionResult] -> ShowS
showList :: [CompletionResult] -> ShowS
Show, CompletionResult -> CompletionResult -> Bool
(CompletionResult -> CompletionResult -> Bool)
-> (CompletionResult -> CompletionResult -> Bool)
-> Eq CompletionResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompletionResult -> CompletionResult -> Bool
== :: CompletionResult -> CompletionResult -> Bool
$c/= :: CompletionResult -> CompletionResult -> Bool
/= :: CompletionResult -> CompletionResult -> Bool
Eq, (forall x. CompletionResult -> Rep CompletionResult x)
-> (forall x. Rep CompletionResult x -> CompletionResult)
-> Generic CompletionResult
forall x. Rep CompletionResult x -> CompletionResult
forall x. CompletionResult -> Rep CompletionResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CompletionResult -> Rep CompletionResult x
from :: forall x. CompletionResult -> Rep CompletionResult x
$cto :: forall x. Rep CompletionResult x -> CompletionResult
to :: forall x. Rep CompletionResult x -> CompletionResult
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True} ''CompletionResult)

-- | Complete result
data CompleteResult = CompleteResult
    { CompleteResult -> CompletionResult
completion :: CompletionResult
    , CompleteResult -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> CompleteResult -> ShowS
[CompleteResult] -> ShowS
CompleteResult -> String
(Int -> CompleteResult -> ShowS)
-> (CompleteResult -> String)
-> ([CompleteResult] -> ShowS)
-> Show CompleteResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompleteResult -> ShowS
showsPrec :: Int -> CompleteResult -> ShowS
$cshow :: CompleteResult -> String
show :: CompleteResult -> String
$cshowList :: [CompleteResult] -> ShowS
showList :: [CompleteResult] -> ShowS
Show, CompleteResult -> CompleteResult -> Bool
(CompleteResult -> CompleteResult -> Bool)
-> (CompleteResult -> CompleteResult -> Bool) -> Eq CompleteResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompleteResult -> CompleteResult -> Bool
== :: CompleteResult -> CompleteResult -> Bool
$c/= :: CompleteResult -> CompleteResult -> Bool
/= :: CompleteResult -> CompleteResult -> Bool
Eq, (forall x. CompleteResult -> Rep CompleteResult x)
-> (forall x. Rep CompleteResult x -> CompleteResult)
-> Generic CompleteResult
forall x. Rep CompleteResult x -> CompleteResult
forall x. CompleteResult -> Rep CompleteResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CompleteResult -> Rep CompleteResult x
from :: forall x. CompleteResult -> Rep CompleteResult x
$cto :: forall x. Rep CompleteResult x -> CompleteResult
to :: forall x. Rep CompleteResult x -> CompleteResult
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True, fieldLabelModifier = \case { "_meta" -> "_meta"; x -> x }} ''CompleteResult)

-- | Create message result (extends SamplingMessage)
data CreateMessageResult = CreateMessageResult
    { CreateMessageResult -> Role
role :: Role
    , CreateMessageResult -> SamplingContent
content :: SamplingContent
    , CreateMessageResult -> Text
model :: Text
    , CreateMessageResult -> Maybe Text
stopReason :: Maybe Text
    , CreateMessageResult -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> CreateMessageResult -> ShowS
[CreateMessageResult] -> ShowS
CreateMessageResult -> String
(Int -> CreateMessageResult -> ShowS)
-> (CreateMessageResult -> String)
-> ([CreateMessageResult] -> ShowS)
-> Show CreateMessageResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateMessageResult -> ShowS
showsPrec :: Int -> CreateMessageResult -> ShowS
$cshow :: CreateMessageResult -> String
show :: CreateMessageResult -> String
$cshowList :: [CreateMessageResult] -> ShowS
showList :: [CreateMessageResult] -> ShowS
Show, CreateMessageResult -> CreateMessageResult -> Bool
(CreateMessageResult -> CreateMessageResult -> Bool)
-> (CreateMessageResult -> CreateMessageResult -> Bool)
-> Eq CreateMessageResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateMessageResult -> CreateMessageResult -> Bool
== :: CreateMessageResult -> CreateMessageResult -> Bool
$c/= :: CreateMessageResult -> CreateMessageResult -> Bool
/= :: CreateMessageResult -> CreateMessageResult -> Bool
Eq, (forall x. CreateMessageResult -> Rep CreateMessageResult x)
-> (forall x. Rep CreateMessageResult x -> CreateMessageResult)
-> Generic CreateMessageResult
forall x. Rep CreateMessageResult x -> CreateMessageResult
forall x. CreateMessageResult -> Rep CreateMessageResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateMessageResult -> Rep CreateMessageResult x
from :: forall x. CreateMessageResult -> Rep CreateMessageResult x
$cto :: forall x. Rep CreateMessageResult x -> CreateMessageResult
to :: forall x. Rep CreateMessageResult x -> CreateMessageResult
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True, fieldLabelModifier = \case { "_meta" -> "_meta"; x -> x }} ''CreateMessageResult)

-- | List roots result
data ListRootsResult = ListRootsResult
    { ListRootsResult -> [Root]
roots :: [Root]
    , ListRootsResult -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> ListRootsResult -> ShowS
[ListRootsResult] -> ShowS
ListRootsResult -> String
(Int -> ListRootsResult -> ShowS)
-> (ListRootsResult -> String)
-> ([ListRootsResult] -> ShowS)
-> Show ListRootsResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListRootsResult -> ShowS
showsPrec :: Int -> ListRootsResult -> ShowS
$cshow :: ListRootsResult -> String
show :: ListRootsResult -> String
$cshowList :: [ListRootsResult] -> ShowS
showList :: [ListRootsResult] -> ShowS
Show, ListRootsResult -> ListRootsResult -> Bool
(ListRootsResult -> ListRootsResult -> Bool)
-> (ListRootsResult -> ListRootsResult -> Bool)
-> Eq ListRootsResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListRootsResult -> ListRootsResult -> Bool
== :: ListRootsResult -> ListRootsResult -> Bool
$c/= :: ListRootsResult -> ListRootsResult -> Bool
/= :: ListRootsResult -> ListRootsResult -> Bool
Eq, (forall x. ListRootsResult -> Rep ListRootsResult x)
-> (forall x. Rep ListRootsResult x -> ListRootsResult)
-> Generic ListRootsResult
forall x. Rep ListRootsResult x -> ListRootsResult
forall x. ListRootsResult -> Rep ListRootsResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListRootsResult -> Rep ListRootsResult x
from :: forall x. ListRootsResult -> Rep ListRootsResult x
$cto :: forall x. Rep ListRootsResult x -> ListRootsResult
to :: forall x. Rep ListRootsResult x -> ListRootsResult
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True, fieldLabelModifier = \case { "_meta" -> "_meta"; x -> x }} ''ListRootsResult)

-- * Elicitation Types

-- | Schema for string fields
data StringSchema = StringSchema
    { StringSchema -> Text
schemaType :: Text -- Always "string"
    , StringSchema -> Maybe Text
title :: Maybe Text
    , StringSchema -> Maybe Text
description :: Maybe Text
    , StringSchema -> Maybe Int
minLength :: Maybe Int
    , StringSchema -> Maybe Int
maxLength :: Maybe Int
    , StringSchema -> Maybe Text
format :: Maybe Text -- "email", "uri", "date", "date-time"
    }
    deriving stock (Int -> StringSchema -> ShowS
[StringSchema] -> ShowS
StringSchema -> String
(Int -> StringSchema -> ShowS)
-> (StringSchema -> String)
-> ([StringSchema] -> ShowS)
-> Show StringSchema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StringSchema -> ShowS
showsPrec :: Int -> StringSchema -> ShowS
$cshow :: StringSchema -> String
show :: StringSchema -> String
$cshowList :: [StringSchema] -> ShowS
showList :: [StringSchema] -> ShowS
Show, StringSchema -> StringSchema -> Bool
(StringSchema -> StringSchema -> Bool)
-> (StringSchema -> StringSchema -> Bool) -> Eq StringSchema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StringSchema -> StringSchema -> Bool
== :: StringSchema -> StringSchema -> Bool
$c/= :: StringSchema -> StringSchema -> Bool
/= :: StringSchema -> StringSchema -> Bool
Eq, (forall x. StringSchema -> Rep StringSchema x)
-> (forall x. Rep StringSchema x -> StringSchema)
-> Generic StringSchema
forall x. Rep StringSchema x -> StringSchema
forall x. StringSchema -> Rep StringSchema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StringSchema -> Rep StringSchema x
from :: forall x. StringSchema -> Rep StringSchema x
$cto :: forall x. Rep StringSchema x -> StringSchema
to :: forall x. Rep StringSchema x -> StringSchema
Generic)

instance ToJSON StringSchema where
    toJSON :: StringSchema -> Value
toJSON (StringSchema Text
_ Maybe Text
t Maybe Text
d Maybe Int
minL Maybe Int
maxL Maybe Text
f) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"string" :: Text) ]
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Text -> [Pair]) -> Maybe Text -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [Key
"title" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
x]) Maybe Text
t
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Text -> [Pair]) -> Maybe Text -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
x]) Maybe Text
d
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Int -> [Pair]) -> Maybe Int -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Int
x -> [Key
"minLength" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
x]) Maybe Int
minL
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Int -> [Pair]) -> Maybe Int -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Int
x -> [Key
"maxLength" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
x]) Maybe Int
maxL
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Text -> [Pair]) -> Maybe Text -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [Key
"format" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
x]) Maybe Text
f

instance FromJSON StringSchema where
    parseJSON :: Value -> Parser StringSchema
parseJSON = String
-> (Object -> Parser StringSchema) -> Value -> Parser StringSchema
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"StringSchema" ((Object -> Parser StringSchema) -> Value -> Parser StringSchema)
-> (Object -> Parser StringSchema) -> Value -> Parser StringSchema
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
ty <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
        if Text
ty Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"string" :: Text)
            then Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> StringSchema
StringSchema Text
ty (Maybe Text
 -> Maybe Text
 -> Maybe Int
 -> Maybe Int
 -> Maybe Text
 -> StringSchema)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Int -> Maybe Int -> Maybe Text -> StringSchema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title" Parser
  (Maybe Text
   -> Maybe Int -> Maybe Int -> Maybe Text -> StringSchema)
-> Parser (Maybe Text)
-> Parser (Maybe Int -> Maybe Int -> Maybe Text -> StringSchema)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description" 
                 Parser (Maybe Int -> Maybe Int -> Maybe Text -> StringSchema)
-> Parser (Maybe Int)
-> Parser (Maybe Int -> Maybe Text -> StringSchema)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"minLength" Parser (Maybe Int -> Maybe Text -> StringSchema)
-> Parser (Maybe Int) -> Parser (Maybe Text -> StringSchema)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"maxLength" Parser (Maybe Text -> StringSchema)
-> Parser (Maybe Text) -> Parser StringSchema
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"format"
            else String -> Parser StringSchema
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected type 'string'"

-- | Schema for number/integer fields
data NumberSchema = NumberSchema
    { NumberSchema -> Text
schemaType :: Text -- "number" or "integer"
    , NumberSchema -> Maybe Text
title :: Maybe Text
    , NumberSchema -> Maybe Text
description :: Maybe Text
    , NumberSchema -> Maybe Double
minimum :: Maybe Double
    , NumberSchema -> Maybe Double
maximum :: Maybe Double
    }
    deriving stock (Int -> NumberSchema -> ShowS
[NumberSchema] -> ShowS
NumberSchema -> String
(Int -> NumberSchema -> ShowS)
-> (NumberSchema -> String)
-> ([NumberSchema] -> ShowS)
-> Show NumberSchema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NumberSchema -> ShowS
showsPrec :: Int -> NumberSchema -> ShowS
$cshow :: NumberSchema -> String
show :: NumberSchema -> String
$cshowList :: [NumberSchema] -> ShowS
showList :: [NumberSchema] -> ShowS
Show, NumberSchema -> NumberSchema -> Bool
(NumberSchema -> NumberSchema -> Bool)
-> (NumberSchema -> NumberSchema -> Bool) -> Eq NumberSchema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NumberSchema -> NumberSchema -> Bool
== :: NumberSchema -> NumberSchema -> Bool
$c/= :: NumberSchema -> NumberSchema -> Bool
/= :: NumberSchema -> NumberSchema -> Bool
Eq, (forall x. NumberSchema -> Rep NumberSchema x)
-> (forall x. Rep NumberSchema x -> NumberSchema)
-> Generic NumberSchema
forall x. Rep NumberSchema x -> NumberSchema
forall x. NumberSchema -> Rep NumberSchema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NumberSchema -> Rep NumberSchema x
from :: forall x. NumberSchema -> Rep NumberSchema x
$cto :: forall x. Rep NumberSchema x -> NumberSchema
to :: forall x. Rep NumberSchema x -> NumberSchema
Generic)

instance ToJSON NumberSchema where
    toJSON :: NumberSchema -> Value
toJSON (NumberSchema Text
ty Maybe Text
t Maybe Text
d Maybe Double
minV Maybe Double
maxV) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
ty ]
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Text -> [Pair]) -> Maybe Text -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [Key
"title" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
x]) Maybe Text
t
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Text -> [Pair]) -> Maybe Text -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
x]) Maybe Text
d
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Double -> [Pair]) -> Maybe Double -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Double
x -> [Key
"minimum" Key -> Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Double
x]) Maybe Double
minV
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Double -> [Pair]) -> Maybe Double -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Double
x -> [Key
"maximum" Key -> Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Double
x]) Maybe Double
maxV

instance FromJSON NumberSchema where
    parseJSON :: Value -> Parser NumberSchema
parseJSON = String
-> (Object -> Parser NumberSchema) -> Value -> Parser NumberSchema
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NumberSchema" ((Object -> Parser NumberSchema) -> Value -> Parser NumberSchema)
-> (Object -> Parser NumberSchema) -> Value -> Parser NumberSchema
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
ty <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
        if Text
ty Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Text
"number", Text
"integer"] :: [Text])
            then Text
-> Maybe Text
-> Maybe Text
-> Maybe Double
-> Maybe Double
-> NumberSchema
NumberSchema Text
ty (Maybe Text
 -> Maybe Text -> Maybe Double -> Maybe Double -> NumberSchema)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Double -> Maybe Double -> NumberSchema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title" Parser (Maybe Text -> Maybe Double -> Maybe Double -> NumberSchema)
-> Parser (Maybe Text)
-> Parser (Maybe Double -> Maybe Double -> NumberSchema)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description" 
                 Parser (Maybe Double -> Maybe Double -> NumberSchema)
-> Parser (Maybe Double) -> Parser (Maybe Double -> NumberSchema)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"minimum" Parser (Maybe Double -> NumberSchema)
-> Parser (Maybe Double) -> Parser NumberSchema
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"maximum"
            else String -> Parser NumberSchema
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected type 'number' or 'integer'"

-- | Schema for boolean fields
data BooleanSchema = BooleanSchema
    { BooleanSchema -> Text
schemaType :: Text -- Always "boolean"
    , BooleanSchema -> Maybe Text
title :: Maybe Text
    , BooleanSchema -> Maybe Text
description :: Maybe Text
    , BooleanSchema -> Maybe Bool
defaultValue :: Maybe Bool
    }
    deriving stock (Int -> BooleanSchema -> ShowS
[BooleanSchema] -> ShowS
BooleanSchema -> String
(Int -> BooleanSchema -> ShowS)
-> (BooleanSchema -> String)
-> ([BooleanSchema] -> ShowS)
-> Show BooleanSchema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BooleanSchema -> ShowS
showsPrec :: Int -> BooleanSchema -> ShowS
$cshow :: BooleanSchema -> String
show :: BooleanSchema -> String
$cshowList :: [BooleanSchema] -> ShowS
showList :: [BooleanSchema] -> ShowS
Show, BooleanSchema -> BooleanSchema -> Bool
(BooleanSchema -> BooleanSchema -> Bool)
-> (BooleanSchema -> BooleanSchema -> Bool) -> Eq BooleanSchema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BooleanSchema -> BooleanSchema -> Bool
== :: BooleanSchema -> BooleanSchema -> Bool
$c/= :: BooleanSchema -> BooleanSchema -> Bool
/= :: BooleanSchema -> BooleanSchema -> Bool
Eq, (forall x. BooleanSchema -> Rep BooleanSchema x)
-> (forall x. Rep BooleanSchema x -> BooleanSchema)
-> Generic BooleanSchema
forall x. Rep BooleanSchema x -> BooleanSchema
forall x. BooleanSchema -> Rep BooleanSchema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BooleanSchema -> Rep BooleanSchema x
from :: forall x. BooleanSchema -> Rep BooleanSchema x
$cto :: forall x. Rep BooleanSchema x -> BooleanSchema
to :: forall x. Rep BooleanSchema x -> BooleanSchema
Generic)

instance ToJSON BooleanSchema where
    toJSON :: BooleanSchema -> Value
toJSON (BooleanSchema Text
_ Maybe Text
t Maybe Text
d Maybe Bool
def) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"boolean" :: Text) ]
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Text -> [Pair]) -> Maybe Text -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [Key
"title" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
x]) Maybe Text
t
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Text -> [Pair]) -> Maybe Text -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
x]) Maybe Text
d
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Bool -> [Pair]) -> Maybe Bool -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Bool
x -> [Key
"default" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
x]) Maybe Bool
def

instance FromJSON BooleanSchema where
    parseJSON :: Value -> Parser BooleanSchema
parseJSON = String
-> (Object -> Parser BooleanSchema)
-> Value
-> Parser BooleanSchema
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BooleanSchema" ((Object -> Parser BooleanSchema) -> Value -> Parser BooleanSchema)
-> (Object -> Parser BooleanSchema)
-> Value
-> Parser BooleanSchema
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
ty <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
        if Text
ty Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"boolean" :: Text)
            then Text -> Maybe Text -> Maybe Text -> Maybe Bool -> BooleanSchema
BooleanSchema Text
ty (Maybe Text -> Maybe Text -> Maybe Bool -> BooleanSchema)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Bool -> BooleanSchema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title" Parser (Maybe Text -> Maybe Bool -> BooleanSchema)
-> Parser (Maybe Text) -> Parser (Maybe Bool -> BooleanSchema)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description" Parser (Maybe Bool -> BooleanSchema)
-> Parser (Maybe Bool) -> Parser BooleanSchema
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default"
            else String -> Parser BooleanSchema
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected type 'boolean'"

-- | Schema for enum fields
data EnumSchema = EnumSchema
    { EnumSchema -> Text
schemaType :: Text -- Always "string"
    , EnumSchema -> Maybe Text
title :: Maybe Text
    , EnumSchema -> Maybe Text
description :: Maybe Text
    , EnumSchema -> [Text]
enum :: [Text]
    , EnumSchema -> Maybe [Text]
enumNames :: Maybe [Text] -- Display names for enum values
    }
    deriving stock (Int -> EnumSchema -> ShowS
[EnumSchema] -> ShowS
EnumSchema -> String
(Int -> EnumSchema -> ShowS)
-> (EnumSchema -> String)
-> ([EnumSchema] -> ShowS)
-> Show EnumSchema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnumSchema -> ShowS
showsPrec :: Int -> EnumSchema -> ShowS
$cshow :: EnumSchema -> String
show :: EnumSchema -> String
$cshowList :: [EnumSchema] -> ShowS
showList :: [EnumSchema] -> ShowS
Show, EnumSchema -> EnumSchema -> Bool
(EnumSchema -> EnumSchema -> Bool)
-> (EnumSchema -> EnumSchema -> Bool) -> Eq EnumSchema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnumSchema -> EnumSchema -> Bool
== :: EnumSchema -> EnumSchema -> Bool
$c/= :: EnumSchema -> EnumSchema -> Bool
/= :: EnumSchema -> EnumSchema -> Bool
Eq, (forall x. EnumSchema -> Rep EnumSchema x)
-> (forall x. Rep EnumSchema x -> EnumSchema) -> Generic EnumSchema
forall x. Rep EnumSchema x -> EnumSchema
forall x. EnumSchema -> Rep EnumSchema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EnumSchema -> Rep EnumSchema x
from :: forall x. EnumSchema -> Rep EnumSchema x
$cto :: forall x. Rep EnumSchema x -> EnumSchema
to :: forall x. Rep EnumSchema x -> EnumSchema
Generic)

instance ToJSON EnumSchema where
    toJSON :: EnumSchema -> Value
toJSON (EnumSchema Text
_ Maybe Text
t Maybe Text
d [Text]
e Maybe [Text]
eNames) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"string" :: Text)
        , Key
"enum" Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Text]
e
        ]
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Text -> [Pair]) -> Maybe Text -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [Key
"title" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
x]) Maybe Text
t
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Text -> [Pair]) -> Maybe Text -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
x]) Maybe Text
d
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> ([Text] -> [Pair]) -> Maybe [Text] -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\[Text]
x -> [Key
"enumNames" Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Text]
x]) Maybe [Text]
eNames

instance FromJSON EnumSchema where
    parseJSON :: Value -> Parser EnumSchema
parseJSON = String
-> (Object -> Parser EnumSchema) -> Value -> Parser EnumSchema
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"EnumSchema" ((Object -> Parser EnumSchema) -> Value -> Parser EnumSchema)
-> (Object -> Parser EnumSchema) -> Value -> Parser EnumSchema
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
ty <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
        if Text
ty Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"string" :: Text)
            then Text
-> Maybe Text -> Maybe Text -> [Text] -> Maybe [Text] -> EnumSchema
EnumSchema Text
ty (Maybe Text -> Maybe Text -> [Text] -> Maybe [Text] -> EnumSchema)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> [Text] -> Maybe [Text] -> EnumSchema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title" Parser (Maybe Text -> [Text] -> Maybe [Text] -> EnumSchema)
-> Parser (Maybe Text)
-> Parser ([Text] -> Maybe [Text] -> EnumSchema)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description" 
                 Parser ([Text] -> Maybe [Text] -> EnumSchema)
-> Parser [Text] -> Parser (Maybe [Text] -> EnumSchema)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"enum" Parser (Maybe [Text] -> EnumSchema)
-> Parser (Maybe [Text]) -> Parser EnumSchema
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enumNames"
            else String -> Parser EnumSchema
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected type 'string' with enum"

-- | Primitive schema definition union type
data PrimitiveSchemaDefinition
    = StringSchemaDef StringSchema
    | NumberSchemaDef NumberSchema
    | BooleanSchemaDef BooleanSchema
    | EnumSchemaDef EnumSchema
    deriving stock (Int -> PrimitiveSchemaDefinition -> ShowS
[PrimitiveSchemaDefinition] -> ShowS
PrimitiveSchemaDefinition -> String
(Int -> PrimitiveSchemaDefinition -> ShowS)
-> (PrimitiveSchemaDefinition -> String)
-> ([PrimitiveSchemaDefinition] -> ShowS)
-> Show PrimitiveSchemaDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrimitiveSchemaDefinition -> ShowS
showsPrec :: Int -> PrimitiveSchemaDefinition -> ShowS
$cshow :: PrimitiveSchemaDefinition -> String
show :: PrimitiveSchemaDefinition -> String
$cshowList :: [PrimitiveSchemaDefinition] -> ShowS
showList :: [PrimitiveSchemaDefinition] -> ShowS
Show, PrimitiveSchemaDefinition -> PrimitiveSchemaDefinition -> Bool
(PrimitiveSchemaDefinition -> PrimitiveSchemaDefinition -> Bool)
-> (PrimitiveSchemaDefinition -> PrimitiveSchemaDefinition -> Bool)
-> Eq PrimitiveSchemaDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrimitiveSchemaDefinition -> PrimitiveSchemaDefinition -> Bool
== :: PrimitiveSchemaDefinition -> PrimitiveSchemaDefinition -> Bool
$c/= :: PrimitiveSchemaDefinition -> PrimitiveSchemaDefinition -> Bool
/= :: PrimitiveSchemaDefinition -> PrimitiveSchemaDefinition -> Bool
Eq, (forall x.
 PrimitiveSchemaDefinition -> Rep PrimitiveSchemaDefinition x)
-> (forall x.
    Rep PrimitiveSchemaDefinition x -> PrimitiveSchemaDefinition)
-> Generic PrimitiveSchemaDefinition
forall x.
Rep PrimitiveSchemaDefinition x -> PrimitiveSchemaDefinition
forall x.
PrimitiveSchemaDefinition -> Rep PrimitiveSchemaDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
PrimitiveSchemaDefinition -> Rep PrimitiveSchemaDefinition x
from :: forall x.
PrimitiveSchemaDefinition -> Rep PrimitiveSchemaDefinition x
$cto :: forall x.
Rep PrimitiveSchemaDefinition x -> PrimitiveSchemaDefinition
to :: forall x.
Rep PrimitiveSchemaDefinition x -> PrimitiveSchemaDefinition
Generic)

instance ToJSON PrimitiveSchemaDefinition where
    toJSON :: PrimitiveSchemaDefinition -> Value
toJSON (StringSchemaDef StringSchema
s) = StringSchema -> Value
forall a. ToJSON a => a -> Value
toJSON StringSchema
s
    toJSON (NumberSchemaDef NumberSchema
s) = NumberSchema -> Value
forall a. ToJSON a => a -> Value
toJSON NumberSchema
s
    toJSON (BooleanSchemaDef BooleanSchema
s) = BooleanSchema -> Value
forall a. ToJSON a => a -> Value
toJSON BooleanSchema
s
    toJSON (EnumSchemaDef EnumSchema
s) = EnumSchema -> Value
forall a. ToJSON a => a -> Value
toJSON EnumSchema
s

instance FromJSON PrimitiveSchemaDefinition where
    parseJSON :: Value -> Parser PrimitiveSchemaDefinition
parseJSON Value
v =
        (EnumSchema -> PrimitiveSchemaDefinition
EnumSchemaDef (EnumSchema -> PrimitiveSchemaDefinition)
-> Parser EnumSchema -> Parser PrimitiveSchemaDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser EnumSchema
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v) -- Try enum first since it's also a string type
            Parser PrimitiveSchemaDefinition
-> Parser PrimitiveSchemaDefinition
-> Parser PrimitiveSchemaDefinition
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (StringSchema -> PrimitiveSchemaDefinition
StringSchemaDef (StringSchema -> PrimitiveSchemaDefinition)
-> Parser StringSchema -> Parser PrimitiveSchemaDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser StringSchema
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser PrimitiveSchemaDefinition
-> Parser PrimitiveSchemaDefinition
-> Parser PrimitiveSchemaDefinition
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (NumberSchema -> PrimitiveSchemaDefinition
NumberSchemaDef (NumberSchema -> PrimitiveSchemaDefinition)
-> Parser NumberSchema -> Parser PrimitiveSchemaDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser NumberSchema
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser PrimitiveSchemaDefinition
-> Parser PrimitiveSchemaDefinition
-> Parser PrimitiveSchemaDefinition
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (BooleanSchema -> PrimitiveSchemaDefinition
BooleanSchemaDef (BooleanSchema -> PrimitiveSchemaDefinition)
-> Parser BooleanSchema -> Parser PrimitiveSchemaDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser BooleanSchema
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)

-- | Elicit request parameters
data ElicitParams = ElicitParams
    { ElicitParams -> Text
message :: Text
    , ElicitParams -> Object
requestedSchema :: Object -- Restricted to top-level properties only
    }
    deriving stock (Int -> ElicitParams -> ShowS
[ElicitParams] -> ShowS
ElicitParams -> String
(Int -> ElicitParams -> ShowS)
-> (ElicitParams -> String)
-> ([ElicitParams] -> ShowS)
-> Show ElicitParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ElicitParams -> ShowS
showsPrec :: Int -> ElicitParams -> ShowS
$cshow :: ElicitParams -> String
show :: ElicitParams -> String
$cshowList :: [ElicitParams] -> ShowS
showList :: [ElicitParams] -> ShowS
Show, ElicitParams -> ElicitParams -> Bool
(ElicitParams -> ElicitParams -> Bool)
-> (ElicitParams -> ElicitParams -> Bool) -> Eq ElicitParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ElicitParams -> ElicitParams -> Bool
== :: ElicitParams -> ElicitParams -> Bool
$c/= :: ElicitParams -> ElicitParams -> Bool
/= :: ElicitParams -> ElicitParams -> Bool
Eq, (forall x. ElicitParams -> Rep ElicitParams x)
-> (forall x. Rep ElicitParams x -> ElicitParams)
-> Generic ElicitParams
forall x. Rep ElicitParams x -> ElicitParams
forall x. ElicitParams -> Rep ElicitParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ElicitParams -> Rep ElicitParams x
from :: forall x. ElicitParams -> Rep ElicitParams x
$cto :: forall x. Rep ElicitParams x -> ElicitParams
to :: forall x. Rep ElicitParams x -> ElicitParams
Generic)

$(deriveJSON defaultOptions ''ElicitParams)

-- | Elicit request
data ElicitRequest = ElicitRequest
    { ElicitRequest -> Text
method :: Text -- Always "elicitation/create"
    , ElicitRequest -> ElicitParams
params :: ElicitParams
    }
    deriving stock (Int -> ElicitRequest -> ShowS
[ElicitRequest] -> ShowS
ElicitRequest -> String
(Int -> ElicitRequest -> ShowS)
-> (ElicitRequest -> String)
-> ([ElicitRequest] -> ShowS)
-> Show ElicitRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ElicitRequest -> ShowS
showsPrec :: Int -> ElicitRequest -> ShowS
$cshow :: ElicitRequest -> String
show :: ElicitRequest -> String
$cshowList :: [ElicitRequest] -> ShowS
showList :: [ElicitRequest] -> ShowS
Show, ElicitRequest -> ElicitRequest -> Bool
(ElicitRequest -> ElicitRequest -> Bool)
-> (ElicitRequest -> ElicitRequest -> Bool) -> Eq ElicitRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ElicitRequest -> ElicitRequest -> Bool
== :: ElicitRequest -> ElicitRequest -> Bool
$c/= :: ElicitRequest -> ElicitRequest -> Bool
/= :: ElicitRequest -> ElicitRequest -> Bool
Eq, (forall x. ElicitRequest -> Rep ElicitRequest x)
-> (forall x. Rep ElicitRequest x -> ElicitRequest)
-> Generic ElicitRequest
forall x. Rep ElicitRequest x -> ElicitRequest
forall x. ElicitRequest -> Rep ElicitRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ElicitRequest -> Rep ElicitRequest x
from :: forall x. ElicitRequest -> Rep ElicitRequest x
$cto :: forall x. Rep ElicitRequest x -> ElicitRequest
to :: forall x. Rep ElicitRequest x -> ElicitRequest
Generic)

instance ToJSON ElicitRequest where
    toJSON :: ElicitRequest -> Value
toJSON (ElicitRequest Text
_ ElicitParams
p) =
        [Pair] -> Value
object
            [ Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"elicitation/create" :: Text)
            , Key
"params" Key -> ElicitParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ElicitParams
p
            ]

instance FromJSON ElicitRequest where
    parseJSON :: Value -> Parser ElicitRequest
parseJSON = String
-> (Object -> Parser ElicitRequest)
-> Value
-> Parser ElicitRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ElicitRequest" ((Object -> Parser ElicitRequest) -> Value -> Parser ElicitRequest)
-> (Object -> Parser ElicitRequest)
-> Value
-> Parser ElicitRequest
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"elicitation/create" :: Text)
            then Text -> ElicitParams -> ElicitRequest
ElicitRequest Text
m (ElicitParams -> ElicitRequest)
-> Parser ElicitParams -> Parser ElicitRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ElicitParams
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
            else String -> Parser ElicitRequest
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'elicitation/create'"

-- | Elicit result
data ElicitResult = ElicitResult
    { ElicitResult -> Text
action :: Text -- "accept", "decline", or "cancel"
    , ElicitResult -> Maybe Value
content :: Maybe Value -- Present when action is "accept"
    , ElicitResult -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> ElicitResult -> ShowS
[ElicitResult] -> ShowS
ElicitResult -> String
(Int -> ElicitResult -> ShowS)
-> (ElicitResult -> String)
-> ([ElicitResult] -> ShowS)
-> Show ElicitResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ElicitResult -> ShowS
showsPrec :: Int -> ElicitResult -> ShowS
$cshow :: ElicitResult -> String
show :: ElicitResult -> String
$cshowList :: [ElicitResult] -> ShowS
showList :: [ElicitResult] -> ShowS
Show, ElicitResult -> ElicitResult -> Bool
(ElicitResult -> ElicitResult -> Bool)
-> (ElicitResult -> ElicitResult -> Bool) -> Eq ElicitResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ElicitResult -> ElicitResult -> Bool
== :: ElicitResult -> ElicitResult -> Bool
$c/= :: ElicitResult -> ElicitResult -> Bool
/= :: ElicitResult -> ElicitResult -> Bool
Eq, (forall x. ElicitResult -> Rep ElicitResult x)
-> (forall x. Rep ElicitResult x -> ElicitResult)
-> Generic ElicitResult
forall x. Rep ElicitResult x -> ElicitResult
forall x. ElicitResult -> Rep ElicitResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ElicitResult -> Rep ElicitResult x
from :: forall x. ElicitResult -> Rep ElicitResult x
$cto :: forall x. Rep ElicitResult x -> ElicitResult
to :: forall x. Rep ElicitResult x -> ElicitResult
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True, fieldLabelModifier = \case { "_meta" -> "_meta"; x -> x }} ''ElicitResult)

-- * Notification Types

-- | Cancelled notification parameters
data CancelledParams = CancelledParams
    { CancelledParams -> RequestId
requestId :: RequestId
    , CancelledParams -> Maybe Text
reason :: Maybe Text
    }
    deriving stock (Int -> CancelledParams -> ShowS
[CancelledParams] -> ShowS
CancelledParams -> String
(Int -> CancelledParams -> ShowS)
-> (CancelledParams -> String)
-> ([CancelledParams] -> ShowS)
-> Show CancelledParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CancelledParams -> ShowS
showsPrec :: Int -> CancelledParams -> ShowS
$cshow :: CancelledParams -> String
show :: CancelledParams -> String
$cshowList :: [CancelledParams] -> ShowS
showList :: [CancelledParams] -> ShowS
Show, CancelledParams -> CancelledParams -> Bool
(CancelledParams -> CancelledParams -> Bool)
-> (CancelledParams -> CancelledParams -> Bool)
-> Eq CancelledParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CancelledParams -> CancelledParams -> Bool
== :: CancelledParams -> CancelledParams -> Bool
$c/= :: CancelledParams -> CancelledParams -> Bool
/= :: CancelledParams -> CancelledParams -> Bool
Eq, (forall x. CancelledParams -> Rep CancelledParams x)
-> (forall x. Rep CancelledParams x -> CancelledParams)
-> Generic CancelledParams
forall x. Rep CancelledParams x -> CancelledParams
forall x. CancelledParams -> Rep CancelledParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CancelledParams -> Rep CancelledParams x
from :: forall x. CancelledParams -> Rep CancelledParams x
$cto :: forall x. Rep CancelledParams x -> CancelledParams
to :: forall x. Rep CancelledParams x -> CancelledParams
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True} ''CancelledParams)

-- | Cancelled notification
data CancelledNotification = CancelledNotification
    { CancelledNotification -> Text
method :: Text -- Always "notifications/cancelled"
    , CancelledNotification -> CancelledParams
params :: CancelledParams
    }
    deriving stock (Int -> CancelledNotification -> ShowS
[CancelledNotification] -> ShowS
CancelledNotification -> String
(Int -> CancelledNotification -> ShowS)
-> (CancelledNotification -> String)
-> ([CancelledNotification] -> ShowS)
-> Show CancelledNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CancelledNotification -> ShowS
showsPrec :: Int -> CancelledNotification -> ShowS
$cshow :: CancelledNotification -> String
show :: CancelledNotification -> String
$cshowList :: [CancelledNotification] -> ShowS
showList :: [CancelledNotification] -> ShowS
Show, CancelledNotification -> CancelledNotification -> Bool
(CancelledNotification -> CancelledNotification -> Bool)
-> (CancelledNotification -> CancelledNotification -> Bool)
-> Eq CancelledNotification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CancelledNotification -> CancelledNotification -> Bool
== :: CancelledNotification -> CancelledNotification -> Bool
$c/= :: CancelledNotification -> CancelledNotification -> Bool
/= :: CancelledNotification -> CancelledNotification -> Bool
Eq, (forall x. CancelledNotification -> Rep CancelledNotification x)
-> (forall x. Rep CancelledNotification x -> CancelledNotification)
-> Generic CancelledNotification
forall x. Rep CancelledNotification x -> CancelledNotification
forall x. CancelledNotification -> Rep CancelledNotification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CancelledNotification -> Rep CancelledNotification x
from :: forall x. CancelledNotification -> Rep CancelledNotification x
$cto :: forall x. Rep CancelledNotification x -> CancelledNotification
to :: forall x. Rep CancelledNotification x -> CancelledNotification
Generic)

instance ToJSON CancelledNotification where
    toJSON :: CancelledNotification -> Value
toJSON (CancelledNotification Text
_ CancelledParams
p) =
        [Pair] -> Value
object
            [ Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"notifications/cancelled" :: Text)
            , Key
"params" Key -> CancelledParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CancelledParams
p
            ]

instance FromJSON CancelledNotification where
    parseJSON :: Value -> Parser CancelledNotification
parseJSON = String
-> (Object -> Parser CancelledNotification)
-> Value
-> Parser CancelledNotification
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CancelledNotification" ((Object -> Parser CancelledNotification)
 -> Value -> Parser CancelledNotification)
-> (Object -> Parser CancelledNotification)
-> Value
-> Parser CancelledNotification
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"notifications/cancelled" :: Text)
            then Text -> CancelledParams -> CancelledNotification
CancelledNotification Text
m (CancelledParams -> CancelledNotification)
-> Parser CancelledParams -> Parser CancelledNotification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser CancelledParams
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
            else String -> Parser CancelledNotification
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'notifications/cancelled'"

-- | Initialized notification parameters
data InitializedParams where
    InitializedParams :: {InitializedParams -> Maybe Metadata
_meta :: Maybe Metadata} -> InitializedParams
    deriving stock (Int -> InitializedParams -> ShowS
[InitializedParams] -> ShowS
InitializedParams -> String
(Int -> InitializedParams -> ShowS)
-> (InitializedParams -> String)
-> ([InitializedParams] -> ShowS)
-> Show InitializedParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InitializedParams -> ShowS
showsPrec :: Int -> InitializedParams -> ShowS
$cshow :: InitializedParams -> String
show :: InitializedParams -> String
$cshowList :: [InitializedParams] -> ShowS
showList :: [InitializedParams] -> ShowS
Show, InitializedParams -> InitializedParams -> Bool
(InitializedParams -> InitializedParams -> Bool)
-> (InitializedParams -> InitializedParams -> Bool)
-> Eq InitializedParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InitializedParams -> InitializedParams -> Bool
== :: InitializedParams -> InitializedParams -> Bool
$c/= :: InitializedParams -> InitializedParams -> Bool
/= :: InitializedParams -> InitializedParams -> Bool
Eq, (forall x. InitializedParams -> Rep InitializedParams x)
-> (forall x. Rep InitializedParams x -> InitializedParams)
-> Generic InitializedParams
forall x. Rep InitializedParams x -> InitializedParams
forall x. InitializedParams -> Rep InitializedParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InitializedParams -> Rep InitializedParams x
from :: forall x. InitializedParams -> Rep InitializedParams x
$cto :: forall x. Rep InitializedParams x -> InitializedParams
to :: forall x. Rep InitializedParams x -> InitializedParams
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True, fieldLabelModifier = \case { "_meta" -> "_meta"; x -> x }} ''InitializedParams)

-- | Initialized notification
data InitializedNotification = InitializedNotification
    { InitializedNotification -> Text
method :: Text -- Always "notifications/initialized"
    , InitializedNotification -> Maybe InitializedParams
params :: Maybe InitializedParams
    }
    deriving stock (Int -> InitializedNotification -> ShowS
[InitializedNotification] -> ShowS
InitializedNotification -> String
(Int -> InitializedNotification -> ShowS)
-> (InitializedNotification -> String)
-> ([InitializedNotification] -> ShowS)
-> Show InitializedNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InitializedNotification -> ShowS
showsPrec :: Int -> InitializedNotification -> ShowS
$cshow :: InitializedNotification -> String
show :: InitializedNotification -> String
$cshowList :: [InitializedNotification] -> ShowS
showList :: [InitializedNotification] -> ShowS
Show, InitializedNotification -> InitializedNotification -> Bool
(InitializedNotification -> InitializedNotification -> Bool)
-> (InitializedNotification -> InitializedNotification -> Bool)
-> Eq InitializedNotification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InitializedNotification -> InitializedNotification -> Bool
== :: InitializedNotification -> InitializedNotification -> Bool
$c/= :: InitializedNotification -> InitializedNotification -> Bool
/= :: InitializedNotification -> InitializedNotification -> Bool
Eq, (forall x.
 InitializedNotification -> Rep InitializedNotification x)
-> (forall x.
    Rep InitializedNotification x -> InitializedNotification)
-> Generic InitializedNotification
forall x. Rep InitializedNotification x -> InitializedNotification
forall x. InitializedNotification -> Rep InitializedNotification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InitializedNotification -> Rep InitializedNotification x
from :: forall x. InitializedNotification -> Rep InitializedNotification x
$cto :: forall x. Rep InitializedNotification x -> InitializedNotification
to :: forall x. Rep InitializedNotification x -> InitializedNotification
Generic)

instance ToJSON InitializedNotification where
    toJSON :: InitializedNotification -> Value
toJSON (InitializedNotification Text
_ Maybe InitializedParams
p) =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
            (Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"notifications/initialized" :: Text)) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
-> (InitializedParams -> [Pair])
-> Maybe InitializedParams
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\InitializedParams
pr -> [Key
"params" Key -> InitializedParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= InitializedParams
pr]) Maybe InitializedParams
p

instance FromJSON InitializedNotification where
    parseJSON :: Value -> Parser InitializedNotification
parseJSON = String
-> (Object -> Parser InitializedNotification)
-> Value
-> Parser InitializedNotification
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"InitializedNotification" ((Object -> Parser InitializedNotification)
 -> Value -> Parser InitializedNotification)
-> (Object -> Parser InitializedNotification)
-> Value
-> Parser InitializedNotification
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"notifications/initialized" :: Text)
            then Text -> Maybe InitializedParams -> InitializedNotification
InitializedNotification Text
m (Maybe InitializedParams -> InitializedNotification)
-> Parser (Maybe InitializedParams)
-> Parser InitializedNotification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe InitializedParams)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params"
            else String -> Parser InitializedNotification
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'notifications/initialized'"

-- | Progress notification parameters
data ProgressParams = ProgressParams
    { ProgressParams -> ProgressToken
progressToken :: ProgressToken
    , ProgressParams -> Double
progress :: Double
    , ProgressParams -> Maybe Double
total :: Maybe Double
    , ProgressParams -> Maybe Text
message :: Maybe Text
    }
    deriving stock (Int -> ProgressParams -> ShowS
[ProgressParams] -> ShowS
ProgressParams -> String
(Int -> ProgressParams -> ShowS)
-> (ProgressParams -> String)
-> ([ProgressParams] -> ShowS)
-> Show ProgressParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProgressParams -> ShowS
showsPrec :: Int -> ProgressParams -> ShowS
$cshow :: ProgressParams -> String
show :: ProgressParams -> String
$cshowList :: [ProgressParams] -> ShowS
showList :: [ProgressParams] -> ShowS
Show, ProgressParams -> ProgressParams -> Bool
(ProgressParams -> ProgressParams -> Bool)
-> (ProgressParams -> ProgressParams -> Bool) -> Eq ProgressParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProgressParams -> ProgressParams -> Bool
== :: ProgressParams -> ProgressParams -> Bool
$c/= :: ProgressParams -> ProgressParams -> Bool
/= :: ProgressParams -> ProgressParams -> Bool
Eq, (forall x. ProgressParams -> Rep ProgressParams x)
-> (forall x. Rep ProgressParams x -> ProgressParams)
-> Generic ProgressParams
forall x. Rep ProgressParams x -> ProgressParams
forall x. ProgressParams -> Rep ProgressParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProgressParams -> Rep ProgressParams x
from :: forall x. ProgressParams -> Rep ProgressParams x
$cto :: forall x. Rep ProgressParams x -> ProgressParams
to :: forall x. Rep ProgressParams x -> ProgressParams
Generic)

$(deriveJSON defaultOptions{omitNothingFields = True} ''ProgressParams)

-- | Progress notification
data ProgressNotification = ProgressNotification
    { ProgressNotification -> Text
method :: Text -- Always "notifications/progress"
    , ProgressNotification -> ProgressParams
params :: ProgressParams
    }
    deriving stock (Int -> ProgressNotification -> ShowS
[ProgressNotification] -> ShowS
ProgressNotification -> String
(Int -> ProgressNotification -> ShowS)
-> (ProgressNotification -> String)
-> ([ProgressNotification] -> ShowS)
-> Show ProgressNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProgressNotification -> ShowS
showsPrec :: Int -> ProgressNotification -> ShowS
$cshow :: ProgressNotification -> String
show :: ProgressNotification -> String
$cshowList :: [ProgressNotification] -> ShowS
showList :: [ProgressNotification] -> ShowS
Show, ProgressNotification -> ProgressNotification -> Bool
(ProgressNotification -> ProgressNotification -> Bool)
-> (ProgressNotification -> ProgressNotification -> Bool)
-> Eq ProgressNotification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProgressNotification -> ProgressNotification -> Bool
== :: ProgressNotification -> ProgressNotification -> Bool
$c/= :: ProgressNotification -> ProgressNotification -> Bool
/= :: ProgressNotification -> ProgressNotification -> Bool
Eq, (forall x. ProgressNotification -> Rep ProgressNotification x)
-> (forall x. Rep ProgressNotification x -> ProgressNotification)
-> Generic ProgressNotification
forall x. Rep ProgressNotification x -> ProgressNotification
forall x. ProgressNotification -> Rep ProgressNotification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProgressNotification -> Rep ProgressNotification x
from :: forall x. ProgressNotification -> Rep ProgressNotification x
$cto :: forall x. Rep ProgressNotification x -> ProgressNotification
to :: forall x. Rep ProgressNotification x -> ProgressNotification
Generic)

instance ToJSON ProgressNotification where
    toJSON :: ProgressNotification -> Value
toJSON (ProgressNotification Text
_ ProgressParams
p) =
        [Pair] -> Value
object
            [ Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"notifications/progress" :: Text)
            , Key
"params" Key -> ProgressParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ProgressParams
p
            ]

instance FromJSON ProgressNotification where
    parseJSON :: Value -> Parser ProgressNotification
parseJSON = String
-> (Object -> Parser ProgressNotification)
-> Value
-> Parser ProgressNotification
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProgressNotification" ((Object -> Parser ProgressNotification)
 -> Value -> Parser ProgressNotification)
-> (Object -> Parser ProgressNotification)
-> Value
-> Parser ProgressNotification
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"notifications/progress" :: Text)
            then Text -> ProgressParams -> ProgressNotification
ProgressNotification Text
m (ProgressParams -> ProgressNotification)
-> Parser ProgressParams -> Parser ProgressNotification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ProgressParams
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
            else String -> Parser ProgressNotification
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'notifications/progress'"

-- | Resource list changed notification
data ResourceListChangedNotification = ResourceListChangedNotification
    { ResourceListChangedNotification -> Text
method :: Text -- Always "notifications/resources/list_changed"
    , ResourceListChangedNotification -> Maybe InitializedParams
params :: Maybe InitializedParams
    }
    deriving stock (Int -> ResourceListChangedNotification -> ShowS
[ResourceListChangedNotification] -> ShowS
ResourceListChangedNotification -> String
(Int -> ResourceListChangedNotification -> ShowS)
-> (ResourceListChangedNotification -> String)
-> ([ResourceListChangedNotification] -> ShowS)
-> Show ResourceListChangedNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResourceListChangedNotification -> ShowS
showsPrec :: Int -> ResourceListChangedNotification -> ShowS
$cshow :: ResourceListChangedNotification -> String
show :: ResourceListChangedNotification -> String
$cshowList :: [ResourceListChangedNotification] -> ShowS
showList :: [ResourceListChangedNotification] -> ShowS
Show, ResourceListChangedNotification
-> ResourceListChangedNotification -> Bool
(ResourceListChangedNotification
 -> ResourceListChangedNotification -> Bool)
-> (ResourceListChangedNotification
    -> ResourceListChangedNotification -> Bool)
-> Eq ResourceListChangedNotification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResourceListChangedNotification
-> ResourceListChangedNotification -> Bool
== :: ResourceListChangedNotification
-> ResourceListChangedNotification -> Bool
$c/= :: ResourceListChangedNotification
-> ResourceListChangedNotification -> Bool
/= :: ResourceListChangedNotification
-> ResourceListChangedNotification -> Bool
Eq, (forall x.
 ResourceListChangedNotification
 -> Rep ResourceListChangedNotification x)
-> (forall x.
    Rep ResourceListChangedNotification x
    -> ResourceListChangedNotification)
-> Generic ResourceListChangedNotification
forall x.
Rep ResourceListChangedNotification x
-> ResourceListChangedNotification
forall x.
ResourceListChangedNotification
-> Rep ResourceListChangedNotification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ResourceListChangedNotification
-> Rep ResourceListChangedNotification x
from :: forall x.
ResourceListChangedNotification
-> Rep ResourceListChangedNotification x
$cto :: forall x.
Rep ResourceListChangedNotification x
-> ResourceListChangedNotification
to :: forall x.
Rep ResourceListChangedNotification x
-> ResourceListChangedNotification
Generic)

instance ToJSON ResourceListChangedNotification where
    toJSON :: ResourceListChangedNotification -> Value
toJSON (ResourceListChangedNotification Text
_ Maybe InitializedParams
p) =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
            (Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"notifications/resources/list_changed" :: Text)) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
-> (InitializedParams -> [Pair])
-> Maybe InitializedParams
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\InitializedParams
pr -> [Key
"params" Key -> InitializedParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= InitializedParams
pr]) Maybe InitializedParams
p

instance FromJSON ResourceListChangedNotification where
    parseJSON :: Value -> Parser ResourceListChangedNotification
parseJSON = String
-> (Object -> Parser ResourceListChangedNotification)
-> Value
-> Parser ResourceListChangedNotification
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ResourceListChangedNotification" ((Object -> Parser ResourceListChangedNotification)
 -> Value -> Parser ResourceListChangedNotification)
-> (Object -> Parser ResourceListChangedNotification)
-> Value
-> Parser ResourceListChangedNotification
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"notifications/resources/list_changed" :: Text)
            then Text -> Maybe InitializedParams -> ResourceListChangedNotification
ResourceListChangedNotification Text
m (Maybe InitializedParams -> ResourceListChangedNotification)
-> Parser (Maybe InitializedParams)
-> Parser ResourceListChangedNotification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe InitializedParams)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params"
            else String -> Parser ResourceListChangedNotification
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'notifications/resources/list_changed'"

-- | Resource updated notification parameters
data ResourceUpdatedParams = ResourceUpdatedParams
    { ResourceUpdatedParams -> Text
uri :: Text
    }
    deriving stock (Int -> ResourceUpdatedParams -> ShowS
[ResourceUpdatedParams] -> ShowS
ResourceUpdatedParams -> String
(Int -> ResourceUpdatedParams -> ShowS)
-> (ResourceUpdatedParams -> String)
-> ([ResourceUpdatedParams] -> ShowS)
-> Show ResourceUpdatedParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResourceUpdatedParams -> ShowS
showsPrec :: Int -> ResourceUpdatedParams -> ShowS
$cshow :: ResourceUpdatedParams -> String
show :: ResourceUpdatedParams -> String
$cshowList :: [ResourceUpdatedParams] -> ShowS
showList :: [ResourceUpdatedParams] -> ShowS
Show, ResourceUpdatedParams -> ResourceUpdatedParams -> Bool
(ResourceUpdatedParams -> ResourceUpdatedParams -> Bool)
-> (ResourceUpdatedParams -> ResourceUpdatedParams -> Bool)
-> Eq ResourceUpdatedParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResourceUpdatedParams -> ResourceUpdatedParams -> Bool
== :: ResourceUpdatedParams -> ResourceUpdatedParams -> Bool
$c/= :: ResourceUpdatedParams -> ResourceUpdatedParams -> Bool
/= :: ResourceUpdatedParams -> ResourceUpdatedParams -> Bool
Eq, (forall x. ResourceUpdatedParams -> Rep ResourceUpdatedParams x)
-> (forall x. Rep ResourceUpdatedParams x -> ResourceUpdatedParams)
-> Generic ResourceUpdatedParams
forall x. Rep ResourceUpdatedParams x -> ResourceUpdatedParams
forall x. ResourceUpdatedParams -> Rep ResourceUpdatedParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResourceUpdatedParams -> Rep ResourceUpdatedParams x
from :: forall x. ResourceUpdatedParams -> Rep ResourceUpdatedParams x
$cto :: forall x. Rep ResourceUpdatedParams x -> ResourceUpdatedParams
to :: forall x. Rep ResourceUpdatedParams x -> ResourceUpdatedParams
Generic)

$(deriveJSON defaultOptions ''ResourceUpdatedParams)

-- | Resource updated notification
data ResourceUpdatedNotification = ResourceUpdatedNotification
    { ResourceUpdatedNotification -> Text
method :: Text -- Always "notifications/resources/updated"
    , ResourceUpdatedNotification -> ResourceUpdatedParams
params :: ResourceUpdatedParams
    }
    deriving stock (Int -> ResourceUpdatedNotification -> ShowS
[ResourceUpdatedNotification] -> ShowS
ResourceUpdatedNotification -> String
(Int -> ResourceUpdatedNotification -> ShowS)
-> (ResourceUpdatedNotification -> String)
-> ([ResourceUpdatedNotification] -> ShowS)
-> Show ResourceUpdatedNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResourceUpdatedNotification -> ShowS
showsPrec :: Int -> ResourceUpdatedNotification -> ShowS
$cshow :: ResourceUpdatedNotification -> String
show :: ResourceUpdatedNotification -> String
$cshowList :: [ResourceUpdatedNotification] -> ShowS
showList :: [ResourceUpdatedNotification] -> ShowS
Show, ResourceUpdatedNotification -> ResourceUpdatedNotification -> Bool
(ResourceUpdatedNotification
 -> ResourceUpdatedNotification -> Bool)
-> (ResourceUpdatedNotification
    -> ResourceUpdatedNotification -> Bool)
-> Eq ResourceUpdatedNotification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResourceUpdatedNotification -> ResourceUpdatedNotification -> Bool
== :: ResourceUpdatedNotification -> ResourceUpdatedNotification -> Bool
$c/= :: ResourceUpdatedNotification -> ResourceUpdatedNotification -> Bool
/= :: ResourceUpdatedNotification -> ResourceUpdatedNotification -> Bool
Eq, (forall x.
 ResourceUpdatedNotification -> Rep ResourceUpdatedNotification x)
-> (forall x.
    Rep ResourceUpdatedNotification x -> ResourceUpdatedNotification)
-> Generic ResourceUpdatedNotification
forall x.
Rep ResourceUpdatedNotification x -> ResourceUpdatedNotification
forall x.
ResourceUpdatedNotification -> Rep ResourceUpdatedNotification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ResourceUpdatedNotification -> Rep ResourceUpdatedNotification x
from :: forall x.
ResourceUpdatedNotification -> Rep ResourceUpdatedNotification x
$cto :: forall x.
Rep ResourceUpdatedNotification x -> ResourceUpdatedNotification
to :: forall x.
Rep ResourceUpdatedNotification x -> ResourceUpdatedNotification
Generic)

instance ToJSON ResourceUpdatedNotification where
    toJSON :: ResourceUpdatedNotification -> Value
toJSON (ResourceUpdatedNotification Text
_ ResourceUpdatedParams
p) =
        [Pair] -> Value
object
            [ Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"notifications/resources/updated" :: Text)
            , Key
"params" Key -> ResourceUpdatedParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ResourceUpdatedParams
p
            ]

instance FromJSON ResourceUpdatedNotification where
    parseJSON :: Value -> Parser ResourceUpdatedNotification
parseJSON = String
-> (Object -> Parser ResourceUpdatedNotification)
-> Value
-> Parser ResourceUpdatedNotification
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ResourceUpdatedNotification" ((Object -> Parser ResourceUpdatedNotification)
 -> Value -> Parser ResourceUpdatedNotification)
-> (Object -> Parser ResourceUpdatedNotification)
-> Value
-> Parser ResourceUpdatedNotification
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"notifications/resources/updated" :: Text)
            then Text -> ResourceUpdatedParams -> ResourceUpdatedNotification
ResourceUpdatedNotification Text
m (ResourceUpdatedParams -> ResourceUpdatedNotification)
-> Parser ResourceUpdatedParams
-> Parser ResourceUpdatedNotification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ResourceUpdatedParams
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
            else String -> Parser ResourceUpdatedNotification
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'notifications/resources/updated'"

-- | Prompt list changed notification
data PromptListChangedNotification = PromptListChangedNotification
    { PromptListChangedNotification -> Text
method :: Text -- Always "notifications/prompts/list_changed"
    , PromptListChangedNotification -> Maybe InitializedParams
params :: Maybe InitializedParams
    }
    deriving stock (Int -> PromptListChangedNotification -> ShowS
[PromptListChangedNotification] -> ShowS
PromptListChangedNotification -> String
(Int -> PromptListChangedNotification -> ShowS)
-> (PromptListChangedNotification -> String)
-> ([PromptListChangedNotification] -> ShowS)
-> Show PromptListChangedNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PromptListChangedNotification -> ShowS
showsPrec :: Int -> PromptListChangedNotification -> ShowS
$cshow :: PromptListChangedNotification -> String
show :: PromptListChangedNotification -> String
$cshowList :: [PromptListChangedNotification] -> ShowS
showList :: [PromptListChangedNotification] -> ShowS
Show, PromptListChangedNotification
-> PromptListChangedNotification -> Bool
(PromptListChangedNotification
 -> PromptListChangedNotification -> Bool)
-> (PromptListChangedNotification
    -> PromptListChangedNotification -> Bool)
-> Eq PromptListChangedNotification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PromptListChangedNotification
-> PromptListChangedNotification -> Bool
== :: PromptListChangedNotification
-> PromptListChangedNotification -> Bool
$c/= :: PromptListChangedNotification
-> PromptListChangedNotification -> Bool
/= :: PromptListChangedNotification
-> PromptListChangedNotification -> Bool
Eq, (forall x.
 PromptListChangedNotification
 -> Rep PromptListChangedNotification x)
-> (forall x.
    Rep PromptListChangedNotification x
    -> PromptListChangedNotification)
-> Generic PromptListChangedNotification
forall x.
Rep PromptListChangedNotification x
-> PromptListChangedNotification
forall x.
PromptListChangedNotification
-> Rep PromptListChangedNotification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
PromptListChangedNotification
-> Rep PromptListChangedNotification x
from :: forall x.
PromptListChangedNotification
-> Rep PromptListChangedNotification x
$cto :: forall x.
Rep PromptListChangedNotification x
-> PromptListChangedNotification
to :: forall x.
Rep PromptListChangedNotification x
-> PromptListChangedNotification
Generic)

instance ToJSON PromptListChangedNotification where
    toJSON :: PromptListChangedNotification -> Value
toJSON (PromptListChangedNotification Text
_ Maybe InitializedParams
p) =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
            (Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"notifications/prompts/list_changed" :: Text)) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
-> (InitializedParams -> [Pair])
-> Maybe InitializedParams
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\InitializedParams
pr -> [Key
"params" Key -> InitializedParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= InitializedParams
pr]) Maybe InitializedParams
p

instance FromJSON PromptListChangedNotification where
    parseJSON :: Value -> Parser PromptListChangedNotification
parseJSON = String
-> (Object -> Parser PromptListChangedNotification)
-> Value
-> Parser PromptListChangedNotification
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PromptListChangedNotification" ((Object -> Parser PromptListChangedNotification)
 -> Value -> Parser PromptListChangedNotification)
-> (Object -> Parser PromptListChangedNotification)
-> Value
-> Parser PromptListChangedNotification
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"notifications/prompts/list_changed" :: Text)
            then Text -> Maybe InitializedParams -> PromptListChangedNotification
PromptListChangedNotification Text
m (Maybe InitializedParams -> PromptListChangedNotification)
-> Parser (Maybe InitializedParams)
-> Parser PromptListChangedNotification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe InitializedParams)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params"
            else String -> Parser PromptListChangedNotification
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'notifications/prompts/list_changed'"

-- | Tool list changed notification
data ToolListChangedNotification = ToolListChangedNotification
    { ToolListChangedNotification -> Text
method :: Text -- Always "notifications/tools/list_changed"
    , ToolListChangedNotification -> Maybe InitializedParams
params :: Maybe InitializedParams
    }
    deriving stock (Int -> ToolListChangedNotification -> ShowS
[ToolListChangedNotification] -> ShowS
ToolListChangedNotification -> String
(Int -> ToolListChangedNotification -> ShowS)
-> (ToolListChangedNotification -> String)
-> ([ToolListChangedNotification] -> ShowS)
-> Show ToolListChangedNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ToolListChangedNotification -> ShowS
showsPrec :: Int -> ToolListChangedNotification -> ShowS
$cshow :: ToolListChangedNotification -> String
show :: ToolListChangedNotification -> String
$cshowList :: [ToolListChangedNotification] -> ShowS
showList :: [ToolListChangedNotification] -> ShowS
Show, ToolListChangedNotification -> ToolListChangedNotification -> Bool
(ToolListChangedNotification
 -> ToolListChangedNotification -> Bool)
-> (ToolListChangedNotification
    -> ToolListChangedNotification -> Bool)
-> Eq ToolListChangedNotification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ToolListChangedNotification -> ToolListChangedNotification -> Bool
== :: ToolListChangedNotification -> ToolListChangedNotification -> Bool
$c/= :: ToolListChangedNotification -> ToolListChangedNotification -> Bool
/= :: ToolListChangedNotification -> ToolListChangedNotification -> Bool
Eq, (forall x.
 ToolListChangedNotification -> Rep ToolListChangedNotification x)
-> (forall x.
    Rep ToolListChangedNotification x -> ToolListChangedNotification)
-> Generic ToolListChangedNotification
forall x.
Rep ToolListChangedNotification x -> ToolListChangedNotification
forall x.
ToolListChangedNotification -> Rep ToolListChangedNotification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ToolListChangedNotification -> Rep ToolListChangedNotification x
from :: forall x.
ToolListChangedNotification -> Rep ToolListChangedNotification x
$cto :: forall x.
Rep ToolListChangedNotification x -> ToolListChangedNotification
to :: forall x.
Rep ToolListChangedNotification x -> ToolListChangedNotification
Generic)

instance ToJSON ToolListChangedNotification where
    toJSON :: ToolListChangedNotification -> Value
toJSON (ToolListChangedNotification Text
_ Maybe InitializedParams
p) =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
            (Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"notifications/tools/list_changed" :: Text)) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
-> (InitializedParams -> [Pair])
-> Maybe InitializedParams
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\InitializedParams
pr -> [Key
"params" Key -> InitializedParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= InitializedParams
pr]) Maybe InitializedParams
p

instance FromJSON ToolListChangedNotification where
    parseJSON :: Value -> Parser ToolListChangedNotification
parseJSON = String
-> (Object -> Parser ToolListChangedNotification)
-> Value
-> Parser ToolListChangedNotification
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ToolListChangedNotification" ((Object -> Parser ToolListChangedNotification)
 -> Value -> Parser ToolListChangedNotification)
-> (Object -> Parser ToolListChangedNotification)
-> Value
-> Parser ToolListChangedNotification
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"notifications/tools/list_changed" :: Text)
            then Text -> Maybe InitializedParams -> ToolListChangedNotification
ToolListChangedNotification Text
m (Maybe InitializedParams -> ToolListChangedNotification)
-> Parser (Maybe InitializedParams)
-> Parser ToolListChangedNotification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe InitializedParams)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params"
            else String -> Parser ToolListChangedNotification
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'notifications/tools/list_changed'"

-- | Logging message notification parameters
data LoggingMessageParams = LoggingMessageParams
    { LoggingMessageParams -> LoggingLevel
level :: LoggingLevel
    , LoggingMessageParams -> Value
data' :: Value -- Can be any JSON value
    , LoggingMessageParams -> Maybe Text
logger :: Maybe Text
    }
    deriving stock (Int -> LoggingMessageParams -> ShowS
[LoggingMessageParams] -> ShowS
LoggingMessageParams -> String
(Int -> LoggingMessageParams -> ShowS)
-> (LoggingMessageParams -> String)
-> ([LoggingMessageParams] -> ShowS)
-> Show LoggingMessageParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LoggingMessageParams -> ShowS
showsPrec :: Int -> LoggingMessageParams -> ShowS
$cshow :: LoggingMessageParams -> String
show :: LoggingMessageParams -> String
$cshowList :: [LoggingMessageParams] -> ShowS
showList :: [LoggingMessageParams] -> ShowS
Show, LoggingMessageParams -> LoggingMessageParams -> Bool
(LoggingMessageParams -> LoggingMessageParams -> Bool)
-> (LoggingMessageParams -> LoggingMessageParams -> Bool)
-> Eq LoggingMessageParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LoggingMessageParams -> LoggingMessageParams -> Bool
== :: LoggingMessageParams -> LoggingMessageParams -> Bool
$c/= :: LoggingMessageParams -> LoggingMessageParams -> Bool
/= :: LoggingMessageParams -> LoggingMessageParams -> Bool
Eq, (forall x. LoggingMessageParams -> Rep LoggingMessageParams x)
-> (forall x. Rep LoggingMessageParams x -> LoggingMessageParams)
-> Generic LoggingMessageParams
forall x. Rep LoggingMessageParams x -> LoggingMessageParams
forall x. LoggingMessageParams -> Rep LoggingMessageParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LoggingMessageParams -> Rep LoggingMessageParams x
from :: forall x. LoggingMessageParams -> Rep LoggingMessageParams x
$cto :: forall x. Rep LoggingMessageParams x -> LoggingMessageParams
to :: forall x. Rep LoggingMessageParams x -> LoggingMessageParams
Generic)

instance ToJSON LoggingMessageParams where
    toJSON :: LoggingMessageParams -> Value
toJSON (LoggingMessageParams LoggingLevel
lvl Value
d Maybe Text
lgr) =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
            [ Key
"level" Key -> LoggingLevel -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= LoggingLevel
lvl
            , Key
"data" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
d
            ]
                [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Text -> [Pair]) -> Maybe Text -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
l -> [Key
"logger" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
l]) Maybe Text
lgr

instance FromJSON LoggingMessageParams where
    parseJSON :: Value -> Parser LoggingMessageParams
parseJSON = String
-> (Object -> Parser LoggingMessageParams)
-> Value
-> Parser LoggingMessageParams
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LoggingMessageParams" ((Object -> Parser LoggingMessageParams)
 -> Value -> Parser LoggingMessageParams)
-> (Object -> Parser LoggingMessageParams)
-> Value
-> Parser LoggingMessageParams
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        LoggingLevel -> Value -> Maybe Text -> LoggingMessageParams
LoggingMessageParams (LoggingLevel -> Value -> Maybe Text -> LoggingMessageParams)
-> Parser LoggingLevel
-> Parser (Value -> Maybe Text -> LoggingMessageParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser LoggingLevel
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"level" Parser (Value -> Maybe Text -> LoggingMessageParams)
-> Parser Value -> Parser (Maybe Text -> LoggingMessageParams)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data" Parser (Maybe Text -> LoggingMessageParams)
-> Parser (Maybe Text) -> Parser LoggingMessageParams
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"logger"

-- | Logging message notification
data LoggingMessageNotification = LoggingMessageNotification
    { LoggingMessageNotification -> Text
method :: Text -- Always "notifications/message"
    , LoggingMessageNotification -> LoggingMessageParams
params :: LoggingMessageParams
    }
    deriving stock (Int -> LoggingMessageNotification -> ShowS
[LoggingMessageNotification] -> ShowS
LoggingMessageNotification -> String
(Int -> LoggingMessageNotification -> ShowS)
-> (LoggingMessageNotification -> String)
-> ([LoggingMessageNotification] -> ShowS)
-> Show LoggingMessageNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LoggingMessageNotification -> ShowS
showsPrec :: Int -> LoggingMessageNotification -> ShowS
$cshow :: LoggingMessageNotification -> String
show :: LoggingMessageNotification -> String
$cshowList :: [LoggingMessageNotification] -> ShowS
showList :: [LoggingMessageNotification] -> ShowS
Show, LoggingMessageNotification -> LoggingMessageNotification -> Bool
(LoggingMessageNotification -> LoggingMessageNotification -> Bool)
-> (LoggingMessageNotification
    -> LoggingMessageNotification -> Bool)
-> Eq LoggingMessageNotification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LoggingMessageNotification -> LoggingMessageNotification -> Bool
== :: LoggingMessageNotification -> LoggingMessageNotification -> Bool
$c/= :: LoggingMessageNotification -> LoggingMessageNotification -> Bool
/= :: LoggingMessageNotification -> LoggingMessageNotification -> Bool
Eq, (forall x.
 LoggingMessageNotification -> Rep LoggingMessageNotification x)
-> (forall x.
    Rep LoggingMessageNotification x -> LoggingMessageNotification)
-> Generic LoggingMessageNotification
forall x.
Rep LoggingMessageNotification x -> LoggingMessageNotification
forall x.
LoggingMessageNotification -> Rep LoggingMessageNotification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
LoggingMessageNotification -> Rep LoggingMessageNotification x
from :: forall x.
LoggingMessageNotification -> Rep LoggingMessageNotification x
$cto :: forall x.
Rep LoggingMessageNotification x -> LoggingMessageNotification
to :: forall x.
Rep LoggingMessageNotification x -> LoggingMessageNotification
Generic)

instance ToJSON LoggingMessageNotification where
    toJSON :: LoggingMessageNotification -> Value
toJSON (LoggingMessageNotification Text
_ LoggingMessageParams
p) =
        [Pair] -> Value
object
            [ Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"notifications/message" :: Text)
            , Key
"params" Key -> LoggingMessageParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= LoggingMessageParams
p
            ]

instance FromJSON LoggingMessageNotification where
    parseJSON :: Value -> Parser LoggingMessageNotification
parseJSON = String
-> (Object -> Parser LoggingMessageNotification)
-> Value
-> Parser LoggingMessageNotification
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LoggingMessageNotification" ((Object -> Parser LoggingMessageNotification)
 -> Value -> Parser LoggingMessageNotification)
-> (Object -> Parser LoggingMessageNotification)
-> Value
-> Parser LoggingMessageNotification
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"notifications/message" :: Text)
            then Text -> LoggingMessageParams -> LoggingMessageNotification
LoggingMessageNotification Text
m (LoggingMessageParams -> LoggingMessageNotification)
-> Parser LoggingMessageParams -> Parser LoggingMessageNotification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser LoggingMessageParams
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
            else String -> Parser LoggingMessageNotification
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'notifications/message'"

-- | Roots list changed notification
data RootsListChangedNotification = RootsListChangedNotification
    { RootsListChangedNotification -> Text
method :: Text -- Always "notifications/roots/list_changed"
    , RootsListChangedNotification -> Maybe InitializedParams
params :: Maybe InitializedParams
    }
    deriving stock (Int -> RootsListChangedNotification -> ShowS
[RootsListChangedNotification] -> ShowS
RootsListChangedNotification -> String
(Int -> RootsListChangedNotification -> ShowS)
-> (RootsListChangedNotification -> String)
-> ([RootsListChangedNotification] -> ShowS)
-> Show RootsListChangedNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RootsListChangedNotification -> ShowS
showsPrec :: Int -> RootsListChangedNotification -> ShowS
$cshow :: RootsListChangedNotification -> String
show :: RootsListChangedNotification -> String
$cshowList :: [RootsListChangedNotification] -> ShowS
showList :: [RootsListChangedNotification] -> ShowS
Show, RootsListChangedNotification
-> RootsListChangedNotification -> Bool
(RootsListChangedNotification
 -> RootsListChangedNotification -> Bool)
-> (RootsListChangedNotification
    -> RootsListChangedNotification -> Bool)
-> Eq RootsListChangedNotification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RootsListChangedNotification
-> RootsListChangedNotification -> Bool
== :: RootsListChangedNotification
-> RootsListChangedNotification -> Bool
$c/= :: RootsListChangedNotification
-> RootsListChangedNotification -> Bool
/= :: RootsListChangedNotification
-> RootsListChangedNotification -> Bool
Eq, (forall x.
 RootsListChangedNotification -> Rep RootsListChangedNotification x)
-> (forall x.
    Rep RootsListChangedNotification x -> RootsListChangedNotification)
-> Generic RootsListChangedNotification
forall x.
Rep RootsListChangedNotification x -> RootsListChangedNotification
forall x.
RootsListChangedNotification -> Rep RootsListChangedNotification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RootsListChangedNotification -> Rep RootsListChangedNotification x
from :: forall x.
RootsListChangedNotification -> Rep RootsListChangedNotification x
$cto :: forall x.
Rep RootsListChangedNotification x -> RootsListChangedNotification
to :: forall x.
Rep RootsListChangedNotification x -> RootsListChangedNotification
Generic)

instance ToJSON RootsListChangedNotification where
    toJSON :: RootsListChangedNotification -> Value
toJSON (RootsListChangedNotification Text
_ Maybe InitializedParams
p) =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
            (Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"notifications/roots/list_changed" :: Text)) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
-> (InitializedParams -> [Pair])
-> Maybe InitializedParams
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\InitializedParams
pr -> [Key
"params" Key -> InitializedParams -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= InitializedParams
pr]) Maybe InitializedParams
p

instance FromJSON RootsListChangedNotification where
    parseJSON :: Value -> Parser RootsListChangedNotification
parseJSON = String
-> (Object -> Parser RootsListChangedNotification)
-> Value
-> Parser RootsListChangedNotification
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RootsListChangedNotification" ((Object -> Parser RootsListChangedNotification)
 -> Value -> Parser RootsListChangedNotification)
-> (Object -> Parser RootsListChangedNotification)
-> Value
-> Parser RootsListChangedNotification
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
m <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
        if Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"notifications/roots/list_changed" :: Text)
            then Text -> Maybe InitializedParams -> RootsListChangedNotification
RootsListChangedNotification Text
m (Maybe InitializedParams -> RootsListChangedNotification)
-> Parser (Maybe InitializedParams)
-> Parser RootsListChangedNotification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe InitializedParams)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params"
            else String -> Parser RootsListChangedNotification
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected method 'notifications/roots/list_changed'"

-- * Union Types

-- | Any client request
data ClientRequest
    = InitializeReq InitializeRequest
    | PingReq PingRequest
    | ListResourcesReq ListResourcesRequest
    | ListResourceTemplatesReq ListResourceTemplatesRequest
    | ReadResourceReq ReadResourceRequest
    | SubscribeReq SubscribeRequest
    | UnsubscribeReq UnsubscribeRequest
    | ListPromptsReq ListPromptsRequest
    | GetPromptReq GetPromptRequest
    | ListToolsReq ListToolsRequest
    | CallToolReq CallToolRequest
    | SetLevelReq SetLevelRequest
    | CompleteReq CompleteRequest
    deriving stock (Int -> ClientRequest -> ShowS
[ClientRequest] -> ShowS
ClientRequest -> String
(Int -> ClientRequest -> ShowS)
-> (ClientRequest -> String)
-> ([ClientRequest] -> ShowS)
-> Show ClientRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClientRequest -> ShowS
showsPrec :: Int -> ClientRequest -> ShowS
$cshow :: ClientRequest -> String
show :: ClientRequest -> String
$cshowList :: [ClientRequest] -> ShowS
showList :: [ClientRequest] -> ShowS
Show, ClientRequest -> ClientRequest -> Bool
(ClientRequest -> ClientRequest -> Bool)
-> (ClientRequest -> ClientRequest -> Bool) -> Eq ClientRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClientRequest -> ClientRequest -> Bool
== :: ClientRequest -> ClientRequest -> Bool
$c/= :: ClientRequest -> ClientRequest -> Bool
/= :: ClientRequest -> ClientRequest -> Bool
Eq, (forall x. ClientRequest -> Rep ClientRequest x)
-> (forall x. Rep ClientRequest x -> ClientRequest)
-> Generic ClientRequest
forall x. Rep ClientRequest x -> ClientRequest
forall x. ClientRequest -> Rep ClientRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClientRequest -> Rep ClientRequest x
from :: forall x. ClientRequest -> Rep ClientRequest x
$cto :: forall x. Rep ClientRequest x -> ClientRequest
to :: forall x. Rep ClientRequest x -> ClientRequest
Generic)

instance ToJSON ClientRequest where
    toJSON :: ClientRequest -> Value
toJSON (InitializeReq InitializeRequest
r) = InitializeRequest -> Value
forall a. ToJSON a => a -> Value
toJSON InitializeRequest
r
    toJSON (PingReq PingRequest
r) = PingRequest -> Value
forall a. ToJSON a => a -> Value
toJSON PingRequest
r
    toJSON (ListResourcesReq ListResourcesRequest
r) = ListResourcesRequest -> Value
forall a. ToJSON a => a -> Value
toJSON ListResourcesRequest
r
    toJSON (ListResourceTemplatesReq ListResourceTemplatesRequest
r) = ListResourceTemplatesRequest -> Value
forall a. ToJSON a => a -> Value
toJSON ListResourceTemplatesRequest
r
    toJSON (ReadResourceReq ReadResourceRequest
r) = ReadResourceRequest -> Value
forall a. ToJSON a => a -> Value
toJSON ReadResourceRequest
r
    toJSON (SubscribeReq SubscribeRequest
r) = SubscribeRequest -> Value
forall a. ToJSON a => a -> Value
toJSON SubscribeRequest
r
    toJSON (UnsubscribeReq UnsubscribeRequest
r) = UnsubscribeRequest -> Value
forall a. ToJSON a => a -> Value
toJSON UnsubscribeRequest
r
    toJSON (ListPromptsReq ListPromptsRequest
r) = ListPromptsRequest -> Value
forall a. ToJSON a => a -> Value
toJSON ListPromptsRequest
r
    toJSON (GetPromptReq GetPromptRequest
r) = GetPromptRequest -> Value
forall a. ToJSON a => a -> Value
toJSON GetPromptRequest
r
    toJSON (ListToolsReq ListToolsRequest
r) = ListToolsRequest -> Value
forall a. ToJSON a => a -> Value
toJSON ListToolsRequest
r
    toJSON (CallToolReq CallToolRequest
r) = CallToolRequest -> Value
forall a. ToJSON a => a -> Value
toJSON CallToolRequest
r
    toJSON (SetLevelReq SetLevelRequest
r) = SetLevelRequest -> Value
forall a. ToJSON a => a -> Value
toJSON SetLevelRequest
r
    toJSON (CompleteReq CompleteRequest
r) = CompleteRequest -> Value
forall a. ToJSON a => a -> Value
toJSON CompleteRequest
r

instance FromJSON ClientRequest where
    parseJSON :: Value -> Parser ClientRequest
parseJSON Value
v =
        (InitializeRequest -> ClientRequest
InitializeReq (InitializeRequest -> ClientRequest)
-> Parser InitializeRequest -> Parser ClientRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser InitializeRequest
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ClientRequest
-> Parser ClientRequest -> Parser ClientRequest
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (PingRequest -> ClientRequest
PingReq (PingRequest -> ClientRequest)
-> Parser PingRequest -> Parser ClientRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser PingRequest
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ClientRequest
-> Parser ClientRequest -> Parser ClientRequest
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ListResourcesRequest -> ClientRequest
ListResourcesReq (ListResourcesRequest -> ClientRequest)
-> Parser ListResourcesRequest -> Parser ClientRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ListResourcesRequest
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ClientRequest
-> Parser ClientRequest -> Parser ClientRequest
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ListResourceTemplatesRequest -> ClientRequest
ListResourceTemplatesReq (ListResourceTemplatesRequest -> ClientRequest)
-> Parser ListResourceTemplatesRequest -> Parser ClientRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ListResourceTemplatesRequest
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ClientRequest
-> Parser ClientRequest -> Parser ClientRequest
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ReadResourceRequest -> ClientRequest
ReadResourceReq (ReadResourceRequest -> ClientRequest)
-> Parser ReadResourceRequest -> Parser ClientRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ReadResourceRequest
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ClientRequest
-> Parser ClientRequest -> Parser ClientRequest
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (SubscribeRequest -> ClientRequest
SubscribeReq (SubscribeRequest -> ClientRequest)
-> Parser SubscribeRequest -> Parser ClientRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser SubscribeRequest
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ClientRequest
-> Parser ClientRequest -> Parser ClientRequest
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (UnsubscribeRequest -> ClientRequest
UnsubscribeReq (UnsubscribeRequest -> ClientRequest)
-> Parser UnsubscribeRequest -> Parser ClientRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser UnsubscribeRequest
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ClientRequest
-> Parser ClientRequest -> Parser ClientRequest
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ListPromptsRequest -> ClientRequest
ListPromptsReq (ListPromptsRequest -> ClientRequest)
-> Parser ListPromptsRequest -> Parser ClientRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ListPromptsRequest
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ClientRequest
-> Parser ClientRequest -> Parser ClientRequest
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (GetPromptRequest -> ClientRequest
GetPromptReq (GetPromptRequest -> ClientRequest)
-> Parser GetPromptRequest -> Parser ClientRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser GetPromptRequest
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ClientRequest
-> Parser ClientRequest -> Parser ClientRequest
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ListToolsRequest -> ClientRequest
ListToolsReq (ListToolsRequest -> ClientRequest)
-> Parser ListToolsRequest -> Parser ClientRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ListToolsRequest
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ClientRequest
-> Parser ClientRequest -> Parser ClientRequest
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CallToolRequest -> ClientRequest
CallToolReq (CallToolRequest -> ClientRequest)
-> Parser CallToolRequest -> Parser ClientRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser CallToolRequest
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ClientRequest
-> Parser ClientRequest -> Parser ClientRequest
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (SetLevelRequest -> ClientRequest
SetLevelReq (SetLevelRequest -> ClientRequest)
-> Parser SetLevelRequest -> Parser ClientRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser SetLevelRequest
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ClientRequest
-> Parser ClientRequest -> Parser ClientRequest
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CompleteRequest -> ClientRequest
CompleteReq (CompleteRequest -> ClientRequest)
-> Parser CompleteRequest -> Parser ClientRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser CompleteRequest
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)

-- | Any server request
data ServerRequest
    = PingServerReq PingRequest
    | CreateMessageReq CreateMessageRequest
    | ListRootsReq ListRootsRequest
    | ElicitReq ElicitRequest
    deriving stock (Int -> ServerRequest -> ShowS
[ServerRequest] -> ShowS
ServerRequest -> String
(Int -> ServerRequest -> ShowS)
-> (ServerRequest -> String)
-> ([ServerRequest] -> ShowS)
-> Show ServerRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerRequest -> ShowS
showsPrec :: Int -> ServerRequest -> ShowS
$cshow :: ServerRequest -> String
show :: ServerRequest -> String
$cshowList :: [ServerRequest] -> ShowS
showList :: [ServerRequest] -> ShowS
Show, ServerRequest -> ServerRequest -> Bool
(ServerRequest -> ServerRequest -> Bool)
-> (ServerRequest -> ServerRequest -> Bool) -> Eq ServerRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerRequest -> ServerRequest -> Bool
== :: ServerRequest -> ServerRequest -> Bool
$c/= :: ServerRequest -> ServerRequest -> Bool
/= :: ServerRequest -> ServerRequest -> Bool
Eq, (forall x. ServerRequest -> Rep ServerRequest x)
-> (forall x. Rep ServerRequest x -> ServerRequest)
-> Generic ServerRequest
forall x. Rep ServerRequest x -> ServerRequest
forall x. ServerRequest -> Rep ServerRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ServerRequest -> Rep ServerRequest x
from :: forall x. ServerRequest -> Rep ServerRequest x
$cto :: forall x. Rep ServerRequest x -> ServerRequest
to :: forall x. Rep ServerRequest x -> ServerRequest
Generic)

instance ToJSON ServerRequest where
    toJSON :: ServerRequest -> Value
toJSON (PingServerReq PingRequest
r) = PingRequest -> Value
forall a. ToJSON a => a -> Value
toJSON PingRequest
r
    toJSON (CreateMessageReq CreateMessageRequest
r) = CreateMessageRequest -> Value
forall a. ToJSON a => a -> Value
toJSON CreateMessageRequest
r
    toJSON (ListRootsReq ListRootsRequest
r) = ListRootsRequest -> Value
forall a. ToJSON a => a -> Value
toJSON ListRootsRequest
r
    toJSON (ElicitReq ElicitRequest
r) = ElicitRequest -> Value
forall a. ToJSON a => a -> Value
toJSON ElicitRequest
r

instance FromJSON ServerRequest where
    parseJSON :: Value -> Parser ServerRequest
parseJSON Value
v =
        (PingRequest -> ServerRequest
PingServerReq (PingRequest -> ServerRequest)
-> Parser PingRequest -> Parser ServerRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser PingRequest
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ServerRequest
-> Parser ServerRequest -> Parser ServerRequest
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CreateMessageRequest -> ServerRequest
CreateMessageReq (CreateMessageRequest -> ServerRequest)
-> Parser CreateMessageRequest -> Parser ServerRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser CreateMessageRequest
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ServerRequest
-> Parser ServerRequest -> Parser ServerRequest
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ListRootsRequest -> ServerRequest
ListRootsReq (ListRootsRequest -> ServerRequest)
-> Parser ListRootsRequest -> Parser ServerRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ListRootsRequest
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ServerRequest
-> Parser ServerRequest -> Parser ServerRequest
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ElicitRequest -> ServerRequest
ElicitReq (ElicitRequest -> ServerRequest)
-> Parser ElicitRequest -> Parser ServerRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ElicitRequest
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)

-- | Any client notification
data ClientNotification
    = CancelledNotif CancelledNotification
    | InitializedNotif InitializedNotification
    | ProgressNotif ProgressNotification
    | RootsListChangedNotif RootsListChangedNotification
    deriving stock (Int -> ClientNotification -> ShowS
[ClientNotification] -> ShowS
ClientNotification -> String
(Int -> ClientNotification -> ShowS)
-> (ClientNotification -> String)
-> ([ClientNotification] -> ShowS)
-> Show ClientNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClientNotification -> ShowS
showsPrec :: Int -> ClientNotification -> ShowS
$cshow :: ClientNotification -> String
show :: ClientNotification -> String
$cshowList :: [ClientNotification] -> ShowS
showList :: [ClientNotification] -> ShowS
Show, ClientNotification -> ClientNotification -> Bool
(ClientNotification -> ClientNotification -> Bool)
-> (ClientNotification -> ClientNotification -> Bool)
-> Eq ClientNotification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClientNotification -> ClientNotification -> Bool
== :: ClientNotification -> ClientNotification -> Bool
$c/= :: ClientNotification -> ClientNotification -> Bool
/= :: ClientNotification -> ClientNotification -> Bool
Eq, (forall x. ClientNotification -> Rep ClientNotification x)
-> (forall x. Rep ClientNotification x -> ClientNotification)
-> Generic ClientNotification
forall x. Rep ClientNotification x -> ClientNotification
forall x. ClientNotification -> Rep ClientNotification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClientNotification -> Rep ClientNotification x
from :: forall x. ClientNotification -> Rep ClientNotification x
$cto :: forall x. Rep ClientNotification x -> ClientNotification
to :: forall x. Rep ClientNotification x -> ClientNotification
Generic)

instance ToJSON ClientNotification where
    toJSON :: ClientNotification -> Value
toJSON (CancelledNotif CancelledNotification
n) = CancelledNotification -> Value
forall a. ToJSON a => a -> Value
toJSON CancelledNotification
n
    toJSON (InitializedNotif InitializedNotification
n) = InitializedNotification -> Value
forall a. ToJSON a => a -> Value
toJSON InitializedNotification
n
    toJSON (ProgressNotif ProgressNotification
n) = ProgressNotification -> Value
forall a. ToJSON a => a -> Value
toJSON ProgressNotification
n
    toJSON (RootsListChangedNotif RootsListChangedNotification
n) = RootsListChangedNotification -> Value
forall a. ToJSON a => a -> Value
toJSON RootsListChangedNotification
n

instance FromJSON ClientNotification where
    parseJSON :: Value -> Parser ClientNotification
parseJSON Value
v =
        (CancelledNotification -> ClientNotification
CancelledNotif (CancelledNotification -> ClientNotification)
-> Parser CancelledNotification -> Parser ClientNotification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser CancelledNotification
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ClientNotification
-> Parser ClientNotification -> Parser ClientNotification
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (InitializedNotification -> ClientNotification
InitializedNotif (InitializedNotification -> ClientNotification)
-> Parser InitializedNotification -> Parser ClientNotification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser InitializedNotification
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ClientNotification
-> Parser ClientNotification -> Parser ClientNotification
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ProgressNotification -> ClientNotification
ProgressNotif (ProgressNotification -> ClientNotification)
-> Parser ProgressNotification -> Parser ClientNotification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ProgressNotification
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ClientNotification
-> Parser ClientNotification -> Parser ClientNotification
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (RootsListChangedNotification -> ClientNotification
RootsListChangedNotif (RootsListChangedNotification -> ClientNotification)
-> Parser RootsListChangedNotification -> Parser ClientNotification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser RootsListChangedNotification
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)

-- | Any server notification
data ServerNotification
    = CancelledServerNotif CancelledNotification
    | ProgressServerNotif ProgressNotification
    | ResourceListChangedNotif ResourceListChangedNotification
    | ResourceUpdatedNotif ResourceUpdatedNotification
    | PromptListChangedNotif PromptListChangedNotification
    | ToolListChangedNotif ToolListChangedNotification
    | LoggingMessageNotif LoggingMessageNotification
    deriving stock (Int -> ServerNotification -> ShowS
[ServerNotification] -> ShowS
ServerNotification -> String
(Int -> ServerNotification -> ShowS)
-> (ServerNotification -> String)
-> ([ServerNotification] -> ShowS)
-> Show ServerNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerNotification -> ShowS
showsPrec :: Int -> ServerNotification -> ShowS
$cshow :: ServerNotification -> String
show :: ServerNotification -> String
$cshowList :: [ServerNotification] -> ShowS
showList :: [ServerNotification] -> ShowS
Show, ServerNotification -> ServerNotification -> Bool
(ServerNotification -> ServerNotification -> Bool)
-> (ServerNotification -> ServerNotification -> Bool)
-> Eq ServerNotification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerNotification -> ServerNotification -> Bool
== :: ServerNotification -> ServerNotification -> Bool
$c/= :: ServerNotification -> ServerNotification -> Bool
/= :: ServerNotification -> ServerNotification -> Bool
Eq, (forall x. ServerNotification -> Rep ServerNotification x)
-> (forall x. Rep ServerNotification x -> ServerNotification)
-> Generic ServerNotification
forall x. Rep ServerNotification x -> ServerNotification
forall x. ServerNotification -> Rep ServerNotification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ServerNotification -> Rep ServerNotification x
from :: forall x. ServerNotification -> Rep ServerNotification x
$cto :: forall x. Rep ServerNotification x -> ServerNotification
to :: forall x. Rep ServerNotification x -> ServerNotification
Generic)

instance ToJSON ServerNotification where
    toJSON :: ServerNotification -> Value
toJSON (CancelledServerNotif CancelledNotification
n) = CancelledNotification -> Value
forall a. ToJSON a => a -> Value
toJSON CancelledNotification
n
    toJSON (ProgressServerNotif ProgressNotification
n) = ProgressNotification -> Value
forall a. ToJSON a => a -> Value
toJSON ProgressNotification
n
    toJSON (ResourceListChangedNotif ResourceListChangedNotification
n) = ResourceListChangedNotification -> Value
forall a. ToJSON a => a -> Value
toJSON ResourceListChangedNotification
n
    toJSON (ResourceUpdatedNotif ResourceUpdatedNotification
n) = ResourceUpdatedNotification -> Value
forall a. ToJSON a => a -> Value
toJSON ResourceUpdatedNotification
n
    toJSON (PromptListChangedNotif PromptListChangedNotification
n) = PromptListChangedNotification -> Value
forall a. ToJSON a => a -> Value
toJSON PromptListChangedNotification
n
    toJSON (ToolListChangedNotif ToolListChangedNotification
n) = ToolListChangedNotification -> Value
forall a. ToJSON a => a -> Value
toJSON ToolListChangedNotification
n
    toJSON (LoggingMessageNotif LoggingMessageNotification
n) = LoggingMessageNotification -> Value
forall a. ToJSON a => a -> Value
toJSON LoggingMessageNotification
n

instance FromJSON ServerNotification where
    parseJSON :: Value -> Parser ServerNotification
parseJSON Value
v =
        (CancelledNotification -> ServerNotification
CancelledServerNotif (CancelledNotification -> ServerNotification)
-> Parser CancelledNotification -> Parser ServerNotification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser CancelledNotification
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ServerNotification
-> Parser ServerNotification -> Parser ServerNotification
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ProgressNotification -> ServerNotification
ProgressServerNotif (ProgressNotification -> ServerNotification)
-> Parser ProgressNotification -> Parser ServerNotification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ProgressNotification
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ServerNotification
-> Parser ServerNotification -> Parser ServerNotification
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ResourceListChangedNotification -> ServerNotification
ResourceListChangedNotif (ResourceListChangedNotification -> ServerNotification)
-> Parser ResourceListChangedNotification
-> Parser ServerNotification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ResourceListChangedNotification
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ServerNotification
-> Parser ServerNotification -> Parser ServerNotification
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ResourceUpdatedNotification -> ServerNotification
ResourceUpdatedNotif (ResourceUpdatedNotification -> ServerNotification)
-> Parser ResourceUpdatedNotification -> Parser ServerNotification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ResourceUpdatedNotification
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ServerNotification
-> Parser ServerNotification -> Parser ServerNotification
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (PromptListChangedNotification -> ServerNotification
PromptListChangedNotif (PromptListChangedNotification -> ServerNotification)
-> Parser PromptListChangedNotification
-> Parser ServerNotification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser PromptListChangedNotification
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ServerNotification
-> Parser ServerNotification -> Parser ServerNotification
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ToolListChangedNotification -> ServerNotification
ToolListChangedNotif (ToolListChangedNotification -> ServerNotification)
-> Parser ToolListChangedNotification -> Parser ServerNotification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ToolListChangedNotification
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ServerNotification
-> Parser ServerNotification -> Parser ServerNotification
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (LoggingMessageNotification -> ServerNotification
LoggingMessageNotif (LoggingMessageNotification -> ServerNotification)
-> Parser LoggingMessageNotification -> Parser ServerNotification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser LoggingMessageNotification
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)