{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

{- |
Module      : MCP.Types
Description : Core types for the Model Context Protocol (MCP) version 2025-06-18
Copyright   : (C) 2025 Matthias Pall Gissurarson
License     : MIT
Maintainer  : mpg@mpg.is
Stability   : experimental
Portability : GHC

This module defines the core types used in the Model Context Protocol (MCP) version 2025-06-18,
including JSON-RPC message types, client/server capabilities, resources, tools, prompts,
content blocks, sampling messages, elicitation forms, and various request/response types.

Key features of the 2025-06-18 implementation:
- BaseMetadata interface with name/title distinction
- ContentBlock type supporting text, image, audio, embedded resources, and resource links
- Enhanced metadata with _meta fields and lastModified timestamps
- Restricted SamplingContent type for LLM sampling (text, image, audio only)
- Resource link support for referencing without embedding
- Comprehensive schema validation support for tools and elicitation
-}
module MCP.Types (
    -- * Constants
    mcpProtocolVersion,
    
    -- * Basic Types
    RequestId (..),
    Role (..),
    Cursor (..),
    ProgressToken (..),
    LoggingLevel (..),

    -- * Content Types
    Annotations (..),
    TextContent (..),
    ImageContent (..),
    AudioContent (..),
    EmbeddedResource (..),
    ResourceLink (..),
    ContentBlock (..),
    Content,

    -- * Resource Types
    ResourceContents (..),
    TextResourceContents (..),
    BlobResourceContents (..),
    Resource (..),
    ResourceTemplate (..),
    ResourceReference (..),
    ResourceTemplateReference (..),

    -- * Tool Types
    ToolAnnotations (..),
    Tool (..),
    InputSchema (..),

    -- * Prompt Types
    PromptArgument (..),
    Prompt (..),
    PromptMessage (..),
    PromptReference (..),

    -- * Model Types
    ModelHint (..),
    ModelPreferences (..),
    IncludeContext (..),
    SamplingContent (..),
    SamplingMessage (..),

    -- * Capability Types
    ClientCapabilities (..),
    ServerCapabilities (..),
    RootsCapability (..),
    PromptsCapability (..),
    ResourcesCapability (..),
    ToolsCapability (..),
    CompletionsCapability (..),
    LoggingCapability (..),
    SamplingCapability (..),
    ElicitationCapability (..),
    ExperimentalCapability (..),

    -- * Base Types
    BaseMetadata (..),
    
    -- * Implementation Info
    Implementation (..),

    -- * Roots
    Root (..),

    -- * Result Types
    Result (..),
    Metadata (..),
) where

import Control.Applicative (Alternative ((<|>)))
import Data.Aeson hiding (Error, Result)
import Data.Aeson.TH
import Data.Map (Map)
import Data.Text (Text)
import GHC.Generics

-- | The current MCP protocol version
mcpProtocolVersion :: Text
mcpProtocolVersion :: Text
mcpProtocolVersion = Text
"2025-06-18"

-- | Metadata for results and other types
newtype Metadata = Metadata (Map Text Value)
    deriving stock (Int -> Metadata -> ShowS
[Metadata] -> ShowS
Metadata -> String
(Int -> Metadata -> ShowS)
-> (Metadata -> String) -> ([Metadata] -> ShowS) -> Show Metadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Metadata -> ShowS
showsPrec :: Int -> Metadata -> ShowS
$cshow :: Metadata -> String
show :: Metadata -> String
$cshowList :: [Metadata] -> ShowS
showList :: [Metadata] -> ShowS
Show, Metadata -> Metadata -> Bool
(Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool) -> Eq Metadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Metadata -> Metadata -> Bool
== :: Metadata -> Metadata -> Bool
$c/= :: Metadata -> Metadata -> Bool
/= :: Metadata -> Metadata -> Bool
Eq, (forall x. Metadata -> Rep Metadata x)
-> (forall x. Rep Metadata x -> Metadata) -> Generic Metadata
forall x. Rep Metadata x -> Metadata
forall x. Metadata -> Rep Metadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Metadata -> Rep Metadata x
from :: forall x. Metadata -> Rep Metadata x
$cto :: forall x. Rep Metadata x -> Metadata
to :: forall x. Rep Metadata x -> Metadata
Generic)
    deriving newtype ([Metadata] -> Value
[Metadata] -> Encoding
Metadata -> Bool
Metadata -> Value
Metadata -> Encoding
(Metadata -> Value)
-> (Metadata -> Encoding)
-> ([Metadata] -> Value)
-> ([Metadata] -> Encoding)
-> (Metadata -> Bool)
-> ToJSON Metadata
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Metadata -> Value
toJSON :: Metadata -> Value
$ctoEncoding :: Metadata -> Encoding
toEncoding :: Metadata -> Encoding
$ctoJSONList :: [Metadata] -> Value
toJSONList :: [Metadata] -> Value
$ctoEncodingList :: [Metadata] -> Encoding
toEncodingList :: [Metadata] -> Encoding
$comitField :: Metadata -> Bool
omitField :: Metadata -> Bool
ToJSON, Maybe Metadata
Value -> Parser [Metadata]
Value -> Parser Metadata
(Value -> Parser Metadata)
-> (Value -> Parser [Metadata])
-> Maybe Metadata
-> FromJSON Metadata
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Metadata
parseJSON :: Value -> Parser Metadata
$cparseJSONList :: Value -> Parser [Metadata]
parseJSONList :: Value -> Parser [Metadata]
$comittedField :: Maybe Metadata
omittedField :: Maybe Metadata
FromJSON)

-- | A uniquely identifying ID for a request in JSON-RPC
newtype RequestId = RequestId Value
    deriving stock (Int -> RequestId -> ShowS
[RequestId] -> ShowS
RequestId -> String
(Int -> RequestId -> ShowS)
-> (RequestId -> String)
-> ([RequestId] -> ShowS)
-> Show RequestId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequestId -> ShowS
showsPrec :: Int -> RequestId -> ShowS
$cshow :: RequestId -> String
show :: RequestId -> String
$cshowList :: [RequestId] -> ShowS
showList :: [RequestId] -> ShowS
Show, RequestId -> RequestId -> Bool
(RequestId -> RequestId -> Bool)
-> (RequestId -> RequestId -> Bool) -> Eq RequestId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RequestId -> RequestId -> Bool
== :: RequestId -> RequestId -> Bool
$c/= :: RequestId -> RequestId -> Bool
/= :: RequestId -> RequestId -> Bool
Eq)
    deriving newtype ([RequestId] -> Value
[RequestId] -> Encoding
RequestId -> Bool
RequestId -> Value
RequestId -> Encoding
(RequestId -> Value)
-> (RequestId -> Encoding)
-> ([RequestId] -> Value)
-> ([RequestId] -> Encoding)
-> (RequestId -> Bool)
-> ToJSON RequestId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: RequestId -> Value
toJSON :: RequestId -> Value
$ctoEncoding :: RequestId -> Encoding
toEncoding :: RequestId -> Encoding
$ctoJSONList :: [RequestId] -> Value
toJSONList :: [RequestId] -> Value
$ctoEncodingList :: [RequestId] -> Encoding
toEncodingList :: [RequestId] -> Encoding
$comitField :: RequestId -> Bool
omitField :: RequestId -> Bool
ToJSON, Maybe RequestId
Value -> Parser [RequestId]
Value -> Parser RequestId
(Value -> Parser RequestId)
-> (Value -> Parser [RequestId])
-> Maybe RequestId
-> FromJSON RequestId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser RequestId
parseJSON :: Value -> Parser RequestId
$cparseJSONList :: Value -> Parser [RequestId]
parseJSONList :: Value -> Parser [RequestId]
$comittedField :: Maybe RequestId
omittedField :: Maybe RequestId
FromJSON)

-- | The sender or recipient of messages and data in a conversation
data Role = User | Assistant
    deriving stock (Int -> Role -> ShowS
[Role] -> ShowS
Role -> String
(Int -> Role -> ShowS)
-> (Role -> String) -> ([Role] -> ShowS) -> Show Role
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Role -> ShowS
showsPrec :: Int -> Role -> ShowS
$cshow :: Role -> String
show :: Role -> String
$cshowList :: [Role] -> ShowS
showList :: [Role] -> ShowS
Show, Role -> Role -> Bool
(Role -> Role -> Bool) -> (Role -> Role -> Bool) -> Eq Role
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Role -> Role -> Bool
== :: Role -> Role -> Bool
$c/= :: Role -> Role -> Bool
/= :: Role -> Role -> Bool
Eq, (forall x. Role -> Rep Role x)
-> (forall x. Rep Role x -> Role) -> Generic Role
forall x. Rep Role x -> Role
forall x. Role -> Rep Role x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Role -> Rep Role x
from :: forall x. Role -> Rep Role x
$cto :: forall x. Rep Role x -> Role
to :: forall x. Rep Role x -> Role
Generic)

instance ToJSON Role where
    toJSON :: Role -> Value
toJSON Role
User = Value
"user"
    toJSON Role
Assistant = Value
"assistant"

instance FromJSON Role where
    parseJSON :: Value -> Parser Role
parseJSON = String -> (Text -> Parser Role) -> Value -> Parser Role
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Role" ((Text -> Parser Role) -> Value -> Parser Role)
-> (Text -> Parser Role) -> Value -> Parser Role
forall a b. (a -> b) -> a -> b
$ \case
        Text
"user" -> Role -> Parser Role
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Role
User
        Text
"assistant" -> Role -> Parser Role
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Role
Assistant
        Text
other -> String -> Parser Role
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Role) -> String -> Parser Role
forall a b. (a -> b) -> a -> b
$ String
"Unknown role: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
other

-- | An opaque token used to represent a cursor for pagination
newtype Cursor = Cursor Text
    deriving stock (Int -> Cursor -> ShowS
[Cursor] -> ShowS
Cursor -> String
(Int -> Cursor -> ShowS)
-> (Cursor -> String) -> ([Cursor] -> ShowS) -> Show Cursor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cursor -> ShowS
showsPrec :: Int -> Cursor -> ShowS
$cshow :: Cursor -> String
show :: Cursor -> String
$cshowList :: [Cursor] -> ShowS
showList :: [Cursor] -> ShowS
Show, Cursor -> Cursor -> Bool
(Cursor -> Cursor -> Bool)
-> (Cursor -> Cursor -> Bool) -> Eq Cursor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cursor -> Cursor -> Bool
== :: Cursor -> Cursor -> Bool
$c/= :: Cursor -> Cursor -> Bool
/= :: Cursor -> Cursor -> Bool
Eq)
    deriving newtype ([Cursor] -> Value
[Cursor] -> Encoding
Cursor -> Bool
Cursor -> Value
Cursor -> Encoding
(Cursor -> Value)
-> (Cursor -> Encoding)
-> ([Cursor] -> Value)
-> ([Cursor] -> Encoding)
-> (Cursor -> Bool)
-> ToJSON Cursor
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Cursor -> Value
toJSON :: Cursor -> Value
$ctoEncoding :: Cursor -> Encoding
toEncoding :: Cursor -> Encoding
$ctoJSONList :: [Cursor] -> Value
toJSONList :: [Cursor] -> Value
$ctoEncodingList :: [Cursor] -> Encoding
toEncodingList :: [Cursor] -> Encoding
$comitField :: Cursor -> Bool
omitField :: Cursor -> Bool
ToJSON, Maybe Cursor
Value -> Parser [Cursor]
Value -> Parser Cursor
(Value -> Parser Cursor)
-> (Value -> Parser [Cursor]) -> Maybe Cursor -> FromJSON Cursor
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Cursor
parseJSON :: Value -> Parser Cursor
$cparseJSONList :: Value -> Parser [Cursor]
parseJSONList :: Value -> Parser [Cursor]
$comittedField :: Maybe Cursor
omittedField :: Maybe Cursor
FromJSON)

-- | A progress token, used to associate progress notifications with the original request
newtype ProgressToken = ProgressToken Value
    deriving stock (Int -> ProgressToken -> ShowS
[ProgressToken] -> ShowS
ProgressToken -> String
(Int -> ProgressToken -> ShowS)
-> (ProgressToken -> String)
-> ([ProgressToken] -> ShowS)
-> Show ProgressToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProgressToken -> ShowS
showsPrec :: Int -> ProgressToken -> ShowS
$cshow :: ProgressToken -> String
show :: ProgressToken -> String
$cshowList :: [ProgressToken] -> ShowS
showList :: [ProgressToken] -> ShowS
Show, ProgressToken -> ProgressToken -> Bool
(ProgressToken -> ProgressToken -> Bool)
-> (ProgressToken -> ProgressToken -> Bool) -> Eq ProgressToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProgressToken -> ProgressToken -> Bool
== :: ProgressToken -> ProgressToken -> Bool
$c/= :: ProgressToken -> ProgressToken -> Bool
/= :: ProgressToken -> ProgressToken -> Bool
Eq)
    deriving newtype ([ProgressToken] -> Value
[ProgressToken] -> Encoding
ProgressToken -> Bool
ProgressToken -> Value
ProgressToken -> Encoding
(ProgressToken -> Value)
-> (ProgressToken -> Encoding)
-> ([ProgressToken] -> Value)
-> ([ProgressToken] -> Encoding)
-> (ProgressToken -> Bool)
-> ToJSON ProgressToken
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ProgressToken -> Value
toJSON :: ProgressToken -> Value
$ctoEncoding :: ProgressToken -> Encoding
toEncoding :: ProgressToken -> Encoding
$ctoJSONList :: [ProgressToken] -> Value
toJSONList :: [ProgressToken] -> Value
$ctoEncodingList :: [ProgressToken] -> Encoding
toEncodingList :: [ProgressToken] -> Encoding
$comitField :: ProgressToken -> Bool
omitField :: ProgressToken -> Bool
ToJSON, Maybe ProgressToken
Value -> Parser [ProgressToken]
Value -> Parser ProgressToken
(Value -> Parser ProgressToken)
-> (Value -> Parser [ProgressToken])
-> Maybe ProgressToken
-> FromJSON ProgressToken
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ProgressToken
parseJSON :: Value -> Parser ProgressToken
$cparseJSONList :: Value -> Parser [ProgressToken]
parseJSONList :: Value -> Parser [ProgressToken]
$comittedField :: Maybe ProgressToken
omittedField :: Maybe ProgressToken
FromJSON)

