mcp-server 0.1.0.5 → 0.1.0.6

raw patch · 7 files changed

+63/−88 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +35/−5
• mcp-server.cabal +2/−2
• src/MCP/Server.hs +6/−24
• src/MCP/Server/Derive.hs +3/−12
• src/MCP/Server/Protocol.hs +12/−21
• src/MCP/Server/Types.hs +3/−20
• test/Main.hs +2/−4

@@ -8,7 +8,6 @@ - **Type-Safe API**: Leverage Haskell's type system for robust MCP servers - **Multiple Abstractions**: Both low-level fine-grained control and high-level derived interfaces - **Template Haskell Support**: Automatic handler derivation from data types-- **Pagination Support**: Cursor-based pagination for large result sets  ## Supported MCP Features @@ -21,6 +20,15 @@  ## Quick Start +Add the library `mcp-server` to your cabal file:++```cabal+build-depends:+  mcp-server+```++Create a simple module, such as this example below:+ ```haskell {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}@@ -62,6 +70,28 @@       } ``` +## Custom Descriptions++You can provide custom descriptions for constructors and fields using the `*WithDescription` variants:++```haskell+-- Define descriptions for constructors and fields+descriptions :: [(String, String)]+descriptions = +  [ ("Recipe", "Generate a recipe for a specific dish")     -- Constructor description+  , ("Search", "Search our menu database")                  -- Constructor description+  , ("idea", "The dish you want a recipe for")              -- Field description+  , ("query", "Search terms to find menu items")            -- Field description+  ]++-- Use in derivation+handlers = McpServerHandlers+  { prompts = Just $(derivePromptHandlerWithDescription ''MyPrompt 'handlePrompt descriptions)+  , tools = Just $(deriveToolHandlerWithDescription ''MyTool 'handleTool descriptions)+  , resources = Just $(deriveResourceHandlerWithDescription ''MyResource 'handleResource descriptions)+  }+```+ ## Manual Handler Implementation  For fine-grained control, implement handlers manually:@@ -70,7 +100,7 @@ import MCP.Server  -- Manual handler implementation-promptListHandler :: Maybe Cursor -> IO (PaginatedResult [PromptDefinition])+promptListHandler :: IO [PromptDefinition] promptGetHandler :: PromptName -> [(ArgumentName, ArgumentValue)] -> IO (Either Error Content) -- ... implement your custom logic @@ -86,10 +116,10 @@  ## Examples -The library includes three complete examples:+The library includes complete examples: -- **`examples/HighLevel.hs`**: Manual high-level implementation-- **`examples/TemplateHaskell.hs`**: Automatic Template Haskell derivation+- **`examples/Simple/`**: Basic key-value store using Template Haskell derivation+- **`examples/Complete/`**: Full-featured example with prompts, resources, and tools  ## Docker Usage 

@@ -15,14 +15,14 @@ -- PVP summary:     +-+------- breaking API changes --                  | | +----- non-breaking API additions --                  | | | +--- code changes with no API change-version: 0.1.0.5+version: 0.1.0.6 -- A short (one-line) description of the package. synopsis: Library for building Model Context Protocol (MCP) servers -- A longer description of the package. description:   A fully featured library for building MCP (Model Context Protocol) servers.   Supports both low-level fine-grained handling and high-level derived interfaces-  for prompts, resources, and tools. Includes JSON-RPC transport, pagination,+  for prompts, resources, and tools. Includes JSON-RPC transport   and stdin/stdout communication.  -- The license under which the package is released.

@@ -187,15 +187,9 @@       , errorData = Nothing       }     Just (listHandler, _) -> do-      let cursor = case requestParams req of-            Just params -> case fromJSON params of-              Success listReq -> promptsListCursor listReq-              _               -> Nothing-            Nothing -> Nothing-      paginatedResult <- listHandler cursor+      promptsList <- listHandler       let response = PromptsListResponse-            { promptsListPrompts = paginatedItems paginatedResult-            , promptsListNextCursor = paginatedNextCursor paginatedResult+            { promptsListPrompts = promptsList             }       return $ makeSuccessResponse (requestId req) (toJSON response) @@ -248,15 +242,9 @@       , errorData = Nothing       }     Just (listHandler, _) -> do-      let cursor = case requestParams req of-            Just params -> case fromJSON params of-              Success listReq -> resourcesListCursor listReq-              _               -> Nothing-            Nothing -> Nothing-      paginatedResult <- listHandler cursor+      resourcesList <- listHandler       let response = ResourcesListResponse-            { resourcesListResources = paginatedItems paginatedResult-            , resourcesListNextCursor = paginatedNextCursor paginatedResult+            { resourcesListResources = resourcesList             }       return $ makeSuccessResponse (requestId req) (toJSON response) @@ -307,15 +295,9 @@       , errorData = Nothing       }     Just (listHandler, _) -> do-      let cursor = case requestParams req of-            Just params -> case fromJSON params of-              Success listReq -> toolsListCursor listReq-              _               -> Nothing-            Nothing -> Nothing-      paginatedResult <- listHandler cursor+      toolsList <- listHandler       let response = ToolsListResponse-            { toolsListTools = paginatedItems paginatedResult-            , toolsListNextCursor = paginatedNextCursor paginatedResult+            { toolsListTools = toolsList             }       return $ makeSuccessResponse (requestId req) (toJSON response) 

@@ -44,10 +44,7 @@       promptDefs <- sequence $ map (mkPromptDefWithDescription descriptions) constructors        -- Generate list handler-      listHandlerExp <- [| \_cursor -> pure $ PaginatedResult-        { paginatedItems = $(return $ ListE promptDefs)-        , paginatedNextCursor = Nothing-        } |]+      listHandlerExp <- [| pure $(return $ ListE promptDefs) |]        -- Generate get handler with cases       cases <- sequence $ map (mkPromptCase handlerName) constructors@@ -207,10 +204,7 @@       -- Generate resource definitions       resourceDefs <- sequence $ map (mkResourceDefWithDescription descriptions) constructors -      listHandlerExp <- [| \_cursor -> pure $ PaginatedResult-        { paginatedItems = $(return $ ListE resourceDefs)-        , paginatedNextCursor = Nothing-        } |]+      listHandlerExp <- [| pure $(return $ ListE resourceDefs) |]        -- Generate read handler with cases       cases <- sequence $ map (mkResourceCase handlerName) constructors@@ -268,10 +262,7 @@       -- Generate tool definitions       toolDefs <- sequence $ map (mkToolDefWithDescription descriptions) constructors -      listHandlerExp <- [| \_cursor -> pure $ PaginatedResult-        { paginatedItems = $(return $ ListE toolDefs)-        , paginatedNextCursor = Nothing-        } |]+      listHandlerExp <- [| pure $(return $ ListE toolDefs) |]        -- Generate call handler with cases       cases <- sequence $ map (mkToolCase handlerName) constructors

@@ -121,23 +121,20 @@  -- | Prompts list request data PromptsListRequest = PromptsListRequest-  { promptsListCursor :: Maybe Cursor-  } deriving (Show, Eq, Generic)+  deriving (Show, Eq, Generic)  instance FromJSON PromptsListRequest where-  parseJSON = withObject "PromptsListRequest" $ \o -> PromptsListRequest-    <$> o .:? "cursor"+  parseJSON _ = return PromptsListRequest  -- | Prompts list response data PromptsListResponse = PromptsListResponse   { promptsListPrompts :: [PromptDefinition]-  , promptsListNextCursor :: Maybe Cursor   } deriving (Show, Eq, Generic)  instance ToJSON PromptsListResponse where-  toJSON resp = object $+  toJSON resp = object     [ "prompts" .= promptsListPrompts resp-    ] ++ maybe [] (\c -> ["nextCursor" .= c]) (promptsListNextCursor resp)+    ]  -- | Prompts get request data PromptsGetRequest = PromptsGetRequest@@ -163,23 +160,20 @@  -- | Resources list request data ResourcesListRequest = ResourcesListRequest-  { resourcesListCursor :: Maybe Cursor-  } deriving (Show, Eq, Generic)+  deriving (Show, Eq, Generic)  instance FromJSON ResourcesListRequest where-  parseJSON = withObject "ResourcesListRequest" $ \o -> ResourcesListRequest-    <$> o .:? "cursor"+  parseJSON _ = return ResourcesListRequest  -- | Resources list response data ResourcesListResponse = ResourcesListResponse   { resourcesListResources :: [ResourceDefinition]-  , resourcesListNextCursor :: Maybe Cursor   } deriving (Show, Eq, Generic)  instance ToJSON ResourcesListResponse where-  toJSON resp = object $+  toJSON resp = object     [ "resources" .= resourcesListResources resp-    ] ++ maybe [] (\c -> ["nextCursor" .= c]) (resourcesListNextCursor resp)+    ]  -- | Resources read request data ResourcesReadRequest = ResourcesReadRequest@@ -205,23 +199,20 @@  -- | Tools list request data ToolsListRequest = ToolsListRequest-  { toolsListCursor :: Maybe Cursor-  } deriving (Show, Eq, Generic)+  deriving (Show, Eq, Generic)  instance FromJSON ToolsListRequest where-  parseJSON = withObject "ToolsListRequest" $ \o -> ToolsListRequest-    <$> o .:? "cursor"+  parseJSON _ = return ToolsListRequest  -- | Tools list response data ToolsListResponse = ToolsListResponse   { toolsListTools :: [ToolDefinition]-  , toolsListNextCursor :: Maybe Cursor   } deriving (Show, Eq, Generic)  instance ToJSON ToolsListResponse where-  toJSON resp = object $+  toJSON resp = object     [ "tools" .= toolsListTools resp-    ] ++ maybe [] (\c -> ["nextCursor" .= c]) (toolsListNextCursor resp)+    ]  -- | Tools call request data ToolsCallRequest = ToolsCallRequest

@@ -34,8 +34,6 @@   , ResourceReadHandler   , ToolListHandler   , ToolCallHandler-  , PaginatedResult(..)-  , Cursor(..)      -- * Basic Types   , PromptName@@ -289,30 +287,15 @@     , fmap ("logging" .=) (capabilityLogging caps)     ] --- | Cursor for pagination-newtype Cursor = Cursor Text-  deriving (Show, Eq, Generic) -instance ToJSON Cursor where-  toJSON (Cursor c) = toJSON c--instance FromJSON Cursor where-  parseJSON = fmap Cursor . parseJSON---- | Pagination result wrapper-data PaginatedResult a = PaginatedResult-  { paginatedItems      :: a-  , paginatedNextCursor :: Maybe Cursor-  } deriving (Show, Eq, Generic)- -- | Handler type definitions-type PromptListHandler m = Maybe Cursor -> m (PaginatedResult [PromptDefinition])+type PromptListHandler m = m [PromptDefinition] type PromptGetHandler m = PromptName -> [(ArgumentName, ArgumentValue)] -> m (Either Error Content) -type ResourceListHandler m = Maybe Cursor -> m (PaginatedResult [ResourceDefinition])+type ResourceListHandler m = m [ResourceDefinition] type ResourceReadHandler m = URI -> m (Either Error Content) -type ToolListHandler m = Maybe Cursor -> m (PaginatedResult [ToolDefinition])+type ToolListHandler m = m [ToolDefinition] type ToolCallHandler m = ToolName -> [(ArgumentName, ArgumentValue)] -> m (Either Error Content)  -- | Server handlers

@@ -234,8 +234,7 @@ testCustomDescriptions = do     let (toolListHandler, _) = testToolHandlersWithDescriptions     -    paginatedResult <- toolListHandler Nothing-    let toolDefs = paginatedItems paginatedResult+    toolDefs <- toolListHandler          -- Find the Echo tool definition and check its description     let echoDef = filter (\def -> toolDefinitionName def == "echo") toolDefs@@ -272,8 +271,7 @@ testSchemaGeneration = do     let (toolListHandler, _) = testToolHandlers     -    paginatedResult <- toolListHandler Nothing-    let toolDefs = paginatedItems paginatedResult+    toolDefs <- toolListHandler          -- Find the Calculate tool definition     let calculateDef = filter (\def -> toolDefinitionName def == "calculate") toolDefs