-- | The severity of a log message
data LoggingLevel = Alert | Critical | Debug | Emergency | Error | Info | Notice | Warning
    deriving stock (Int -> LoggingLevel -> ShowS
[LoggingLevel] -> ShowS
LoggingLevel -> String
(Int -> LoggingLevel -> ShowS)
-> (LoggingLevel -> String)
-> ([LoggingLevel] -> ShowS)
-> Show LoggingLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LoggingLevel -> ShowS
showsPrec :: Int -> LoggingLevel -> ShowS
$cshow :: LoggingLevel -> String
show :: LoggingLevel -> String
$cshowList :: [LoggingLevel] -> ShowS
showList :: [LoggingLevel] -> ShowS
Show, LoggingLevel -> LoggingLevel -> Bool
(LoggingLevel -> LoggingLevel -> Bool)
-> (LoggingLevel -> LoggingLevel -> Bool) -> Eq LoggingLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LoggingLevel -> LoggingLevel -> Bool
== :: LoggingLevel -> LoggingLevel -> Bool
$c/= :: LoggingLevel -> LoggingLevel -> Bool
/= :: LoggingLevel -> LoggingLevel -> Bool
Eq, (forall x. LoggingLevel -> Rep LoggingLevel x)
-> (forall x. Rep LoggingLevel x -> LoggingLevel)
-> Generic LoggingLevel
forall x. Rep LoggingLevel x -> LoggingLevel
forall x. LoggingLevel -> Rep LoggingLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LoggingLevel -> Rep LoggingLevel x
from :: forall x. LoggingLevel -> Rep LoggingLevel x
$cto :: forall x. Rep LoggingLevel x -> LoggingLevel
to :: forall x. Rep LoggingLevel x -> LoggingLevel
Generic)

instance ToJSON LoggingLevel where
    toJSON :: LoggingLevel -> Value
toJSON LoggingLevel
Alert = Value
"alert"
    toJSON LoggingLevel
Critical = Value
"critical"
    toJSON LoggingLevel
Debug = Value
"debug"
    toJSON LoggingLevel
Emergency = Value
"emergency"
    toJSON LoggingLevel
Error = Value
"error"
    toJSON LoggingLevel
Info = Value
"info"
    toJSON LoggingLevel
Notice = Value
"notice"
    toJSON LoggingLevel
Warning = Value
"warning"

instance FromJSON LoggingLevel where
    parseJSON :: Value -> Parser LoggingLevel
parseJSON = String
-> (Text -> Parser LoggingLevel) -> Value -> Parser LoggingLevel
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"LoggingLevel" ((Text -> Parser LoggingLevel) -> Value -> Parser LoggingLevel)
-> (Text -> Parser LoggingLevel) -> Value -> Parser LoggingLevel
forall a b. (a -> b) -> a -> b
$ \case
        Text
"alert" -> LoggingLevel -> Parser LoggingLevel
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoggingLevel
Alert
        Text
"critical" -> LoggingLevel -> Parser LoggingLevel
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoggingLevel
Critical
        Text
"debug" -> LoggingLevel -> Parser LoggingLevel
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoggingLevel
Debug
        Text
"emergency" -> LoggingLevel -> Parser LoggingLevel
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoggingLevel
Emergency
        Text
"error" -> LoggingLevel -> Parser LoggingLevel
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoggingLevel
Error
        Text
"info" -> LoggingLevel -> Parser LoggingLevel
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoggingLevel
Info
        Text
"notice" -> LoggingLevel -> Parser LoggingLevel
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoggingLevel
Notice
        Text
"warning" -> LoggingLevel -> Parser LoggingLevel
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoggingLevel
Warning
        Text
other -> String -> Parser LoggingLevel
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser LoggingLevel) -> String -> Parser LoggingLevel
forall a b. (a -> b) -> a -> b
$ String
"Unknown logging level: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
other

-- | Base interface for metadata with name and optional title
data BaseMetadata = BaseMetadata
    { BaseMetadata -> Text
name :: Text
    , BaseMetadata -> Maybe Text
title :: Maybe Text
    }
    deriving stock (Int -> BaseMetadata -> ShowS
[BaseMetadata] -> ShowS
BaseMetadata -> String
(Int -> BaseMetadata -> ShowS)
-> (BaseMetadata -> String)
-> ([BaseMetadata] -> ShowS)
-> Show BaseMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BaseMetadata -> ShowS
showsPrec :: Int -> BaseMetadata -> ShowS
$cshow :: BaseMetadata -> String
show :: BaseMetadata -> String
$cshowList :: [BaseMetadata] -> ShowS
showList :: [BaseMetadata] -> ShowS
Show, BaseMetadata -> BaseMetadata -> Bool
(BaseMetadata -> BaseMetadata -> Bool)
-> (BaseMetadata -> BaseMetadata -> Bool) -> Eq BaseMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BaseMetadata -> BaseMetadata -> Bool
== :: BaseMetadata -> BaseMetadata -> Bool
$c/= :: BaseMetadata -> BaseMetadata -> Bool
/= :: BaseMetadata -> BaseMetadata -> Bool
Eq, (forall x. BaseMetadata -> Rep BaseMetadata x)
-> (forall x. Rep BaseMetadata x -> BaseMetadata)
-> Generic BaseMetadata
forall x. Rep BaseMetadata x -> BaseMetadata
forall x. BaseMetadata -> Rep BaseMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BaseMetadata -> Rep BaseMetadata x
from :: forall x. BaseMetadata -> Rep BaseMetadata x
$cto :: forall x. Rep BaseMetadata x -> BaseMetadata
to :: forall x. Rep BaseMetadata x -> BaseMetadata
Generic)

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

-- | Optional annotations for the client
data Annotations = Annotations
    { Annotations -> Maybe [Role]
audience :: Maybe [Role]
    , Annotations -> Maybe Double
priority :: Maybe Double -- 0.0 to 1.0
    , Annotations -> Maybe Text
lastModified :: Maybe Text -- ISO 8601 formatted timestamp
    }
    deriving stock (Int -> Annotations -> ShowS
[Annotations] -> ShowS
Annotations -> String
(Int -> Annotations -> ShowS)
-> (Annotations -> String)
-> ([Annotations] -> ShowS)
-> Show Annotations
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Annotations -> ShowS
showsPrec :: Int -> Annotations -> ShowS
$cshow :: Annotations -> String
show :: Annotations -> String
$cshowList :: [Annotations] -> ShowS
showList :: [Annotations] -> ShowS
Show, Annotations -> Annotations -> Bool
(Annotations -> Annotations -> Bool)
-> (Annotations -> Annotations -> Bool) -> Eq Annotations
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Annotations -> Annotations -> Bool
== :: Annotations -> Annotations -> Bool
$c/= :: Annotations -> Annotations -> Bool
/= :: Annotations -> Annotations -> Bool
Eq, (forall x. Annotations -> Rep Annotations x)
-> (forall x. Rep Annotations x -> Annotations)
-> Generic Annotations
forall x. Rep Annotations x -> Annotations
forall x. Annotations -> Rep Annotations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Annotations -> Rep Annotations x
from :: forall x. Annotations -> Rep Annotations x
$cto :: forall x. Rep Annotations x -> Annotations
to :: forall x. Rep Annotations x -> Annotations
Generic)

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

-- | Text provided to or from an LLM
data TextContent = TextContent
    { TextContent -> Text
textType :: Text -- Always "text"
    , TextContent -> Text
text :: Text
    , TextContent -> Maybe Annotations
annotations :: Maybe Annotations
    , TextContent -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> TextContent -> ShowS
[TextContent] -> ShowS
TextContent -> String
(Int -> TextContent -> ShowS)
-> (TextContent -> String)
-> ([TextContent] -> ShowS)
-> Show TextContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextContent -> ShowS
showsPrec :: Int -> TextContent -> ShowS
$cshow :: TextContent -> String
show :: TextContent -> String
$cshowList :: [TextContent] -> ShowS
showList :: [TextContent] -> ShowS
Show, TextContent -> TextContent -> Bool
(TextContent -> TextContent -> Bool)
-> (TextContent -> TextContent -> Bool) -> Eq TextContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextContent -> TextContent -> Bool
== :: TextContent -> TextContent -> Bool
$c/= :: TextContent -> TextContent -> Bool
/= :: TextContent -> TextContent -> Bool
Eq, (forall x. TextContent -> Rep TextContent x)
-> (forall x. Rep TextContent x -> TextContent)
-> Generic TextContent
forall x. Rep TextContent x -> TextContent
forall x. TextContent -> Rep TextContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TextContent -> Rep TextContent x
from :: forall x. TextContent -> Rep TextContent x
$cto :: forall x. Rep TextContent x -> TextContent
to :: forall x. Rep TextContent x -> TextContent
Generic)

instance ToJSON TextContent where
    toJSON :: TextContent -> Value
toJSON (TextContent Text
_ Text
txt Maybe Annotations
anns Maybe Metadata
meta) =
        [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
"text" :: Text)
            , Key
"text" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
txt
            ]
                [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Annotations -> [Pair]) -> Maybe Annotations -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Annotations
a -> [Key
"annotations" Key -> Annotations -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Annotations
a]) Maybe Annotations
anns
                [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Metadata -> [Pair]) -> Maybe Metadata -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Metadata
m -> [Key
"_meta" Key -> Metadata -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Metadata
m]) Maybe Metadata
meta

instance FromJSON TextContent where
    parseJSON :: Value -> Parser TextContent
parseJSON = String
-> (Object -> Parser TextContent) -> Value -> Parser TextContent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TextContent" ((Object -> Parser TextContent) -> Value -> Parser TextContent)
-> (Object -> Parser TextContent) -> Value -> Parser TextContent
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
"text" :: Text)
            then Text -> Text -> Maybe Annotations -> Maybe Metadata -> TextContent
TextContent Text
ty (Text -> Maybe Annotations -> Maybe Metadata -> TextContent)
-> Parser Text
-> Parser (Maybe Annotations -> Maybe Metadata -> TextContent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"text" Parser (Maybe Annotations -> Maybe Metadata -> TextContent)
-> Parser (Maybe Annotations)
-> Parser (Maybe Metadata -> TextContent)
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 Annotations)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"annotations" Parser (Maybe Metadata -> TextContent)
-> Parser (Maybe Metadata) -> Parser TextContent
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 Metadata)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"_meta"
            else String -> Parser TextContent
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected type 'text'"

-- | An image provided to or from an LLM
data ImageContent = ImageContent
    { ImageContent -> Text
imageType :: Text -- Always "image"
    , ImageContent -> Text
data' :: Text -- base64-encoded image data
    , ImageContent -> Text
mimeType :: Text
    , ImageContent -> Maybe Annotations
annotations :: Maybe Annotations
    , ImageContent -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> ImageContent -> ShowS
[ImageContent] -> ShowS
ImageContent -> String
(Int -> ImageContent -> ShowS)
-> (ImageContent -> String)
-> ([ImageContent] -> ShowS)
-> Show ImageContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImageContent -> ShowS
showsPrec :: Int -> ImageContent -> ShowS
$cshow :: ImageContent -> String
show :: ImageContent -> String
$cshowList :: [ImageContent] -> ShowS
showList :: [ImageContent] -> ShowS
Show, ImageContent -> ImageContent -> Bool
(ImageContent -> ImageContent -> Bool)
-> (ImageContent -> ImageContent -> Bool) -> Eq ImageContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImageContent -> ImageContent -> Bool
== :: ImageContent -> ImageContent -> Bool
$c/= :: ImageContent -> ImageContent -> Bool
/= :: ImageContent -> ImageContent -> Bool
Eq, (forall x. ImageContent -> Rep ImageContent x)
-> (forall x. Rep ImageContent x -> ImageContent)
-> Generic ImageContent
forall x. Rep ImageContent x -> ImageContent
forall x. ImageContent -> Rep ImageContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ImageContent -> Rep ImageContent x
from :: forall x. ImageContent -> Rep ImageContent x
$cto :: forall x. Rep ImageContent x -> ImageContent
to :: forall x. Rep ImageContent x -> ImageContent
Generic)

instance ToJSON ImageContent where
    toJSON :: ImageContent -> Value
toJSON (ImageContent Text
_ Text
dat Text
mime Maybe Annotations
anns Maybe Metadata
meta) =
        [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
"image" :: Text)
            , Key
"data" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
dat
            , Key
"mimeType" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
mime
            ]
                [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Annotations -> [Pair]) -> Maybe Annotations -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Annotations
a -> [Key
"annotations" Key -> Annotations -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Annotations
a]) Maybe Annotations
anns
                [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Metadata -> [Pair]) -> Maybe Metadata -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Metadata
m -> [Key
"_meta" Key -> Metadata -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Metadata
m]) Maybe Metadata
meta

instance FromJSON ImageContent where
    parseJSON :: Value -> Parser ImageContent
parseJSON = String
-> (Object -> Parser ImageContent) -> Value -> Parser ImageContent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ImageContent" ((Object -> Parser ImageContent) -> Value -> Parser ImageContent)
-> (Object -> Parser ImageContent) -> Value -> Parser ImageContent
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
"image" :: Text)
            then Text
-> Text
-> Text
-> Maybe Annotations
-> Maybe Metadata
-> ImageContent
ImageContent Text
ty (Text
 -> Text -> Maybe Annotations -> Maybe Metadata -> ImageContent)
-> Parser Text
-> Parser
     (Text -> Maybe Annotations -> Maybe Metadata -> ImageContent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data" Parser
  (Text -> Maybe Annotations -> Maybe Metadata -> ImageContent)
-> Parser Text
-> Parser (Maybe Annotations -> Maybe Metadata -> ImageContent)
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
"mimeType" Parser (Maybe Annotations -> Maybe Metadata -> ImageContent)
-> Parser (Maybe Annotations)
-> Parser (Maybe Metadata -> ImageContent)
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 Annotations)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"annotations" Parser (Maybe Metadata -> ImageContent)
-> Parser (Maybe Metadata) -> Parser ImageContent
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 Metadata)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"_meta"
            else String -> Parser ImageContent
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected type 'image'"

-- | Audio provided to or from an LLM
data AudioContent = AudioContent
    { AudioContent -> Text
audioType :: Text -- Always "audio"
    , AudioContent -> Text
data' :: Text -- base64-encoded audio data
    , AudioContent -> Text
mimeType :: Text
    , AudioContent -> Maybe Annotations
annotations :: Maybe Annotations
    , AudioContent -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> AudioContent -> ShowS
[AudioContent] -> ShowS
AudioContent -> String
(Int -> AudioContent -> ShowS)
-> (AudioContent -> String)
-> ([AudioContent] -> ShowS)
-> Show AudioContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AudioContent -> ShowS
showsPrec :: Int -> AudioContent -> ShowS
$cshow :: AudioContent -> String
show :: AudioContent -> String
$cshowList :: [AudioContent] -> ShowS
showList :: [AudioContent] -> ShowS
Show, AudioContent -> AudioContent -> Bool
(AudioContent -> AudioContent -> Bool)
-> (AudioContent -> AudioContent -> Bool) -> Eq AudioContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AudioContent -> AudioContent -> Bool
== :: AudioContent -> AudioContent -> Bool
$c/= :: AudioContent -> AudioContent -> Bool
/= :: AudioContent -> AudioContent -> Bool
Eq, (forall x. AudioContent -> Rep AudioContent x)
-> (forall x. Rep AudioContent x -> AudioContent)
-> Generic AudioContent
forall x. Rep AudioContent x -> AudioContent
forall x. AudioContent -> Rep AudioContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AudioContent -> Rep AudioContent x
from :: forall x. AudioContent -> Rep AudioContent x
$cto :: forall x. Rep AudioContent x -> AudioContent
to :: forall x. Rep AudioContent x -> AudioContent
Generic)

instance ToJSON AudioContent where
    toJSON :: AudioContent -> Value
toJSON (AudioContent Text
_ Text
dat Text
mime Maybe Annotations
anns Maybe Metadata
meta) =
        [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
"audio" :: Text)
            , Key
"data" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
dat
            , Key
"mimeType" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
mime
            ]
                [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Annotations -> [Pair]) -> Maybe Annotations -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Annotations
a -> [Key
"annotations" Key -> Annotations -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Annotations
a]) Maybe Annotations
anns
                [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Metadata -> [Pair]) -> Maybe Metadata -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Metadata
m -> [Key
"_meta" Key -> Metadata -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Metadata
m]) Maybe Metadata
meta

instance FromJSON AudioContent where
    parseJSON :: Value -> Parser AudioContent
parseJSON = String
-> (Object -> Parser AudioContent) -> Value -> Parser AudioContent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AudioContent" ((Object -> Parser AudioContent) -> Value -> Parser AudioContent)
-> (Object -> Parser AudioContent) -> Value -> Parser AudioContent
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
"audio" :: Text)
            then Text
-> Text
-> Text
-> Maybe Annotations
-> Maybe Metadata
-> AudioContent
AudioContent Text
ty (Text
 -> Text -> Maybe Annotations -> Maybe Metadata -> AudioContent)
-> Parser Text
-> Parser
     (Text -> Maybe Annotations -> Maybe Metadata -> AudioContent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data" Parser
  (Text -> Maybe Annotations -> Maybe Metadata -> AudioContent)
-> Parser Text
-> Parser (Maybe Annotations -> Maybe Metadata -> AudioContent)
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
"mimeType" Parser (Maybe Annotations -> Maybe Metadata -> AudioContent)
-> Parser (Maybe Annotations)
-> Parser (Maybe Metadata -> AudioContent)
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 Annotations)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"annotations" Parser (Maybe Metadata -> AudioContent)
-> Parser (Maybe Metadata) -> Parser AudioContent
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 Metadata)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"_meta"
            else String -> Parser AudioContent
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected type 'audio'"

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

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

-- | Blob resource contents
data BlobResourceContents = BlobResourceContents
    { BlobResourceContents -> Text
uri :: Text
    , BlobResourceContents -> Text
blob :: Text -- base64-encoded
    , BlobResourceContents -> Maybe Text
mimeType :: Maybe Text
    , BlobResourceContents -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> BlobResourceContents -> ShowS
[BlobResourceContents] -> ShowS
BlobResourceContents -> String
(Int -> BlobResourceContents -> ShowS)
-> (BlobResourceContents -> String)
-> ([BlobResourceContents] -> ShowS)
-> Show BlobResourceContents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlobResourceContents -> ShowS
showsPrec :: Int -> BlobResourceContents -> ShowS
$cshow :: BlobResourceContents -> String
show :: BlobResourceContents -> String
$cshowList :: [BlobResourceContents] -> ShowS
showList :: [BlobResourceContents] -> ShowS
Show, BlobResourceContents -> BlobResourceContents -> Bool
(BlobResourceContents -> BlobResourceContents -> Bool)
-> (BlobResourceContents -> BlobResourceContents -> Bool)
-> Eq BlobResourceContents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlobResourceContents -> BlobResourceContents -> Bool
== :: BlobResourceContents -> BlobResourceContents -> Bool
$c/= :: BlobResourceContents -> BlobResourceContents -> Bool
/= :: BlobResourceContents -> BlobResourceContents -> Bool
Eq, (forall x. BlobResourceContents -> Rep BlobResourceContents x)
-> (forall x. Rep BlobResourceContents x -> BlobResourceContents)
-> Generic BlobResourceContents
forall x. Rep BlobResourceContents x -> BlobResourceContents
forall x. BlobResourceContents -> Rep BlobResourceContents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BlobResourceContents -> Rep BlobResourceContents x
from :: forall x. BlobResourceContents -> Rep BlobResourceContents x
$cto :: forall x. Rep BlobResourceContents x -> BlobResourceContents
to :: forall x. Rep BlobResourceContents x -> BlobResourceContents
Generic)

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

-- | Resource contents (text or blob)
data ResourceContents
    = TextResource TextResourceContents
    | BlobResource BlobResourceContents
    deriving stock (Int -> ResourceContents -> ShowS
[ResourceContents] -> ShowS
ResourceContents -> String
(Int -> ResourceContents -> ShowS)
-> (ResourceContents -> String)
-> ([ResourceContents] -> ShowS)
-> Show ResourceContents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResourceContents -> ShowS
showsPrec :: Int -> ResourceContents -> ShowS
$cshow :: ResourceContents -> String
show :: ResourceContents -> String
$cshowList :: [ResourceContents] -> ShowS
showList :: [ResourceContents] -> ShowS
Show, ResourceContents -> ResourceContents -> Bool
(ResourceContents -> ResourceContents -> Bool)
-> (ResourceContents -> ResourceContents -> Bool)
-> Eq ResourceContents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResourceContents -> ResourceContents -> Bool
== :: ResourceContents -> ResourceContents -> Bool
$c/= :: ResourceContents -> ResourceContents -> Bool
/= :: ResourceContents -> ResourceContents -> Bool
Eq, (forall x. ResourceContents -> Rep ResourceContents x)
-> (forall x. Rep ResourceContents x -> ResourceContents)
-> Generic ResourceContents
forall x. Rep ResourceContents x -> ResourceContents
forall x. ResourceContents -> Rep ResourceContents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResourceContents -> Rep ResourceContents x
from :: forall x. ResourceContents -> Rep ResourceContents x
$cto :: forall x. Rep ResourceContents x -> ResourceContents
to :: forall x. Rep ResourceContents x -> ResourceContents
Generic)

instance ToJSON ResourceContents where
    toJSON :: ResourceContents -> Value
toJSON (TextResource TextResourceContents
t) = TextResourceContents -> Value
forall a. ToJSON a => a -> Value
toJSON TextResourceContents
t
    toJSON (BlobResource BlobResourceContents
b) = BlobResourceContents -> Value
forall a. ToJSON a => a -> Value
toJSON BlobResourceContents
b

instance FromJSON ResourceContents where
    parseJSON :: Value -> Parser ResourceContents
parseJSON Value
v =
        (TextResourceContents -> ResourceContents
TextResource (TextResourceContents -> ResourceContents)
-> Parser TextResourceContents -> Parser ResourceContents
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser TextResourceContents
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ResourceContents
-> Parser ResourceContents -> Parser ResourceContents
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (BlobResourceContents -> ResourceContents
BlobResource (BlobResourceContents -> ResourceContents)
-> Parser BlobResourceContents -> Parser ResourceContents
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser BlobResourceContents
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)

-- | The contents of a resource, embedded into a prompt or tool call result
data EmbeddedResource = EmbeddedResource
    { EmbeddedResource -> Text
resourceType :: Text -- Always "resource"
    , EmbeddedResource -> ResourceContents
resource :: ResourceContents
    , EmbeddedResource -> Maybe Annotations
annotations :: Maybe Annotations
    , EmbeddedResource -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> EmbeddedResource -> ShowS
[EmbeddedResource] -> ShowS
EmbeddedResource -> String
(Int -> EmbeddedResource -> ShowS)
-> (EmbeddedResource -> String)
-> ([EmbeddedResource] -> ShowS)
-> Show EmbeddedResource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EmbeddedResource -> ShowS
showsPrec :: Int -> EmbeddedResource -> ShowS
$cshow :: EmbeddedResource -> String
show :: EmbeddedResource -> String
$cshowList :: [EmbeddedResource] -> ShowS
showList :: [EmbeddedResource] -> ShowS
Show, EmbeddedResource -> EmbeddedResource -> Bool
(EmbeddedResource -> EmbeddedResource -> Bool)
-> (EmbeddedResource -> EmbeddedResource -> Bool)
-> Eq EmbeddedResource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EmbeddedResource -> EmbeddedResource -> Bool
== :: EmbeddedResource -> EmbeddedResource -> Bool
$c/= :: EmbeddedResource -> EmbeddedResource -> Bool
/= :: EmbeddedResource -> EmbeddedResource -> Bool
Eq, (forall x. EmbeddedResource -> Rep EmbeddedResource x)
-> (forall x. Rep EmbeddedResource x -> EmbeddedResource)
-> Generic EmbeddedResource
forall x. Rep EmbeddedResource x -> EmbeddedResource
forall x. EmbeddedResource -> Rep EmbeddedResource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EmbeddedResource -> Rep EmbeddedResource x
from :: forall x. EmbeddedResource -> Rep EmbeddedResource x
$cto :: forall x. Rep EmbeddedResource x -> EmbeddedResource
to :: forall x. Rep EmbeddedResource x -> EmbeddedResource
Generic)

instance ToJSON EmbeddedResource where
    toJSON :: EmbeddedResource -> Value
toJSON (EmbeddedResource Text
_ ResourceContents
res Maybe Annotations
anns Maybe Metadata
meta) =
        [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
"resource" :: Text)
            , Key
"resource" Key -> ResourceContents -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ResourceContents
res
            ]
                [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Annotations -> [Pair]) -> Maybe Annotations -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Annotations
a -> [Key
"annotations" Key -> Annotations -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Annotations
a]) Maybe Annotations
anns
                [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Metadata -> [Pair]) -> Maybe Metadata -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Metadata
m -> [Key
"_meta" Key -> Metadata -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Metadata
m]) Maybe Metadata
meta

instance FromJSON EmbeddedResource where
    parseJSON :: Value -> Parser EmbeddedResource
parseJSON = String
-> (Object -> Parser EmbeddedResource)
-> Value
-> Parser EmbeddedResource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"EmbeddedResource" ((Object -> Parser EmbeddedResource)
 -> Value -> Parser EmbeddedResource)
-> (Object -> Parser EmbeddedResource)
-> Value
-> Parser EmbeddedResource
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
"resource" :: Text)
            then Text
-> ResourceContents
-> Maybe Annotations
-> Maybe Metadata
-> EmbeddedResource
EmbeddedResource Text
ty (ResourceContents
 -> Maybe Annotations -> Maybe Metadata -> EmbeddedResource)
-> Parser ResourceContents
-> Parser (Maybe Annotations -> Maybe Metadata -> EmbeddedResource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ResourceContents
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"resource" Parser (Maybe Annotations -> Maybe Metadata -> EmbeddedResource)
-> Parser (Maybe Annotations)
-> Parser (Maybe Metadata -> EmbeddedResource)
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 Annotations)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"annotations" Parser (Maybe Metadata -> EmbeddedResource)
-> Parser (Maybe Metadata) -> Parser EmbeddedResource
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 Metadata)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"_meta"
            else String -> Parser EmbeddedResource
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected type 'resource'"

-- | A resource that the server is capable of reading, included in a prompt or tool call result
data ResourceLink = ResourceLink
    { ResourceLink -> Text
resourceLinkType :: Text -- Always "resource_link"
    , ResourceLink -> Text
uri :: Text
    , ResourceLink -> Text
name :: Text
    , ResourceLink -> Maybe Text
title :: Maybe Text
    , ResourceLink -> Maybe Text
description :: Maybe Text
    , ResourceLink -> Maybe Text
mimeType :: Maybe Text
    , ResourceLink -> Maybe Int
size :: Maybe Int
    , ResourceLink -> Maybe Annotations
annotations :: Maybe Annotations
    , ResourceLink -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> ResourceLink -> ShowS
[ResourceLink] -> ShowS
ResourceLink -> String
(Int -> ResourceLink -> ShowS)
-> (ResourceLink -> String)
-> ([ResourceLink] -> ShowS)
-> Show ResourceLink
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResourceLink -> ShowS
showsPrec :: Int -> ResourceLink -> ShowS
$cshow :: ResourceLink -> String
show :: ResourceLink -> String
$cshowList :: [ResourceLink] -> ShowS
showList :: [ResourceLink] -> ShowS
Show, ResourceLink -> ResourceLink -> Bool
(ResourceLink -> ResourceLink -> Bool)
-> (ResourceLink -> ResourceLink -> Bool) -> Eq ResourceLink
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResourceLink -> ResourceLink -> Bool
== :: ResourceLink -> ResourceLink -> Bool
$c/= :: ResourceLink -> ResourceLink -> Bool
/= :: ResourceLink -> ResourceLink -> Bool
Eq, (forall x. ResourceLink -> Rep ResourceLink x)
-> (forall x. Rep ResourceLink x -> ResourceLink)
-> Generic ResourceLink
forall x. Rep ResourceLink x -> ResourceLink
forall x. ResourceLink -> Rep ResourceLink x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResourceLink -> Rep ResourceLink x
from :: forall x. ResourceLink -> Rep ResourceLink x
$cto :: forall x. Rep ResourceLink x -> ResourceLink
to :: forall x. Rep ResourceLink x -> ResourceLink
Generic)

instance ToJSON ResourceLink where
    toJSON :: ResourceLink -> Value
toJSON (ResourceLink Text
_ Text
u Text
n Maybe Text
t Maybe Text
d Maybe Text
m Maybe Int
s Maybe Annotations
a Maybe Metadata
meta) = [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
"resource_link" :: Text)
        , Key
"uri" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
u
        , Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
n
        ]
        [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
"mimeType" 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
m
        [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
"size" 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
s
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Annotations -> [Pair]) -> Maybe Annotations -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Annotations
x -> [Key
"annotations" Key -> Annotations -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Annotations
x]) Maybe Annotations
a
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Metadata -> [Pair]) -> Maybe Metadata -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Metadata
x -> [Key
"_meta" Key -> Metadata -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Metadata
x]) Maybe Metadata
meta

instance FromJSON ResourceLink where
    parseJSON :: Value -> Parser ResourceLink
parseJSON = String
-> (Object -> Parser ResourceLink) -> Value -> Parser ResourceLink
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ResourceLink" ((Object -> Parser ResourceLink) -> Value -> Parser ResourceLink)
-> (Object -> Parser ResourceLink) -> Value -> Parser ResourceLink
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
"resource_link" :: Text)
            then Text
-> Text
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Annotations
-> Maybe Metadata
-> ResourceLink
ResourceLink Text
ty (Text
 -> Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Int
 -> Maybe Annotations
 -> Maybe Metadata
 -> ResourceLink)
-> Parser Text
-> Parser
     (Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Annotations
      -> Maybe Metadata
      -> ResourceLink)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"uri" Parser
  (Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Annotations
   -> Maybe Metadata
   -> ResourceLink)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Annotations
      -> Maybe Metadata
      -> ResourceLink)
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
"name" Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Annotations
   -> Maybe Metadata
   -> ResourceLink)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Annotations
      -> Maybe Metadata
      -> ResourceLink)
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
"title" 
                 Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Annotations
   -> Maybe Metadata
   -> ResourceLink)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Annotations
      -> Maybe Metadata
      -> ResourceLink)
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 Text
   -> Maybe Int
   -> Maybe Annotations
   -> Maybe Metadata
   -> ResourceLink)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int -> Maybe Annotations -> Maybe Metadata -> ResourceLink)
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
"mimeType" Parser
  (Maybe Int -> Maybe Annotations -> Maybe Metadata -> ResourceLink)
-> Parser (Maybe Int)
-> Parser (Maybe Annotations -> Maybe Metadata -> ResourceLink)
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
"size" 
                 Parser (Maybe Annotations -> Maybe Metadata -> ResourceLink)
-> Parser (Maybe Annotations)
-> Parser (Maybe Metadata -> ResourceLink)
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 Annotations)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"annotations" Parser (Maybe Metadata -> ResourceLink)
-> Parser (Maybe Metadata) -> Parser ResourceLink
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 Metadata)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"_meta"
            else String -> Parser ResourceLink
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected type 'resource_link'"

-- | Content blocks that can be text, image, audio, embedded resource, or resource link
data ContentBlock
    = TextContentType TextContent
    | ImageContentType ImageContent
    | AudioContentType AudioContent
    | EmbeddedResourceType EmbeddedResource
    | ResourceLinkType ResourceLink
    deriving stock (Int -> ContentBlock -> ShowS
[ContentBlock] -> ShowS
ContentBlock -> String
(Int -> ContentBlock -> ShowS)
-> (ContentBlock -> String)
-> ([ContentBlock] -> ShowS)
-> Show ContentBlock
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContentBlock -> ShowS
showsPrec :: Int -> ContentBlock -> ShowS
$cshow :: ContentBlock -> String
show :: ContentBlock -> String
$cshowList :: [ContentBlock] -> ShowS
showList :: [ContentBlock] -> ShowS
Show, ContentBlock -> ContentBlock -> Bool
(ContentBlock -> ContentBlock -> Bool)
-> (ContentBlock -> ContentBlock -> Bool) -> Eq ContentBlock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContentBlock -> ContentBlock -> Bool
== :: ContentBlock -> ContentBlock -> Bool
$c/= :: ContentBlock -> ContentBlock -> Bool
/= :: ContentBlock -> ContentBlock -> Bool
Eq, (forall x. ContentBlock -> Rep ContentBlock x)
-> (forall x. Rep ContentBlock x -> ContentBlock)
-> Generic ContentBlock
forall x. Rep ContentBlock x -> ContentBlock
forall x. ContentBlock -> Rep ContentBlock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ContentBlock -> Rep ContentBlock x
from :: forall x. ContentBlock -> Rep ContentBlock x
$cto :: forall x. Rep ContentBlock x -> ContentBlock
to :: forall x. Rep ContentBlock x -> ContentBlock
Generic)

instance ToJSON ContentBlock where
    toJSON :: ContentBlock -> Value
toJSON (TextContentType TextContent
c) = TextContent -> Value
forall a. ToJSON a => a -> Value
toJSON TextContent
c
    toJSON (ImageContentType ImageContent
c) = ImageContent -> Value
forall a. ToJSON a => a -> Value
toJSON ImageContent
c
    toJSON (AudioContentType AudioContent
c) = AudioContent -> Value
forall a. ToJSON a => a -> Value
toJSON AudioContent
c
    toJSON (EmbeddedResourceType EmbeddedResource
c) = EmbeddedResource -> Value
forall a. ToJSON a => a -> Value
toJSON EmbeddedResource
c
    toJSON (ResourceLinkType ResourceLink
c) = ResourceLink -> Value
forall a. ToJSON a => a -> Value
toJSON ResourceLink
c

instance FromJSON ContentBlock where
    parseJSON :: Value -> Parser ContentBlock
parseJSON Value
v =
        (TextContent -> ContentBlock
TextContentType (TextContent -> ContentBlock)
-> Parser TextContent -> Parser ContentBlock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser TextContent
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ContentBlock -> Parser ContentBlock -> Parser ContentBlock
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ImageContent -> ContentBlock
ImageContentType (ImageContent -> ContentBlock)
-> Parser ImageContent -> Parser ContentBlock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ImageContent
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ContentBlock -> Parser ContentBlock -> Parser ContentBlock
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (AudioContent -> ContentBlock
AudioContentType (AudioContent -> ContentBlock)
-> Parser AudioContent -> Parser ContentBlock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser AudioContent
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ContentBlock -> Parser ContentBlock -> Parser ContentBlock
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (EmbeddedResource -> ContentBlock
EmbeddedResourceType (EmbeddedResource -> ContentBlock)
-> Parser EmbeddedResource -> Parser ContentBlock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser EmbeddedResource
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser ContentBlock -> Parser ContentBlock -> Parser ContentBlock
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ResourceLink -> ContentBlock
ResourceLinkType (ResourceLink -> ContentBlock)
-> Parser ResourceLink -> Parser ContentBlock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ResourceLink
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)

-- | Legacy alias for ContentBlock (for backward compatibility)
type Content = ContentBlock

-- | A known resource that the server is capable of reading
data Resource = Resource
    { Resource -> Text
uri :: Text
    , Resource -> Text
name :: Text
    , Resource -> Maybe Text
title :: Maybe Text
    , Resource -> Maybe Text
description :: Maybe Text
    , Resource -> Maybe Text
mimeType :: Maybe Text
    , Resource -> Maybe Int
size :: Maybe Int
    , Resource -> Maybe Annotations
annotations :: Maybe Annotations
    , Resource -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> Resource -> ShowS
[Resource] -> ShowS
Resource -> String
(Int -> Resource -> ShowS)
-> (Resource -> String) -> ([Resource] -> ShowS) -> Show Resource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Resource -> ShowS
showsPrec :: Int -> Resource -> ShowS
$cshow :: Resource -> String
show :: Resource -> String
$cshowList :: [Resource] -> ShowS
showList :: [Resource] -> ShowS
Show, Resource -> Resource -> Bool
(Resource -> Resource -> Bool)
-> (Resource -> Resource -> Bool) -> Eq Resource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Resource -> Resource -> Bool
== :: Resource -> Resource -> Bool
$c/= :: Resource -> Resource -> Bool
/= :: Resource -> Resource -> Bool
Eq, (forall x. Resource -> Rep Resource x)
-> (forall x. Rep Resource x -> Resource) -> Generic Resource
forall x. Rep Resource x -> Resource
forall x. Resource -> Rep Resource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Resource -> Rep Resource x
from :: forall x. Resource -> Rep Resource x
$cto :: forall x. Rep Resource x -> Resource
to :: forall x. Rep Resource x -> Resource
Generic)

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

-- | A template description for resources available on the server
data ResourceTemplate = ResourceTemplate
    { ResourceTemplate -> Text
name :: Text
    , ResourceTemplate -> Maybe Text
title :: Maybe Text
    , ResourceTemplate -> Text
uriTemplate :: Text
    , ResourceTemplate -> Maybe Text
description :: Maybe Text
    , ResourceTemplate -> Maybe Text
mimeType :: Maybe Text
    , ResourceTemplate -> Maybe Annotations
annotations :: Maybe Annotations
    , ResourceTemplate -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> ResourceTemplate -> ShowS
[ResourceTemplate] -> ShowS
ResourceTemplate -> String
(Int -> ResourceTemplate -> ShowS)
-> (ResourceTemplate -> String)
-> ([ResourceTemplate] -> ShowS)
-> Show ResourceTemplate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResourceTemplate -> ShowS
showsPrec :: Int -> ResourceTemplate -> ShowS
$cshow :: ResourceTemplate -> String
show :: ResourceTemplate -> String
$cshowList :: [ResourceTemplate] -> ShowS
showList :: [ResourceTemplate] -> ShowS
Show, ResourceTemplate -> ResourceTemplate -> Bool
(ResourceTemplate -> ResourceTemplate -> Bool)
-> (ResourceTemplate -> ResourceTemplate -> Bool)
-> Eq ResourceTemplate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResourceTemplate -> ResourceTemplate -> Bool
== :: ResourceTemplate -> ResourceTemplate -> Bool
$c/= :: ResourceTemplate -> ResourceTemplate -> Bool
/= :: ResourceTemplate -> ResourceTemplate -> Bool
Eq, (forall x. ResourceTemplate -> Rep ResourceTemplate x)
-> (forall x. Rep ResourceTemplate x -> ResourceTemplate)
-> Generic ResourceTemplate
forall x. Rep ResourceTemplate x -> ResourceTemplate
forall x. ResourceTemplate -> Rep ResourceTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResourceTemplate -> Rep ResourceTemplate x
from :: forall x. ResourceTemplate -> Rep ResourceTemplate x
$cto :: forall x. Rep ResourceTemplate x -> ResourceTemplate
to :: forall x. Rep ResourceTemplate x -> ResourceTemplate
Generic)

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

-- | A reference to a resource or resource template definition
data ResourceReference = ResourceReference
    { ResourceReference -> Text
refType :: Text -- Always "ref/resource"
    , ResourceReference -> Text
uri :: Text
    }
    deriving stock (Int -> ResourceReference -> ShowS
[ResourceReference] -> ShowS
ResourceReference -> String
(Int -> ResourceReference -> ShowS)
-> (ResourceReference -> String)
-> ([ResourceReference] -> ShowS)
-> Show ResourceReference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResourceReference -> ShowS
showsPrec :: Int -> ResourceReference -> ShowS
$cshow :: ResourceReference -> String
show :: ResourceReference -> String
$cshowList :: [ResourceReference] -> ShowS
showList :: [ResourceReference] -> ShowS
Show, ResourceReference -> ResourceReference -> Bool
(ResourceReference -> ResourceReference -> Bool)
-> (ResourceReference -> ResourceReference -> Bool)
-> Eq ResourceReference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResourceReference -> ResourceReference -> Bool
== :: ResourceReference -> ResourceReference -> Bool
$c/= :: ResourceReference -> ResourceReference -> Bool
/= :: ResourceReference -> ResourceReference -> Bool
Eq, (forall x. ResourceReference -> Rep ResourceReference x)
-> (forall x. Rep ResourceReference x -> ResourceReference)
-> Generic ResourceReference
forall x. Rep ResourceReference x -> ResourceReference
forall x. ResourceReference -> Rep ResourceReference x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResourceReference -> Rep ResourceReference x
from :: forall x. ResourceReference -> Rep ResourceReference x
$cto :: forall x. Rep ResourceReference x -> ResourceReference
to :: forall x. Rep ResourceReference x -> ResourceReference
Generic)

instance ToJSON ResourceReference where
    toJSON :: ResourceReference -> Value
toJSON (ResourceReference Text
_ Text
u) =
        [Pair] -> Value
object
            [ 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
"ref/resource" :: Text)
            , Key
"uri" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
u
            ]

instance FromJSON ResourceReference where
    parseJSON :: Value -> Parser ResourceReference
parseJSON = String
-> (Object -> Parser ResourceReference)
-> Value
-> Parser ResourceReference
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ResourceReference" ((Object -> Parser ResourceReference)
 -> Value -> Parser ResourceReference)
-> (Object -> Parser ResourceReference)
-> Value
-> Parser ResourceReference
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
"ref/resource" :: Text)
            then Text -> Text -> ResourceReference
ResourceReference Text
ty (Text -> ResourceReference)
-> Parser Text -> Parser ResourceReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"uri"
            else String -> Parser ResourceReference
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected type 'ref/resource'"

-- | A reference to a resource template definition
data ResourceTemplateReference = ResourceTemplateReference
    { ResourceTemplateReference -> Text
refType :: Text -- Always "ref/resource"
    , ResourceTemplateReference -> Text
uri :: Text
    }
    deriving stock (Int -> ResourceTemplateReference -> ShowS
[ResourceTemplateReference] -> ShowS
ResourceTemplateReference -> String
(Int -> ResourceTemplateReference -> ShowS)
-> (ResourceTemplateReference -> String)
-> ([ResourceTemplateReference] -> ShowS)
-> Show ResourceTemplateReference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResourceTemplateReference -> ShowS
showsPrec :: Int -> ResourceTemplateReference -> ShowS
$cshow :: ResourceTemplateReference -> String
show :: ResourceTemplateReference -> String
$cshowList :: [ResourceTemplateReference] -> ShowS
showList :: [ResourceTemplateReference] -> ShowS
Show, ResourceTemplateReference -> ResourceTemplateReference -> Bool
(ResourceTemplateReference -> ResourceTemplateReference -> Bool)
-> (ResourceTemplateReference -> ResourceTemplateReference -> Bool)
-> Eq ResourceTemplateReference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResourceTemplateReference -> ResourceTemplateReference -> Bool
== :: ResourceTemplateReference -> ResourceTemplateReference -> Bool
$c/= :: ResourceTemplateReference -> ResourceTemplateReference -> Bool
/= :: ResourceTemplateReference -> ResourceTemplateReference -> Bool
Eq, (forall x.
 ResourceTemplateReference -> Rep ResourceTemplateReference x)
-> (forall x.
    Rep ResourceTemplateReference x -> ResourceTemplateReference)
-> Generic ResourceTemplateReference
forall x.
Rep ResourceTemplateReference x -> ResourceTemplateReference
forall x.
ResourceTemplateReference -> Rep ResourceTemplateReference x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ResourceTemplateReference -> Rep ResourceTemplateReference x
from :: forall x.
ResourceTemplateReference -> Rep ResourceTemplateReference x
$cto :: forall x.
Rep ResourceTemplateReference x -> ResourceTemplateReference
to :: forall x.
Rep ResourceTemplateReference x -> ResourceTemplateReference
Generic)

instance ToJSON ResourceTemplateReference where
    toJSON :: ResourceTemplateReference -> Value
toJSON (ResourceTemplateReference Text
_ Text
u) =
        [Pair] -> Value
object
            [ 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
"ref/resource" :: Text)
            , Key
"uri" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
u
            ]

instance FromJSON ResourceTemplateReference where
    parseJSON :: Value -> Parser ResourceTemplateReference
parseJSON = String
-> (Object -> Parser ResourceTemplateReference)
-> Value
-> Parser ResourceTemplateReference
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ResourceTemplateReference" ((Object -> Parser ResourceTemplateReference)
 -> Value -> Parser ResourceTemplateReference)
-> (Object -> Parser ResourceTemplateReference)
-> Value
-> Parser ResourceTemplateReference
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
"ref/resource" :: Text)
            then Text -> Text -> ResourceTemplateReference
ResourceTemplateReference Text
ty (Text -> ResourceTemplateReference)
-> Parser Text -> Parser ResourceTemplateReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"uri"
            else String -> Parser ResourceTemplateReference
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected type 'ref/resource'"

-- | Additional properties describing a Tool to clients
data ToolAnnotations = ToolAnnotations
    { ToolAnnotations -> Maybe Text
title :: Maybe Text
    , ToolAnnotations -> Maybe Bool
readOnlyHint :: Maybe Bool
    , ToolAnnotations -> Maybe Bool
destructiveHint :: Maybe Bool
    , ToolAnnotations -> Maybe Bool
idempotentHint :: Maybe Bool
    , ToolAnnotations -> Maybe Bool
openWorldHint :: Maybe Bool
    }
    deriving stock (Int -> ToolAnnotations -> ShowS
[ToolAnnotations] -> ShowS
ToolAnnotations -> String
(Int -> ToolAnnotations -> ShowS)
-> (ToolAnnotations -> String)
-> ([ToolAnnotations] -> ShowS)
-> Show ToolAnnotations
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ToolAnnotations -> ShowS
showsPrec :: Int -> ToolAnnotations -> ShowS
$cshow :: ToolAnnotations -> String
show :: ToolAnnotations -> String
$cshowList :: [ToolAnnotations] -> ShowS
showList :: [ToolAnnotations] -> ShowS
Show, ToolAnnotations -> ToolAnnotations -> Bool
(ToolAnnotations -> ToolAnnotations -> Bool)
-> (ToolAnnotations -> ToolAnnotations -> Bool)
-> Eq ToolAnnotations
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ToolAnnotations -> ToolAnnotations -> Bool
== :: ToolAnnotations -> ToolAnnotations -> Bool
$c/= :: ToolAnnotations -> ToolAnnotations -> Bool
/= :: ToolAnnotations -> ToolAnnotations -> Bool
Eq, (forall x. ToolAnnotations -> Rep ToolAnnotations x)
-> (forall x. Rep ToolAnnotations x -> ToolAnnotations)
-> Generic ToolAnnotations
forall x. Rep ToolAnnotations x -> ToolAnnotations
forall x. ToolAnnotations -> Rep ToolAnnotations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ToolAnnotations -> Rep ToolAnnotations x
from :: forall x. ToolAnnotations -> Rep ToolAnnotations x
$cto :: forall x. Rep ToolAnnotations x -> ToolAnnotations
to :: forall x. Rep ToolAnnotations x -> ToolAnnotations
Generic)

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

-- | Input schema for a tool
data InputSchema = InputSchema
    { InputSchema -> Text
schemaType :: Text -- Always "object"
    , InputSchema -> Maybe (Map Text Value)
properties :: Maybe (Map Text Value)
    , InputSchema -> Maybe [Text]
required :: Maybe [Text]
    }
    deriving stock (Int -> InputSchema -> ShowS
[InputSchema] -> ShowS
InputSchema -> String
(Int -> InputSchema -> ShowS)
-> (InputSchema -> String)
-> ([InputSchema] -> ShowS)
-> Show InputSchema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputSchema -> ShowS
showsPrec :: Int -> InputSchema -> ShowS
$cshow :: InputSchema -> String
show :: InputSchema -> String
$cshowList :: [InputSchema] -> ShowS
showList :: [InputSchema] -> ShowS
Show, InputSchema -> InputSchema -> Bool
(InputSchema -> InputSchema -> Bool)
-> (InputSchema -> InputSchema -> Bool) -> Eq InputSchema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputSchema -> InputSchema -> Bool
== :: InputSchema -> InputSchema -> Bool
$c/= :: InputSchema -> InputSchema -> Bool
/= :: InputSchema -> InputSchema -> Bool
Eq, (forall x. InputSchema -> Rep InputSchema x)
-> (forall x. Rep InputSchema x -> InputSchema)
-> Generic InputSchema
forall x. Rep InputSchema x -> InputSchema
forall x. InputSchema -> Rep InputSchema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InputSchema -> Rep InputSchema x
from :: forall x. InputSchema -> Rep InputSchema x
$cto :: forall x. Rep InputSchema x -> InputSchema
to :: forall x. Rep InputSchema x -> InputSchema
Generic)

instance ToJSON InputSchema where
    toJSON :: InputSchema -> Value
toJSON (InputSchema Text
_ Maybe (Map Text Value)
props Maybe [Text]
req) =
        [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
"object" :: Text)
            ]
                [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair]
-> (Map Text Value -> [Pair]) -> Maybe (Map Text Value) -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Map Text Value
p -> [Key
"properties" Key -> Map Text Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map Text Value
p]) Maybe (Map Text Value)
props
                [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]
r -> [Key
"required" Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Text]
r]) Maybe [Text]
req

instance FromJSON InputSchema where
    parseJSON :: Value -> Parser InputSchema
parseJSON = String
-> (Object -> Parser InputSchema) -> Value -> Parser InputSchema
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"InputSchema" ((Object -> Parser InputSchema) -> Value -> Parser InputSchema)
-> (Object -> Parser InputSchema) -> Value -> Parser InputSchema
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
"object" :: Text)
            then Text -> Maybe (Map Text Value) -> Maybe [Text] -> InputSchema
InputSchema Text
ty (Maybe (Map Text Value) -> Maybe [Text] -> InputSchema)
-> Parser (Maybe (Map Text Value))
-> Parser (Maybe [Text] -> InputSchema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe (Map Text Value))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"properties" Parser (Maybe [Text] -> InputSchema)
-> Parser (Maybe [Text]) -> Parser InputSchema
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
"required"
            else String -> Parser InputSchema
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected type 'object'"

-- | Definition for a tool the client can call
data Tool = Tool
    { Tool -> Text
name :: Text
    , Tool -> Maybe Text
title :: Maybe Text
    , Tool -> Maybe Text
description :: Maybe Text
    , Tool -> InputSchema
inputSchema :: InputSchema
    , Tool -> Maybe InputSchema
outputSchema :: Maybe InputSchema
    , Tool -> Maybe ToolAnnotations
annotations :: Maybe ToolAnnotations
    , Tool -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> Tool -> ShowS
[Tool] -> ShowS
Tool -> String
(Int -> Tool -> ShowS)
-> (Tool -> String) -> ([Tool] -> ShowS) -> Show Tool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tool -> ShowS
showsPrec :: Int -> Tool -> ShowS
$cshow :: Tool -> String
show :: Tool -> String
$cshowList :: [Tool] -> ShowS
showList :: [Tool] -> ShowS
Show, Tool -> Tool -> Bool
(Tool -> Tool -> Bool) -> (Tool -> Tool -> Bool) -> Eq Tool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tool -> Tool -> Bool
== :: Tool -> Tool -> Bool
$c/= :: Tool -> Tool -> Bool
/= :: Tool -> Tool -> Bool
Eq, (forall x. Tool -> Rep Tool x)
-> (forall x. Rep Tool x -> Tool) -> Generic Tool
forall x. Rep Tool x -> Tool
forall x. Tool -> Rep Tool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Tool -> Rep Tool x
from :: forall x. Tool -> Rep Tool x
$cto :: forall x. Rep Tool x -> Tool
to :: forall x. Rep Tool x -> Tool
Generic)

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

-- | Describes an argument that a prompt can accept
data PromptArgument = PromptArgument
    { PromptArgument -> Text
name :: Text
    , PromptArgument -> Maybe Text
title :: Maybe Text
    , PromptArgument -> Maybe Text
description :: Maybe Text
    , PromptArgument -> Maybe Bool
required :: Maybe Bool
    }
    deriving stock (Int -> PromptArgument -> ShowS
[PromptArgument] -> ShowS
PromptArgument -> String
(Int -> PromptArgument -> ShowS)
-> (PromptArgument -> String)
-> ([PromptArgument] -> ShowS)
-> Show PromptArgument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PromptArgument -> ShowS
showsPrec :: Int -> PromptArgument -> ShowS
$cshow :: PromptArgument -> String
show :: PromptArgument -> String
$cshowList :: [PromptArgument] -> ShowS
showList :: [PromptArgument] -> ShowS
Show, PromptArgument -> PromptArgument -> Bool
(PromptArgument -> PromptArgument -> Bool)
-> (PromptArgument -> PromptArgument -> Bool) -> Eq PromptArgument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PromptArgument -> PromptArgument -> Bool
== :: PromptArgument -> PromptArgument -> Bool
$c/= :: PromptArgument -> PromptArgument -> Bool
/= :: PromptArgument -> PromptArgument -> Bool
Eq, (forall x. PromptArgument -> Rep PromptArgument x)
-> (forall x. Rep PromptArgument x -> PromptArgument)
-> Generic PromptArgument
forall x. Rep PromptArgument x -> PromptArgument
forall x. PromptArgument -> Rep PromptArgument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PromptArgument -> Rep PromptArgument x
from :: forall x. PromptArgument -> Rep PromptArgument x
$cto :: forall x. Rep PromptArgument x -> PromptArgument
to :: forall x. Rep PromptArgument x -> PromptArgument
Generic)

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

-- | A prompt or prompt template that the server offers
data Prompt = Prompt
    { Prompt -> Text
name :: Text
    , Prompt -> Maybe Text
title :: Maybe Text
    , Prompt -> Maybe Text
description :: Maybe Text
    , Prompt -> Maybe [PromptArgument]
arguments :: Maybe [PromptArgument]
    , Prompt -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> Prompt -> ShowS
[Prompt] -> ShowS
Prompt -> String
(Int -> Prompt -> ShowS)
-> (Prompt -> String) -> ([Prompt] -> ShowS) -> Show Prompt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Prompt -> ShowS
showsPrec :: Int -> Prompt -> ShowS
$cshow :: Prompt -> String
show :: Prompt -> String
$cshowList :: [Prompt] -> ShowS
showList :: [Prompt] -> ShowS
Show, Prompt -> Prompt -> Bool
(Prompt -> Prompt -> Bool)
-> (Prompt -> Prompt -> Bool) -> Eq Prompt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Prompt -> Prompt -> Bool
== :: Prompt -> Prompt -> Bool
$c/= :: Prompt -> Prompt -> Bool
/= :: Prompt -> Prompt -> Bool
Eq, (forall x. Prompt -> Rep Prompt x)
-> (forall x. Rep Prompt x -> Prompt) -> Generic Prompt
forall x. Rep Prompt x -> Prompt
forall x. Prompt -> Rep Prompt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Prompt -> Rep Prompt x
from :: forall x. Prompt -> Rep Prompt x
$cto :: forall x. Rep Prompt x -> Prompt
to :: forall x. Rep Prompt x -> Prompt
Generic)

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

-- | Describes a message returned as part of a prompt
data PromptMessage = PromptMessage
    { PromptMessage -> Role
role :: Role
    , PromptMessage -> ContentBlock
content :: ContentBlock
    }
    deriving stock (Int -> PromptMessage -> ShowS
[PromptMessage] -> ShowS
PromptMessage -> String
(Int -> PromptMessage -> ShowS)
-> (PromptMessage -> String)
-> ([PromptMessage] -> ShowS)
-> Show PromptMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PromptMessage -> ShowS
showsPrec :: Int -> PromptMessage -> ShowS
$cshow :: PromptMessage -> String
show :: PromptMessage -> String
$cshowList :: [PromptMessage] -> ShowS
showList :: [PromptMessage] -> ShowS
Show, PromptMessage -> PromptMessage -> Bool
(PromptMessage -> PromptMessage -> Bool)
-> (PromptMessage -> PromptMessage -> Bool) -> Eq PromptMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PromptMessage -> PromptMessage -> Bool
== :: PromptMessage -> PromptMessage -> Bool
$c/= :: PromptMessage -> PromptMessage -> Bool
/= :: PromptMessage -> PromptMessage -> Bool
Eq, (forall x. PromptMessage -> Rep PromptMessage x)
-> (forall x. Rep PromptMessage x -> PromptMessage)
-> Generic PromptMessage
forall x. Rep PromptMessage x -> PromptMessage
forall x. PromptMessage -> Rep PromptMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PromptMessage -> Rep PromptMessage x
from :: forall x. PromptMessage -> Rep PromptMessage x
$cto :: forall x. Rep PromptMessage x -> PromptMessage
to :: forall x. Rep PromptMessage x -> PromptMessage
Generic)

$(deriveJSON defaultOptions ''PromptMessage)

-- | Identifies a prompt
data PromptReference = PromptReference
    { PromptReference -> Text
refType :: Text -- Always "ref/prompt"
    , PromptReference -> Text
name :: Text
    , PromptReference -> Maybe Text
title :: Maybe Text
    }
    deriving stock (Int -> PromptReference -> ShowS
[PromptReference] -> ShowS
PromptReference -> String
(Int -> PromptReference -> ShowS)
-> (PromptReference -> String)
-> ([PromptReference] -> ShowS)
-> Show PromptReference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PromptReference -> ShowS
showsPrec :: Int -> PromptReference -> ShowS
$cshow :: PromptReference -> String
show :: PromptReference -> String
$cshowList :: [PromptReference] -> ShowS
showList :: [PromptReference] -> ShowS
Show, PromptReference -> PromptReference -> Bool
(PromptReference -> PromptReference -> Bool)
-> (PromptReference -> PromptReference -> Bool)
-> Eq PromptReference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PromptReference -> PromptReference -> Bool
== :: PromptReference -> PromptReference -> Bool
$c/= :: PromptReference -> PromptReference -> Bool
/= :: PromptReference -> PromptReference -> Bool
Eq, (forall x. PromptReference -> Rep PromptReference x)
-> (forall x. Rep PromptReference x -> PromptReference)
-> Generic PromptReference
forall x. Rep PromptReference x -> PromptReference
forall x. PromptReference -> Rep PromptReference x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PromptReference -> Rep PromptReference x
from :: forall x. PromptReference -> Rep PromptReference x
$cto :: forall x. Rep PromptReference x -> PromptReference
to :: forall x. Rep PromptReference x -> PromptReference
Generic)

instance ToJSON PromptReference where
    toJSON :: PromptReference -> Value
toJSON (PromptReference Text
_ Text
n Maybe Text
t) =
        [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
"ref/prompt" :: Text)
            , Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
n
            ]
            [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
tit -> [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
tit]) Maybe Text
t

instance FromJSON PromptReference where
    parseJSON :: Value -> Parser PromptReference
parseJSON = String
-> (Object -> Parser PromptReference)
-> Value
-> Parser PromptReference
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PromptReference" ((Object -> Parser PromptReference)
 -> Value -> Parser PromptReference)
-> (Object -> Parser PromptReference)
-> Value
-> Parser PromptReference
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
"ref/prompt" :: Text)
            then Text -> Text -> Maybe Text -> PromptReference
PromptReference Text
ty (Text -> Maybe Text -> PromptReference)
-> Parser Text -> Parser (Maybe Text -> PromptReference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name" Parser (Maybe Text -> PromptReference)
-> Parser (Maybe Text) -> Parser PromptReference
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
"title"
            else String -> Parser PromptReference
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected type 'ref/prompt'"

-- | Hints to use for model selection
data ModelHint where
    ModelHint :: {ModelHint -> Maybe Text
name :: Maybe Text} -> ModelHint
    deriving stock (Int -> ModelHint -> ShowS
[ModelHint] -> ShowS
ModelHint -> String
(Int -> ModelHint -> ShowS)
-> (ModelHint -> String)
-> ([ModelHint] -> ShowS)
-> Show ModelHint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModelHint -> ShowS
showsPrec :: Int -> ModelHint -> ShowS
$cshow :: ModelHint -> String
show :: ModelHint -> String
$cshowList :: [ModelHint] -> ShowS
showList :: [ModelHint] -> ShowS
Show, ModelHint -> ModelHint -> Bool
(ModelHint -> ModelHint -> Bool)
-> (ModelHint -> ModelHint -> Bool) -> Eq ModelHint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModelHint -> ModelHint -> Bool
== :: ModelHint -> ModelHint -> Bool
$c/= :: ModelHint -> ModelHint -> Bool
/= :: ModelHint -> ModelHint -> Bool
Eq, (forall x. ModelHint -> Rep ModelHint x)
-> (forall x. Rep ModelHint x -> ModelHint) -> Generic ModelHint
forall x. Rep ModelHint x -> ModelHint
forall x. ModelHint -> Rep ModelHint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModelHint -> Rep ModelHint x
from :: forall x. ModelHint -> Rep ModelHint x
$cto :: forall x. Rep ModelHint x -> ModelHint
to :: forall x. Rep ModelHint x -> ModelHint
Generic)

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

-- | The server's preferences for model selection
data ModelPreferences = ModelPreferences
    { ModelPreferences -> Maybe [ModelHint]
hints :: Maybe [ModelHint]
    , ModelPreferences -> Maybe Double
costPriority :: Maybe Double -- 0.0 to 1.0
    , ModelPreferences -> Maybe Double
speedPriority :: Maybe Double -- 0.0 to 1.0
    , ModelPreferences -> Maybe Double
intelligencePriority :: Maybe Double -- 0.0 to 1.0
    }
    deriving stock (Int -> ModelPreferences -> ShowS
[ModelPreferences] -> ShowS
ModelPreferences -> String
(Int -> ModelPreferences -> ShowS)
-> (ModelPreferences -> String)
-> ([ModelPreferences] -> ShowS)
-> Show ModelPreferences
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModelPreferences -> ShowS
showsPrec :: Int -> ModelPreferences -> ShowS
$cshow :: ModelPreferences -> String
show :: ModelPreferences -> String
$cshowList :: [ModelPreferences] -> ShowS
showList :: [ModelPreferences] -> ShowS
Show, ModelPreferences -> ModelPreferences -> Bool
(ModelPreferences -> ModelPreferences -> Bool)
-> (ModelPreferences -> ModelPreferences -> Bool)
-> Eq ModelPreferences
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModelPreferences -> ModelPreferences -> Bool
== :: ModelPreferences -> ModelPreferences -> Bool
$c/= :: ModelPreferences -> ModelPreferences -> Bool
/= :: ModelPreferences -> ModelPreferences -> Bool
Eq, (forall x. ModelPreferences -> Rep ModelPreferences x)
-> (forall x. Rep ModelPreferences x -> ModelPreferences)
-> Generic ModelPreferences
forall x. Rep ModelPreferences x -> ModelPreferences
forall x. ModelPreferences -> Rep ModelPreferences x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModelPreferences -> Rep ModelPreferences x
from :: forall x. ModelPreferences -> Rep ModelPreferences x
$cto :: forall x. Rep ModelPreferences x -> ModelPreferences
to :: forall x. Rep ModelPreferences x -> ModelPreferences
Generic)

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

-- | Include context options for sampling
data IncludeContext = AllServers | None | ThisServer
    deriving stock (Int -> IncludeContext -> ShowS
[IncludeContext] -> ShowS
IncludeContext -> String
(Int -> IncludeContext -> ShowS)
-> (IncludeContext -> String)
-> ([IncludeContext] -> ShowS)
-> Show IncludeContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IncludeContext -> ShowS
showsPrec :: Int -> IncludeContext -> ShowS
$cshow :: IncludeContext -> String
show :: IncludeContext -> String
$cshowList :: [IncludeContext] -> ShowS
showList :: [IncludeContext] -> ShowS
Show, IncludeContext -> IncludeContext -> Bool
(IncludeContext -> IncludeContext -> Bool)
-> (IncludeContext -> IncludeContext -> Bool) -> Eq IncludeContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IncludeContext -> IncludeContext -> Bool
== :: IncludeContext -> IncludeContext -> Bool
$c/= :: IncludeContext -> IncludeContext -> Bool
/= :: IncludeContext -> IncludeContext -> Bool
Eq, (forall x. IncludeContext -> Rep IncludeContext x)
-> (forall x. Rep IncludeContext x -> IncludeContext)
-> Generic IncludeContext
forall x. Rep IncludeContext x -> IncludeContext
forall x. IncludeContext -> Rep IncludeContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IncludeContext -> Rep IncludeContext x
from :: forall x. IncludeContext -> Rep IncludeContext x
$cto :: forall x. Rep IncludeContext x -> IncludeContext
to :: forall x. Rep IncludeContext x -> IncludeContext
Generic)

instance ToJSON IncludeContext where
    toJSON :: IncludeContext -> Value
toJSON IncludeContext
AllServers = Value
"allServers"
    toJSON IncludeContext
None = Value
"none"
    toJSON IncludeContext
ThisServer = Value
"thisServer"

instance FromJSON IncludeContext where
    parseJSON :: Value -> Parser IncludeContext
parseJSON = String
-> (Text -> Parser IncludeContext)
-> Value
-> Parser IncludeContext
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"IncludeContext" ((Text -> Parser IncludeContext) -> Value -> Parser IncludeContext)
-> (Text -> Parser IncludeContext)
-> Value
-> Parser IncludeContext
forall a b. (a -> b) -> a -> b
$ \case
        Text
"allServers" -> IncludeContext -> Parser IncludeContext
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IncludeContext
AllServers
        Text
"none" -> IncludeContext -> Parser IncludeContext
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IncludeContext
None
        Text
"thisServer" -> IncludeContext -> Parser IncludeContext
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IncludeContext
ThisServer
        Text
other -> String -> Parser IncludeContext
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser IncludeContext)
-> String -> Parser IncludeContext
forall a b. (a -> b) -> a -> b
$ String
"Unknown include context: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
other

-- | Restricted content type for sampling messages (text, image, audio only)
data SamplingContent 
    = SamplingTextContent TextContent
    | SamplingImageContent ImageContent
    | SamplingAudioContent AudioContent
    deriving stock (Int -> SamplingContent -> ShowS
[SamplingContent] -> ShowS
SamplingContent -> String
(Int -> SamplingContent -> ShowS)
-> (SamplingContent -> String)
-> ([SamplingContent] -> ShowS)
-> Show SamplingContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SamplingContent -> ShowS
showsPrec :: Int -> SamplingContent -> ShowS
$cshow :: SamplingContent -> String
show :: SamplingContent -> String
$cshowList :: [SamplingContent] -> ShowS
showList :: [SamplingContent] -> ShowS
Show, SamplingContent -> SamplingContent -> Bool
(SamplingContent -> SamplingContent -> Bool)
-> (SamplingContent -> SamplingContent -> Bool)
-> Eq SamplingContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SamplingContent -> SamplingContent -> Bool
== :: SamplingContent -> SamplingContent -> Bool
$c/= :: SamplingContent -> SamplingContent -> Bool
/= :: SamplingContent -> SamplingContent -> Bool
Eq, (forall x. SamplingContent -> Rep SamplingContent x)
-> (forall x. Rep SamplingContent x -> SamplingContent)
-> Generic SamplingContent
forall x. Rep SamplingContent x -> SamplingContent
forall x. SamplingContent -> Rep SamplingContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SamplingContent -> Rep SamplingContent x
from :: forall x. SamplingContent -> Rep SamplingContent x
$cto :: forall x. Rep SamplingContent x -> SamplingContent
to :: forall x. Rep SamplingContent x -> SamplingContent
Generic)

instance ToJSON SamplingContent where
    toJSON :: SamplingContent -> Value
toJSON (SamplingTextContent TextContent
c) = TextContent -> Value
forall a. ToJSON a => a -> Value
toJSON TextContent
c
    toJSON (SamplingImageContent ImageContent
c) = ImageContent -> Value
forall a. ToJSON a => a -> Value
toJSON ImageContent
c
    toJSON (SamplingAudioContent AudioContent
c) = AudioContent -> Value
forall a. ToJSON a => a -> Value
toJSON AudioContent
c

instance FromJSON SamplingContent where
    parseJSON :: Value -> Parser SamplingContent
parseJSON Value
v =
        (TextContent -> SamplingContent
SamplingTextContent (TextContent -> SamplingContent)
-> Parser TextContent -> Parser SamplingContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser TextContent
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser SamplingContent
-> Parser SamplingContent -> Parser SamplingContent
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ImageContent -> SamplingContent
SamplingImageContent (ImageContent -> SamplingContent)
-> Parser ImageContent -> Parser SamplingContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ImageContent
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
            Parser SamplingContent
-> Parser SamplingContent -> Parser SamplingContent
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (AudioContent -> SamplingContent
SamplingAudioContent (AudioContent -> SamplingContent)
-> Parser AudioContent -> Parser SamplingContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser AudioContent
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)

-- | Describes a message issued to or received from an LLM API
data SamplingMessage = SamplingMessage
    { SamplingMessage -> Role
role :: Role
    , SamplingMessage -> SamplingContent
content :: SamplingContent
    }
    deriving stock (Int -> SamplingMessage -> ShowS
[SamplingMessage] -> ShowS
SamplingMessage -> String
(Int -> SamplingMessage -> ShowS)
-> (SamplingMessage -> String)
-> ([SamplingMessage] -> ShowS)
-> Show SamplingMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SamplingMessage -> ShowS
showsPrec :: Int -> SamplingMessage -> ShowS
$cshow :: SamplingMessage -> String
show :: SamplingMessage -> String
$cshowList :: [SamplingMessage] -> ShowS
showList :: [SamplingMessage] -> ShowS
Show, SamplingMessage -> SamplingMessage -> Bool
(SamplingMessage -> SamplingMessage -> Bool)
-> (SamplingMessage -> SamplingMessage -> Bool)
-> Eq SamplingMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SamplingMessage -> SamplingMessage -> Bool
== :: SamplingMessage -> SamplingMessage -> Bool
$c/= :: SamplingMessage -> SamplingMessage -> Bool
/= :: SamplingMessage -> SamplingMessage -> Bool
Eq, (forall x. SamplingMessage -> Rep SamplingMessage x)
-> (forall x. Rep SamplingMessage x -> SamplingMessage)
-> Generic SamplingMessage
forall x. Rep SamplingMessage x -> SamplingMessage
forall x. SamplingMessage -> Rep SamplingMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SamplingMessage -> Rep SamplingMessage x
from :: forall x. SamplingMessage -> Rep SamplingMessage x
$cto :: forall x. Rep SamplingMessage x -> SamplingMessage
to :: forall x. Rep SamplingMessage x -> SamplingMessage
Generic)

$(deriveJSON defaultOptions ''SamplingMessage)

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

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

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

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

-- | Resources capability
data ResourcesCapability = ResourcesCapability
    { ResourcesCapability -> Maybe Bool
listChanged :: Maybe Bool
    , ResourcesCapability -> Maybe Bool
subscribe :: Maybe Bool
    }
    deriving stock (Int -> ResourcesCapability -> ShowS
[ResourcesCapability] -> ShowS
ResourcesCapability -> String
(Int -> ResourcesCapability -> ShowS)
-> (ResourcesCapability -> String)
-> ([ResourcesCapability] -> ShowS)
-> Show ResourcesCapability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResourcesCapability -> ShowS
showsPrec :: Int -> ResourcesCapability -> ShowS
$cshow :: ResourcesCapability -> String
show :: ResourcesCapability -> String
$cshowList :: [ResourcesCapability] -> ShowS
showList :: [ResourcesCapability] -> ShowS
Show, ResourcesCapability -> ResourcesCapability -> Bool
(ResourcesCapability -> ResourcesCapability -> Bool)
-> (ResourcesCapability -> ResourcesCapability -> Bool)
-> Eq ResourcesCapability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResourcesCapability -> ResourcesCapability -> Bool
== :: ResourcesCapability -> ResourcesCapability -> Bool
$c/= :: ResourcesCapability -> ResourcesCapability -> Bool
/= :: ResourcesCapability -> ResourcesCapability -> Bool
Eq, (forall x. ResourcesCapability -> Rep ResourcesCapability x)
-> (forall x. Rep ResourcesCapability x -> ResourcesCapability)
-> Generic ResourcesCapability
forall x. Rep ResourcesCapability x -> ResourcesCapability
forall x. ResourcesCapability -> Rep ResourcesCapability x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResourcesCapability -> Rep ResourcesCapability x
from :: forall x. ResourcesCapability -> Rep ResourcesCapability x
$cto :: forall x. Rep ResourcesCapability x -> ResourcesCapability
to :: forall x. Rep ResourcesCapability x -> ResourcesCapability
Generic)

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

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

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

-- | Completions capability
data CompletionsCapability = CompletionsCapability
    deriving stock (Int -> CompletionsCapability -> ShowS
[CompletionsCapability] -> ShowS
CompletionsCapability -> String
(Int -> CompletionsCapability -> ShowS)
-> (CompletionsCapability -> String)
-> ([CompletionsCapability] -> ShowS)
-> Show CompletionsCapability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompletionsCapability -> ShowS
showsPrec :: Int -> CompletionsCapability -> ShowS
$cshow :: CompletionsCapability -> String
show :: CompletionsCapability -> String
$cshowList :: [CompletionsCapability] -> ShowS
showList :: [CompletionsCapability] -> ShowS
Show, CompletionsCapability -> CompletionsCapability -> Bool
(CompletionsCapability -> CompletionsCapability -> Bool)
-> (CompletionsCapability -> CompletionsCapability -> Bool)
-> Eq CompletionsCapability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompletionsCapability -> CompletionsCapability -> Bool
== :: CompletionsCapability -> CompletionsCapability -> Bool
$c/= :: CompletionsCapability -> CompletionsCapability -> Bool
/= :: CompletionsCapability -> CompletionsCapability -> Bool
Eq, (forall x. CompletionsCapability -> Rep CompletionsCapability x)
-> (forall x. Rep CompletionsCapability x -> CompletionsCapability)
-> Generic CompletionsCapability
forall x. Rep CompletionsCapability x -> CompletionsCapability
forall x. CompletionsCapability -> Rep CompletionsCapability x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CompletionsCapability -> Rep CompletionsCapability x
from :: forall x. CompletionsCapability -> Rep CompletionsCapability x
$cto :: forall x. Rep CompletionsCapability x -> CompletionsCapability
to :: forall x. Rep CompletionsCapability x -> CompletionsCapability
Generic)

instance ToJSON CompletionsCapability where
    toJSON :: CompletionsCapability -> Value
toJSON CompletionsCapability
_ = [Pair] -> Value
object []

instance FromJSON CompletionsCapability where
    parseJSON :: Value -> Parser CompletionsCapability
parseJSON = String
-> (Object -> Parser CompletionsCapability)
-> Value
-> Parser CompletionsCapability
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CompletionsCapability" ((Object -> Parser CompletionsCapability)
 -> Value -> Parser CompletionsCapability)
-> (Object -> Parser CompletionsCapability)
-> Value
-> Parser CompletionsCapability
forall a b. (a -> b) -> a -> b
$ \Object
_ -> CompletionsCapability -> Parser CompletionsCapability
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionsCapability
CompletionsCapability

-- | Logging capability
data LoggingCapability = LoggingCapability
    deriving stock (Int -> LoggingCapability -> ShowS
[LoggingCapability] -> ShowS
LoggingCapability -> String
(Int -> LoggingCapability -> ShowS)
-> (LoggingCapability -> String)
-> ([LoggingCapability] -> ShowS)
-> Show LoggingCapability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LoggingCapability -> ShowS
showsPrec :: Int -> LoggingCapability -> ShowS
$cshow :: LoggingCapability -> String
show :: LoggingCapability -> String
$cshowList :: [LoggingCapability] -> ShowS
showList :: [LoggingCapability] -> ShowS
Show, LoggingCapability -> LoggingCapability -> Bool
(LoggingCapability -> LoggingCapability -> Bool)
-> (LoggingCapability -> LoggingCapability -> Bool)
-> Eq LoggingCapability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LoggingCapability -> LoggingCapability -> Bool
== :: LoggingCapability -> LoggingCapability -> Bool
$c/= :: LoggingCapability -> LoggingCapability -> Bool
/= :: LoggingCapability -> LoggingCapability -> Bool
Eq, (forall x. LoggingCapability -> Rep LoggingCapability x)
-> (forall x. Rep LoggingCapability x -> LoggingCapability)
-> Generic LoggingCapability
forall x. Rep LoggingCapability x -> LoggingCapability
forall x. LoggingCapability -> Rep LoggingCapability x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LoggingCapability -> Rep LoggingCapability x
from :: forall x. LoggingCapability -> Rep LoggingCapability x
$cto :: forall x. Rep LoggingCapability x -> LoggingCapability
to :: forall x. Rep LoggingCapability x -> LoggingCapability
Generic)

instance ToJSON LoggingCapability where
    toJSON :: LoggingCapability -> Value
toJSON LoggingCapability
_ = [Pair] -> Value
object []

instance FromJSON LoggingCapability where
    parseJSON :: Value -> Parser LoggingCapability
parseJSON = String
-> (Object -> Parser LoggingCapability)
-> Value
-> Parser LoggingCapability
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LoggingCapability" ((Object -> Parser LoggingCapability)
 -> Value -> Parser LoggingCapability)
-> (Object -> Parser LoggingCapability)
-> Value
-> Parser LoggingCapability
forall a b. (a -> b) -> a -> b
$ \Object
_ -> LoggingCapability -> Parser LoggingCapability
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoggingCapability
LoggingCapability

-- | Sampling capability
data SamplingCapability = SamplingCapability
    deriving stock (Int -> SamplingCapability -> ShowS
[SamplingCapability] -> ShowS
SamplingCapability -> String
(Int -> SamplingCapability -> ShowS)
-> (SamplingCapability -> String)
-> ([SamplingCapability] -> ShowS)
-> Show SamplingCapability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SamplingCapability -> ShowS
showsPrec :: Int -> SamplingCapability -> ShowS
$cshow :: SamplingCapability -> String
show :: SamplingCapability -> String
$cshowList :: [SamplingCapability] -> ShowS
showList :: [SamplingCapability] -> ShowS
Show, SamplingCapability -> SamplingCapability -> Bool
(SamplingCapability -> SamplingCapability -> Bool)
-> (SamplingCapability -> SamplingCapability -> Bool)
-> Eq SamplingCapability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SamplingCapability -> SamplingCapability -> Bool
== :: SamplingCapability -> SamplingCapability -> Bool
$c/= :: SamplingCapability -> SamplingCapability -> Bool
/= :: SamplingCapability -> SamplingCapability -> Bool
Eq, (forall x. SamplingCapability -> Rep SamplingCapability x)
-> (forall x. Rep SamplingCapability x -> SamplingCapability)
-> Generic SamplingCapability
forall x. Rep SamplingCapability x -> SamplingCapability
forall x. SamplingCapability -> Rep SamplingCapability x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SamplingCapability -> Rep SamplingCapability x
from :: forall x. SamplingCapability -> Rep SamplingCapability x
$cto :: forall x. Rep SamplingCapability x -> SamplingCapability
to :: forall x. Rep SamplingCapability x -> SamplingCapability
Generic)

instance ToJSON SamplingCapability where
    toJSON :: SamplingCapability -> Value
toJSON SamplingCapability
_ = [Pair] -> Value
object []

instance FromJSON SamplingCapability where
    parseJSON :: Value -> Parser SamplingCapability
parseJSON = String
-> (Object -> Parser SamplingCapability)
-> Value
-> Parser SamplingCapability
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SamplingCapability" ((Object -> Parser SamplingCapability)
 -> Value -> Parser SamplingCapability)
-> (Object -> Parser SamplingCapability)
-> Value
-> Parser SamplingCapability
forall a b. (a -> b) -> a -> b
$ \Object
_ -> SamplingCapability -> Parser SamplingCapability
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SamplingCapability
SamplingCapability

-- | Elicitation capability
data ElicitationCapability = ElicitationCapability
    deriving stock (Int -> ElicitationCapability -> ShowS
[ElicitationCapability] -> ShowS
ElicitationCapability -> String
(Int -> ElicitationCapability -> ShowS)
-> (ElicitationCapability -> String)
-> ([ElicitationCapability] -> ShowS)
-> Show ElicitationCapability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ElicitationCapability -> ShowS
showsPrec :: Int -> ElicitationCapability -> ShowS
$cshow :: ElicitationCapability -> String
show :: ElicitationCapability -> String
$cshowList :: [ElicitationCapability] -> ShowS
showList :: [ElicitationCapability] -> ShowS
Show, ElicitationCapability -> ElicitationCapability -> Bool
(ElicitationCapability -> ElicitationCapability -> Bool)
-> (ElicitationCapability -> ElicitationCapability -> Bool)
-> Eq ElicitationCapability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ElicitationCapability -> ElicitationCapability -> Bool
== :: ElicitationCapability -> ElicitationCapability -> Bool
$c/= :: ElicitationCapability -> ElicitationCapability -> Bool
/= :: ElicitationCapability -> ElicitationCapability -> Bool
Eq, (forall x. ElicitationCapability -> Rep ElicitationCapability x)
-> (forall x. Rep ElicitationCapability x -> ElicitationCapability)
-> Generic ElicitationCapability
forall x. Rep ElicitationCapability x -> ElicitationCapability
forall x. ElicitationCapability -> Rep ElicitationCapability x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ElicitationCapability -> Rep ElicitationCapability x
from :: forall x. ElicitationCapability -> Rep ElicitationCapability x
$cto :: forall x. Rep ElicitationCapability x -> ElicitationCapability
to :: forall x. Rep ElicitationCapability x -> ElicitationCapability
Generic)

instance ToJSON ElicitationCapability where
    toJSON :: ElicitationCapability -> Value
toJSON ElicitationCapability
_ = [Pair] -> Value
object []

instance FromJSON ElicitationCapability where
    parseJSON :: Value -> Parser ElicitationCapability
parseJSON = String
-> (Object -> Parser ElicitationCapability)
-> Value
-> Parser ElicitationCapability
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ElicitationCapability" ((Object -> Parser ElicitationCapability)
 -> Value -> Parser ElicitationCapability)
-> (Object -> Parser ElicitationCapability)
-> Value
-> Parser ElicitationCapability
forall a b. (a -> b) -> a -> b
$ \Object
_ -> ElicitationCapability -> Parser ElicitationCapability
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ElicitationCapability
ElicitationCapability

-- | Experimental capability
newtype ExperimentalCapability = ExperimentalCapability (Map Text Value)
    deriving stock (Int -> ExperimentalCapability -> ShowS
[ExperimentalCapability] -> ShowS
ExperimentalCapability -> String
(Int -> ExperimentalCapability -> ShowS)
-> (ExperimentalCapability -> String)
-> ([ExperimentalCapability] -> ShowS)
-> Show ExperimentalCapability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExperimentalCapability -> ShowS
showsPrec :: Int -> ExperimentalCapability -> ShowS
$cshow :: ExperimentalCapability -> String
show :: ExperimentalCapability -> String
$cshowList :: [ExperimentalCapability] -> ShowS
showList :: [ExperimentalCapability] -> ShowS
Show, ExperimentalCapability -> ExperimentalCapability -> Bool
(ExperimentalCapability -> ExperimentalCapability -> Bool)
-> (ExperimentalCapability -> ExperimentalCapability -> Bool)
-> Eq ExperimentalCapability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExperimentalCapability -> ExperimentalCapability -> Bool
== :: ExperimentalCapability -> ExperimentalCapability -> Bool
$c/= :: ExperimentalCapability -> ExperimentalCapability -> Bool
/= :: ExperimentalCapability -> ExperimentalCapability -> Bool
Eq, (forall x. ExperimentalCapability -> Rep ExperimentalCapability x)
-> (forall x.
    Rep ExperimentalCapability x -> ExperimentalCapability)
-> Generic ExperimentalCapability
forall x. Rep ExperimentalCapability x -> ExperimentalCapability
forall x. ExperimentalCapability -> Rep ExperimentalCapability x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExperimentalCapability -> Rep ExperimentalCapability x
from :: forall x. ExperimentalCapability -> Rep ExperimentalCapability x
$cto :: forall x. Rep ExperimentalCapability x -> ExperimentalCapability
to :: forall x. Rep ExperimentalCapability x -> ExperimentalCapability
Generic)
    deriving newtype ([ExperimentalCapability] -> Value
[ExperimentalCapability] -> Encoding
ExperimentalCapability -> Bool
ExperimentalCapability -> Value
ExperimentalCapability -> Encoding
(ExperimentalCapability -> Value)
-> (ExperimentalCapability -> Encoding)
-> ([ExperimentalCapability] -> Value)
-> ([ExperimentalCapability] -> Encoding)
-> (ExperimentalCapability -> Bool)
-> ToJSON ExperimentalCapability
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ExperimentalCapability -> Value
toJSON :: ExperimentalCapability -> Value
$ctoEncoding :: ExperimentalCapability -> Encoding
toEncoding :: ExperimentalCapability -> Encoding
$ctoJSONList :: [ExperimentalCapability] -> Value
toJSONList :: [ExperimentalCapability] -> Value
$ctoEncodingList :: [ExperimentalCapability] -> Encoding
toEncodingList :: [ExperimentalCapability] -> Encoding
$comitField :: ExperimentalCapability -> Bool
omitField :: ExperimentalCapability -> Bool
ToJSON, Maybe ExperimentalCapability
Value -> Parser [ExperimentalCapability]
Value -> Parser ExperimentalCapability
(Value -> Parser ExperimentalCapability)
-> (Value -> Parser [ExperimentalCapability])
-> Maybe ExperimentalCapability
-> FromJSON ExperimentalCapability
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ExperimentalCapability
parseJSON :: Value -> Parser ExperimentalCapability
$cparseJSONList :: Value -> Parser [ExperimentalCapability]
parseJSONList :: Value -> Parser [ExperimentalCapability]
$comittedField :: Maybe ExperimentalCapability
omittedField :: Maybe ExperimentalCapability
FromJSON)

-- | Capabilities a client may support
data ClientCapabilities = ClientCapabilities
    { ClientCapabilities -> Maybe RootsCapability
roots :: Maybe RootsCapability
    , ClientCapabilities -> Maybe SamplingCapability
sampling :: Maybe SamplingCapability
    , ClientCapabilities -> Maybe ElicitationCapability
elicitation :: Maybe ElicitationCapability
    , ClientCapabilities -> Maybe ExperimentalCapability
experimental :: Maybe ExperimentalCapability
    }
    deriving stock (Int -> ClientCapabilities -> ShowS
[ClientCapabilities] -> ShowS
ClientCapabilities -> String
(Int -> ClientCapabilities -> ShowS)
-> (ClientCapabilities -> String)
-> ([ClientCapabilities] -> ShowS)
-> Show ClientCapabilities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClientCapabilities -> ShowS
showsPrec :: Int -> ClientCapabilities -> ShowS
$cshow :: ClientCapabilities -> String
show :: ClientCapabilities -> String
$cshowList :: [ClientCapabilities] -> ShowS
showList :: [ClientCapabilities] -> ShowS
Show, ClientCapabilities -> ClientCapabilities -> Bool
(ClientCapabilities -> ClientCapabilities -> Bool)
-> (ClientCapabilities -> ClientCapabilities -> Bool)
-> Eq ClientCapabilities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClientCapabilities -> ClientCapabilities -> Bool
== :: ClientCapabilities -> ClientCapabilities -> Bool
$c/= :: ClientCapabilities -> ClientCapabilities -> Bool
/= :: ClientCapabilities -> ClientCapabilities -> Bool
Eq, (forall x. ClientCapabilities -> Rep ClientCapabilities x)
-> (forall x. Rep ClientCapabilities x -> ClientCapabilities)
-> Generic ClientCapabilities
forall x. Rep ClientCapabilities x -> ClientCapabilities
forall x. ClientCapabilities -> Rep ClientCapabilities x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClientCapabilities -> Rep ClientCapabilities x
from :: forall x. ClientCapabilities -> Rep ClientCapabilities x
$cto :: forall x. Rep ClientCapabilities x -> ClientCapabilities
to :: forall x. Rep ClientCapabilities x -> ClientCapabilities
Generic)

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

-- | Capabilities that a server may support
data ServerCapabilities = ServerCapabilities
    { ServerCapabilities -> Maybe LoggingCapability
logging :: Maybe LoggingCapability
    , ServerCapabilities -> Maybe PromptsCapability
prompts :: Maybe PromptsCapability
    , ServerCapabilities -> Maybe ResourcesCapability
resources :: Maybe ResourcesCapability
    , ServerCapabilities -> Maybe ToolsCapability
tools :: Maybe ToolsCapability
    , ServerCapabilities -> Maybe CompletionsCapability
completions :: Maybe CompletionsCapability
    , ServerCapabilities -> Maybe ExperimentalCapability
experimental :: Maybe ExperimentalCapability
    }
    deriving stock (Int -> ServerCapabilities -> ShowS
[ServerCapabilities] -> ShowS
ServerCapabilities -> String
(Int -> ServerCapabilities -> ShowS)
-> (ServerCapabilities -> String)
-> ([ServerCapabilities] -> ShowS)
-> Show ServerCapabilities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerCapabilities -> ShowS
showsPrec :: Int -> ServerCapabilities -> ShowS
$cshow :: ServerCapabilities -> String
show :: ServerCapabilities -> String
$cshowList :: [ServerCapabilities] -> ShowS
showList :: [ServerCapabilities] -> ShowS
Show, ServerCapabilities -> ServerCapabilities -> Bool
(ServerCapabilities -> ServerCapabilities -> Bool)
-> (ServerCapabilities -> ServerCapabilities -> Bool)
-> Eq ServerCapabilities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerCapabilities -> ServerCapabilities -> Bool
== :: ServerCapabilities -> ServerCapabilities -> Bool
$c/= :: ServerCapabilities -> ServerCapabilities -> Bool
/= :: ServerCapabilities -> ServerCapabilities -> Bool
Eq, (forall x. ServerCapabilities -> Rep ServerCapabilities x)
-> (forall x. Rep ServerCapabilities x -> ServerCapabilities)
-> Generic ServerCapabilities
forall x. Rep ServerCapabilities x -> ServerCapabilities
forall x. ServerCapabilities -> Rep ServerCapabilities x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ServerCapabilities -> Rep ServerCapabilities x
from :: forall x. ServerCapabilities -> Rep ServerCapabilities x
$cto :: forall x. Rep ServerCapabilities x -> ServerCapabilities
to :: forall x. Rep ServerCapabilities x -> ServerCapabilities
Generic)

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

-- | Describes the name and version of an MCP implementation
data Implementation = Implementation
    { Implementation -> Text
name :: Text
    , Implementation -> Maybe Text
title :: Maybe Text
    , Implementation -> Text
version :: Text
    }
    deriving stock (Int -> Implementation -> ShowS
[Implementation] -> ShowS
Implementation -> String
(Int -> Implementation -> ShowS)
-> (Implementation -> String)
-> ([Implementation] -> ShowS)
-> Show Implementation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Implementation -> ShowS
showsPrec :: Int -> Implementation -> ShowS
$cshow :: Implementation -> String
show :: Implementation -> String
$cshowList :: [Implementation] -> ShowS
showList :: [Implementation] -> ShowS
Show, Implementation -> Implementation -> Bool
(Implementation -> Implementation -> Bool)
-> (Implementation -> Implementation -> Bool) -> Eq Implementation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Implementation -> Implementation -> Bool
== :: Implementation -> Implementation -> Bool
$c/= :: Implementation -> Implementation -> Bool
/= :: Implementation -> Implementation -> Bool
Eq, (forall x. Implementation -> Rep Implementation x)
-> (forall x. Rep Implementation x -> Implementation)
-> Generic Implementation
forall x. Rep Implementation x -> Implementation
forall x. Implementation -> Rep Implementation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Implementation -> Rep Implementation x
from :: forall x. Implementation -> Rep Implementation x
$cto :: forall x. Rep Implementation x -> Implementation
to :: forall x. Rep Implementation x -> Implementation
Generic)

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

-- | Represents a root directory or file that the server can operate on
data Root = Root
    { Root -> Text
uri :: Text
    , Root -> Maybe Text
name :: Maybe Text
    , Root -> Maybe Metadata
_meta :: Maybe Metadata
    }
    deriving stock (Int -> Root -> ShowS
[Root] -> ShowS
Root -> String
(Int -> Root -> ShowS)
-> (Root -> String) -> ([Root] -> ShowS) -> Show Root
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Root -> ShowS
showsPrec :: Int -> Root -> ShowS
$cshow :: Root -> String
show :: Root -> String
$cshowList :: [Root] -> ShowS
showList :: [Root] -> ShowS
Show, Root -> Root -> Bool
(Root -> Root -> Bool) -> (Root -> Root -> Bool) -> Eq Root
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Root -> Root -> Bool
== :: Root -> Root -> Bool
$c/= :: Root -> Root -> Bool
/= :: Root -> Root -> Bool
Eq, (forall x. Root -> Rep Root x)
-> (forall x. Rep Root x -> Root) -> Generic Root
forall x. Rep Root x -> Root
forall x. Root -> Rep Root x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Root -> Rep Root x
from :: forall x. Root -> Rep Root x
$cto :: forall x. Rep Root x -> Root
to :: forall x. Rep Root x -> Root
Generic)

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

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

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