packages feed

mcp-server 0.1.0.8 → 0.1.0.9

raw patch · 8 files changed

+639/−490 lines, 8 filesdep +hspecdep ~QuickCheckdep ~aesondep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: hspec

Dependency ranges changed: QuickCheck, aeson, base, containers, network-uri, template-haskell, text

API changes (from Hackage documentation)

Files

mcp-server.cabal view
@@ -15,7 +15,7 @@ -- PVP summary:     +-+------- breaking API changes --                  | | +----- non-breaking API additions --                  | | | +--- code changes with no API change-version: 0.1.0.8+version: 0.1.0.9 -- A short (one-line) description of the package. synopsis: Library for building Model Context Protocol (MCP) servers -- A longer description of the package.@@ -74,11 +74,11 @@   -- Other library packages from which modules are imported.   build-depends:     aeson >=2.0 && <3.0,-    base ^>=4.20.0.0,+    base >=4.20.0 && <4.22,     bytestring >=0.10 && <0.13,     containers >=0.6 && <0.8,     network-uri >=2.6 && <2.8,-    template-haskell >=2.16 && <2.23,+    template-haskell >=2.16 && <2.24,     text >=1.2 && <3.0,    -- Directories containing source files.@@ -97,11 +97,11 @@   -- other-extensions:   -- Other library packages from which modules are imported.   build-depends:-    base ^>=4.20.0.0,-    containers >=0.6 && <0.8,+    base,+    containers,     mcp-server,-    network-uri >=2.6 && <2.8,-    text >=1.2 && <3.0,+    network-uri,+    text,    -- Directories containing source files.   hs-source-dirs: app@@ -119,9 +119,9 @@   -- other-extensions:   -- Other library packages from which modules are imported.   build-depends:-    base ^>=4.20.0.0,+    base,     mcp-server,-    text >=1.2 && <3.0,+    text,    -- Directories containing source files.   hs-source-dirs: examples/Simple@@ -139,9 +139,9 @@   -- other-extensions:   -- Other library packages from which modules are imported.   build-depends:-    base ^>=4.20.0.0,+    base,     mcp-server,-    text >=1.2 && <3.0,+    text,    -- Directories containing source files.   hs-source-dirs: examples/Complete@@ -154,7 +154,14 @@   -- Base language which the package is written in.   default-language: GHC2024   -- Modules included in this executable, other than Main.-  other-modules: TestTypes+  other-modules:+    Spec.AdvancedDerivation+    Spec.BasicDerivation+    Spec.JSONConversion+    Spec.SchemaValidation+    TestData+    TestTypes+   -- LANGUAGE extensions used by modules in this package.   -- other-extensions:   -- The interface type and version of the test suite.@@ -162,14 +169,15 @@   -- Directories containing source files.   hs-source-dirs: test   -- The entrypoint to the test suite.-  main-is: Main.hs+  main-is: HspecMain.hs   -- Test dependencies.   build-depends:-    QuickCheck >=2.14 && <2.16,-    aeson >=2.0 && <3.0,-    base ^>=4.20.0.0,-    containers >=0.6 && <0.8,+    QuickCheck,+    aeson,+    base,+    containers,+    hspec,     mcp-server,-    network-uri >=2.6 && <2.8,-    template-haskell >=2.16 && <2.23,-    text >=1.2 && <3.0,+    network-uri,+    template-haskell,+    text,
+ test/HspecMain.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import Test.Hspec+import qualified Spec.JSONConversion+import qualified Spec.BasicDerivation+import qualified Spec.SchemaValidation+import qualified Spec.AdvancedDerivation++main :: IO ()+main = hspec $ do+  describe "MCP Server" $ do+    Spec.JSONConversion.spec+    Spec.BasicDerivation.spec+    Spec.SchemaValidation.spec+    Spec.AdvancedDerivation.spec
− test/Main.hs 
@@ -1,470 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell   #-}--module Main (main) where--import           Data.Aeson              (Value(..), toJSON)-import           Data.Text               (Text)-import qualified Data.Text               as T-import           MCP.Server-import           MCP.Server.Derive-import           Network.URI             (parseURI)-import           Test.QuickCheck-import           TestTypes-import           Text.Read               (readMaybe)---- =============================================================================--- JSON Type Conversion Tests--- =============================================================================---- Test conversion from JSON Value to Text and back-prop_intRoundTrip :: Int -> Bool-prop_intRoundTrip i = -    let jsonVal = toJSON i-        textVal = jsonValueToText jsonVal-        parsed = case readMaybe (T.unpack textVal) of-                   Just result -> result-                   Nothing -> error $ "Failed to parse Int from: " <> T.unpack textVal-    in parsed == i--prop_boolRoundTrip :: Bool -> Bool-prop_boolRoundTrip b = -    let jsonVal = toJSON b-        textVal = jsonValueToText jsonVal-        parsed = case T.toLower textVal of-                   "true" -> True-                   "false" -> False-                   _ -> error $ "Failed to parse Bool from: " <> T.unpack textVal-    in parsed == b--prop_textRoundTrip :: Text -> Bool-prop_textRoundTrip t = -    let jsonVal = toJSON t-        textVal = jsonValueToText jsonVal-    in textVal == t---- Test the specific conversion functions we use in the derivation-testIntConversion :: IO Bool-testIntConversion = do-    let testCases = [0, 42, -17, 999999] :: [Int]-    results <- mapM (\i -> do-        let jsonVal = toJSON i-            textVal = jsonValueToText jsonVal-            parsed = case readMaybe (T.unpack textVal) of-                       Just result -> result-                       Nothing -> error $ "Failed to parse: " <> T.unpack textVal-        return (parsed == (i :: Int))-        ) testCases-    return (all id results)--testBoolConversion :: IO Bool-testBoolConversion = do-    let testCases = [True, False]-    results <- mapM (\b -> do-        let jsonVal = toJSON b-            textVal = jsonValueToText jsonVal-            parsed = case T.toLower textVal of-                       "true" -> True-                       "false" -> False-                       _ -> error $ "Failed to parse: " <> T.unpack textVal-        return (parsed == b)-        ) testCases-    return (all id results)--testTextConversion :: IO Bool-testTextConversion = do-    let testCases = ["hello", "world", "", "123", "true", "false"]-    results <- mapM (\t -> do-        let jsonVal = toJSON t-            textVal = jsonValueToText jsonVal-        return (textVal == t)-        ) testCases-    return (all id results)---- Test JSON Value to Text conversion specifically-testJsonValueToText :: IO Bool-testJsonValueToText = do-    let tests = -            [ (Number 42, "42")      -- Whole numbers become integers-            , (Number 42.5, "42.5")  -- Decimals stay as decimals-            , (String "hello", "hello")-            , (Bool True, "true")-            , (Bool False, "false")-            , (Null, "")-            ]-    -    let results = map (\(input, expected) -> jsonValueToText input == expected) tests-    return (all id results)--runJsonTypesTests :: IO Bool-runJsonTypesTests = do-    putStrLn "\n=== JSON Type Conversion Tests ==="-    -    -- QuickCheck property tests-    putStr "Testing Int round-trip property: "-    quickCheck prop_intRoundTrip-    -    putStr "Testing Bool round-trip property: "-    quickCheck prop_boolRoundTrip-    -    -- Manual conversion tests-    putStr "Testing Int conversion: "-    intResult <- testIntConversion-    putStrLn $ if intResult then "PASS" else "FAIL"-    -    putStr "Testing Bool conversion: "-    boolResult <- testBoolConversion-    putStrLn $ if boolResult then "PASS" else "FAIL"-    -    putStr "Testing Text conversion: "-    textResult <- testTextConversion-    putStrLn $ if textResult then "PASS" else "FAIL"-    -    putStr "Testing jsonValueToText function: "-    jsonResult <- testJsonValueToText-    putStrLn $ if jsonResult then "PASS" else "FAIL"-    -    let allPassed = intResult && boolResult && textResult && jsonResult-    putStrLn $ "JSON Types result: " ++ if allPassed then "PASS" else "FAIL"-    return allPassed---- =============================================================================--- End-to-End Derivation Tests--- =============================================================================---- Generate handlers using Template Haskell (importing types from TestTypes module)-testPromptHandlers :: (PromptListHandler IO, PromptGetHandler IO)-testPromptHandlers = $(derivePromptHandler ''TestPrompt 'handleTestPrompt)--testResourceHandlers :: (ResourceListHandler IO, ResourceReadHandler IO)-testResourceHandlers = $(deriveResourceHandler ''TestResource 'handleTestResource)--testToolHandlers :: (ToolListHandler IO, ToolCallHandler IO)-testToolHandlers = $(deriveToolHandler ''TestTool 'handleTestTool)---- Test handlers with custom descriptions-testToolHandlersWithDescriptions :: (ToolListHandler IO, ToolCallHandler IO)-testToolHandlersWithDescriptions = $(deriveToolHandlerWithDescription ''TestTool 'handleTestTool testDescriptions)---- Test case for separate parameter types approach (should fail with current implementation)-testSeparateParamsToolHandlers :: (ToolListHandler IO, ToolCallHandler IO)-testSeparateParamsToolHandlers = $(deriveToolHandler ''SeparateParamsTool 'handleSeparateParamsTool)---- Test case for recursive parameter types-testRecursiveToolHandlers :: (ToolListHandler IO, ToolCallHandler IO)-testRecursiveToolHandlers = $(deriveToolHandler ''RecursiveTool 'handleRecursiveTool)---- Test case for separate parameter types with descriptions-testSeparateParamsToolHandlersWithDescriptions :: (ToolListHandler IO, ToolCallHandler IO)-testSeparateParamsToolHandlersWithDescriptions = $(deriveToolHandlerWithDescription ''SeparateParamsTool 'handleSeparateParamsTool separateParamsDescriptions)---- Test case for recursive parameter types with descriptions-testRecursiveToolHandlersWithDescriptions :: (ToolListHandler IO, ToolCallHandler IO)-testRecursiveToolHandlersWithDescriptions = $(deriveToolHandlerWithDescription ''RecursiveTool 'handleRecursiveTool separateParamsDescriptions)---- End-to-end test functions-testPromptDerivation :: IO Bool-testPromptDerivation = do-    let (_, getHandler) = testPromptHandlers-    -    -- Test simple prompt-    result1 <- getHandler "simple_prompt" [("message", "hello")]-    let test1 = case result1 of-            Right (ContentText content) -> content == "Simple prompt: hello"-            _ -> False-    -    -- Test complex prompt with multiple types-    result2 <- getHandler "complex_prompt" [("title", "urgent task"), ("priority", "5"), ("urgent", "true")]-    let test2 = case result2 of-            Right (ContentText content) -> content == "Complex prompt: urgent task (priority=5, urgent=True)"-            _ -> False-    -    -- Test optional prompt with missing optional field-    result3 <- getHandler "optional_prompt" [("required", "test")]-    let test3 = case result3 of-            Right (ContentText content) -> content == "Optional prompt: test"-            _ -> False-    -    -- Test optional prompt with optional field present-    result4 <- getHandler "optional_prompt" [("required", "test"), ("optional", "42")]-    let test4 = case result4 of-            Right (ContentText content) -> content == "Optional prompt: test optional=42"-            _ -> False-    -    return (test1 && test2 && test3 && test4)--testSeparateParamsDerivation :: IO Bool-testSeparateParamsDerivation = do-    putStrLn "Testing separate parameter types derivation..."-    -    -- Test the separate parameter types approach-    let (listHandler, callHandler) = testSeparateParamsToolHandlers-    -    -- First test that tool definitions are generated correctly-    toolDefs <- listHandler-    let getValueDef = filter (\def -> toolDefinitionName def == "get_value") toolDefs-    let setValueDef = filter (\def -> toolDefinitionName def == "set_value") toolDefs-    -    let schemaTest = case (getValueDef, setValueDef) of-            ([getDef], [setDef]) -> -                let getProps = case toolDefinitionInputSchema getDef of-                        InputSchemaDefinitionObject props _ -> map fst props-                    setProps = case toolDefinitionInputSchema setDef of  -                        InputSchemaDefinitionObject props _ -> map fst props-                in "_gvpKey" `elem` getProps && "_svpKey" `elem` setProps && "_svpValue" `elem` setProps-            _ -> False-    -    putStrLn $ "  Schema generation: " ++ (if schemaTest then "PASS" else "FAIL")-    -    -- Test GetValue with separate params-    result1 <- callHandler "get_value" [("_gvpKey", "mykey")]-    let test1 = case result1 of-            Right (ContentText content) -> content == "Getting value for key: mykey"-            _ -> False-    -    putStrLn $ "  GetValue execution: " ++ (if test1 then "PASS" else "FAIL")-    -    -- Test SetValue with separate params  -    result2 <- callHandler "set_value" [("_svpKey", "mykey"), ("_svpValue", "myvalue")]-    let test2 = case result2 of-            Right (ContentText content) -> content == "Setting mykey = myvalue"-            _ -> False-    -    putStrLn $ "  SetValue execution: " ++ (if test2 then "PASS" else "FAIL")-    -    -- Test recursive parameter types-    let (recursiveListHandler, recursiveCallHandler) = testRecursiveToolHandlers-    recursiveToolDefs <- recursiveListHandler-    let processDataDef = filter (\def -> toolDefinitionName def == "process_data") recursiveToolDefs-    -    let recursiveSchemaTest = case processDataDef of-            [def] -> case toolDefinitionInputSchema def of-                InputSchemaDefinitionObject props _ -> -                    let propNames = map fst props-                    in "_ipName" `elem` propNames && "_ipAge" `elem` propNames-            _ -> False-    -    putStrLn $ "  Recursive schema generation: " ++ (if recursiveSchemaTest then "PASS" else "FAIL")-    -    -- Test recursive execution-    result3 <- recursiveCallHandler "process_data" [("_ipName", "Alice"), ("_ipAge", "30")]-    let test3 = case result3 of-            Right (ContentText content) -> content == "Processing data for Alice (age 30)"-            _ -> False-    -    putStrLn $ "  Recursive execution: " ++ (if test3 then "PASS" else "FAIL")-    -    -- Test descriptions with separate parameter types-    let (descListHandler, _) = testSeparateParamsToolHandlersWithDescriptions-    descToolDefs <- descListHandler-    let getValueDefWithDesc = filter (\def -> toolDefinitionName def == "get_value") descToolDefs-    let setValueDefWithDesc = filter (\def -> toolDefinitionName def == "set_value") descToolDefs-    -    let descriptionTest = case (getValueDefWithDesc, setValueDefWithDesc) of-            ([getDef], [setDef]) -> -                let getDefDescCorrect = toolDefinitionDescription getDef == "Retrieves a value from the key-value store"-                    setDefDescCorrect = toolDefinitionDescription setDef == "Sets a value in the key-value store"-                    getFieldDescsCorrect = case toolDefinitionInputSchema getDef of-                        InputSchemaDefinitionObject props _ -> -                            case lookup "_gvpKey" props of-                                Just prop -> propertyDescription prop == "The key to retrieve the value for"-                                Nothing -> False-                    setFieldDescsCorrect = case toolDefinitionInputSchema setDef of-                        InputSchemaDefinitionObject props _ ->-                            let keyDesc = case lookup "_svpKey" props of-                                    Just prop -> propertyDescription prop == "The key to set the value for"-                                    Nothing -> False-                                valueDesc = case lookup "_svpValue" props of-                                    Just prop -> propertyDescription prop == "The value to store"-                                    Nothing -> False-                            in keyDesc && valueDesc-                in getDefDescCorrect && setDefDescCorrect && getFieldDescsCorrect && setFieldDescsCorrect-            _ -> False-    -    putStrLn $ "  Description support: " ++ (if descriptionTest then "PASS" else "FAIL")-    -    -- Test recursive descriptions-    let (recursiveDescListHandler, _) = testRecursiveToolHandlersWithDescriptions-    recursiveDescToolDefs <- recursiveDescListHandler-    let processDataDefWithDesc = filter (\def -> toolDefinitionName def == "process_data") recursiveDescToolDefs-    -    let recursiveDescTest = case processDataDefWithDesc of-            [procDef] -> -                let procDefDescCorrect = toolDefinitionDescription procDef == "Processes user data with age validation"-                    procFieldDescsCorrect = case toolDefinitionInputSchema procDef of-                        InputSchemaDefinitionObject props _ ->-                            let nameDesc = case lookup "_ipName" props of-                                    Just prop -> propertyDescription prop == "The person's full name"-                                    Nothing -> False-                                ageDesc = case lookup "_ipAge" props of-                                    Just prop -> propertyDescription prop == "The person's age in years"-                                    Nothing -> False-                            in nameDesc && ageDesc-                in procDefDescCorrect && procFieldDescsCorrect-            _ -> False-    -    putStrLn $ "  Recursive description support: " ++ (if recursiveDescTest then "PASS" else "FAIL")-    -    return (schemaTest && test1 && test2 && recursiveSchemaTest && test3 && descriptionTest && recursiveDescTest)--testResourceDerivation :: IO Bool-testResourceDerivation = do-    let (_, readHandler) = testResourceHandlers-    -    -- Test simple resource-    case parseURI "resource://config_file" of-        Just uri1 -> do-            result1 <- readHandler uri1-            let test1 = case result1 of-                    Right (ContentText content) -> T.isInfixOf "Config file contents" content-                    _ -> False-            -            -- Test parameterized resource (this would need to match actual schema)-            case parseURI "resource://database_connection" of-                Just uri2 -> do-                    result2 <- readHandler uri2-                    let test2 = case result2 of-                            Right (ContentText content) -> T.isInfixOf "Database at" content-                            _ -> False-                    return (test1 && test2)-                Nothing -> return False-        Nothing -> return False--testToolDerivation :: IO Bool-testToolDerivation = do-    let (_, callHandler) = testToolHandlers-    -    -- Test simple tool-    result1 <- callHandler "echo" [("text", "hello world")]-    let test1 = case result1 of-            Right (ContentText content) -> content == "Echo: hello world"-            _ -> False-    -    -- Test tool with multiple typed parameters-    result2 <- callHandler "calculate" [("operation", "add"), ("x", "10"), ("y", "5")]-    let test2 = case result2 of-            Right (ContentText content) -> content == "15"-            _ -> False-    -    -- Test tool with boolean parameter-    result3 <- callHandler "toggle" [("flag", "true")]-    let test3 = case result3 of-            Right (ContentText content) -> content == "Flag is now: False"-            _ -> False-    -    -- Test tool with optional parameters-    result4 <- callHandler "search" [("query", "test"), ("limit", "10")]-    let test4 = case result4 of-            Right (ContentText content) -> T.isInfixOf "Search results for 'test'" content && T.isInfixOf "(limit=10)" content-            _ -> False-    -    return (test1 && test2 && test3 && test4)--testCustomDescriptions :: IO Bool-testCustomDescriptions = do-    let (toolListHandler, _) = testToolHandlersWithDescriptions-    -    toolDefs <- toolListHandler-    -    -- Find the Echo tool definition and check its description-    let echoDef = filter (\def -> toolDefinitionName def == "echo") toolDefs-    let echoDescTest = case echoDef of-            [def] -> toolDefinitionDescription def == "Echoes the input text back to the user"-            _ -> False-    -    -- Find the Calculate tool definition and check its description and field descriptions-    let calculateDef = filter (\def -> toolDefinitionName def == "calculate") toolDefs-    let calculateTest = case calculateDef of-            [def] -> -                let correctToolDesc = toolDefinitionDescription def == "Performs mathematical calculations"-                    correctFieldDescs = case toolDefinitionInputSchema def of-                        InputSchemaDefinitionObject props _ ->-                            let textDesc = case lookup "text" props of-                                    Just prop -> propertyDescription prop == "The text to echo back"-                                    Nothing -> True  -- text field doesn't exist in Calculate, that's fine-                                operationDesc = case lookup "operation" props of-                                    Just prop -> propertyDescription prop == "The mathematical operation to perform"-                                    Nothing -> False-                                xDesc = case lookup "x" props of-                                    Just prop -> propertyDescription prop == "The first number"-                                    Nothing -> False-                                yDesc = case lookup "y" props of-                                    Just prop -> propertyDescription prop == "The second number"-                                    Nothing -> False-                            in operationDesc && xDesc && yDesc-                in correctToolDesc && correctFieldDescs-            _ -> False-    -    return (echoDescTest && calculateTest)--testSchemaGeneration :: IO Bool-testSchemaGeneration = do-    let (toolListHandler, _) = testToolHandlers-    -    toolDefs <- toolListHandler-    -    -- Find the Calculate tool definition-    let calculateDef = filter (\def -> toolDefinitionName def == "calculate") toolDefs-    case calculateDef of-        [def] -> case toolDefinitionInputSchema def of-            InputSchemaDefinitionObject props required ->-                let hasXInt = case lookup "x" props of-                        Just prop -> propertyType prop == "integer"-                        Nothing -> False-                    hasYInt = case lookup "y" props of-                        Just prop -> propertyType prop == "integer"-                        Nothing -> False-                    hasOpString = case lookup "operation" props of-                        Just prop -> propertyType prop == "string"-                        Nothing -> False-                    hasRequiredFields = all (`elem` required) ["operation", "x", "y"]-                in return (hasXInt && hasYInt && hasOpString && hasRequiredFields)-        _ -> return False--runEndToEndTests :: IO Bool-runEndToEndTests = do-    putStrLn "\n=== End-to-End Derivation Tests ==="-    -    putStr "Testing prompt derivation: "-    promptResult <- testPromptDerivation-    putStrLn $ if promptResult then "PASS" else "FAIL"-    -    putStr "Testing resource derivation: "-    resourceResult <- testResourceDerivation-    putStrLn $ if resourceResult then "PASS" else "FAIL"-    -    putStr "Testing tool derivation: "-    toolResult <- testToolDerivation-    putStrLn $ if toolResult then "PASS" else "FAIL"-    -    putStr "Testing schema generation: "-    schemaResult <- testSchemaGeneration-    putStrLn $ if schemaResult then "PASS" else "FAIL"-    -    putStr "Testing custom descriptions: "-    descriptionResult <- testCustomDescriptions-    putStrLn $ if descriptionResult then "PASS" else "FAIL"-    -    putStr "Testing separate parameter types: "-    separateParamsResult <- testSeparateParamsDerivation-    putStrLn $ if separateParamsResult then "PASS" else "FAIL"-    -    let allPassed = promptResult && resourceResult && toolResult && schemaResult && descriptionResult && separateParamsResult-    putStrLn $ "End-to-End result: " ++ if allPassed then "PASS" else "FAIL"-    return allPassed---- =============================================================================--- Main Test Runner--- =============================================================================--main :: IO ()-main = do-    putStrLn "MCP Server Test Suite"-    putStrLn "===================="-    -    jsonResult <- runJsonTypesTests-    endToEndResult <- runEndToEndTests-    -    let overallResult = jsonResult && endToEndResult-    putStrLn $ "\n===================="-    putStrLn $ "Overall result: " ++ if overallResult then "ALL TESTS PASSED" else "SOME TESTS FAILED"
+ test/Spec/AdvancedDerivation.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-}++module Spec.AdvancedDerivation (spec) where++import Control.Monad (forM_)+import Data.Text (Text)+import qualified Data.Text as T+import MCP.Server+import MCP.Server.Derive+import Test.Hspec+import TestTypes+import TestData++-- Generate advanced handlers for separate parameter types+testSeparateParamsToolHandlers :: (ToolListHandler IO, ToolCallHandler IO)+testSeparateParamsToolHandlers = $(deriveToolHandler ''SeparateParamsTool 'handleSeparateParamsTool)++testRecursiveToolHandlers :: (ToolListHandler IO, ToolCallHandler IO)+testRecursiveToolHandlers = $(deriveToolHandler ''RecursiveTool 'handleRecursiveTool)++testSeparateParamsToolHandlersWithDescriptions :: (ToolListHandler IO, ToolCallHandler IO)+testSeparateParamsToolHandlersWithDescriptions = $(deriveToolHandlerWithDescription ''SeparateParamsTool 'handleSeparateParamsTool separateParamsDescriptions)++testRecursiveToolHandlersWithDescriptions :: (ToolListHandler IO, ToolCallHandler IO)+testRecursiveToolHandlersWithDescriptions = $(deriveToolHandlerWithDescription ''RecursiveTool 'handleRecursiveTool separateParamsDescriptions)++-- Helper functions for advanced testing+findToolByName :: Text -> [ToolDefinition] -> ToolDefinition+findToolByName toolName toolDefs = +  case filter (\def -> toolDefinitionName def == toolName) toolDefs of+    [def] -> def+    [] -> error $ "Tool not found: " ++ T.unpack toolName+    _ -> error $ "Multiple tools found with name: " ++ T.unpack toolName++assertSchemaHasProperties :: [Text] -> ToolDefinition -> IO ()+assertSchemaHasProperties expectedProps toolDef = do+  case toolDefinitionInputSchema toolDef of+    InputSchemaDefinitionObject props _ -> +      let propNames = map fst props+      in all (`elem` propNames) expectedProps `shouldBe` True+    other -> expectationFailure $ "Expected InputSchemaDefinitionObject but got: " ++ show other++assertToolCallResult :: (ToolCallHandler IO) -> Text -> [(Text, Text)] -> Text -> IO ()+assertToolCallResult handler toolName args expectedContent = do+  result <- handler toolName args+  case result of+    Right (ContentText content) -> content `shouldBe` expectedContent+    other -> expectationFailure $ "Expected ContentText but got: " ++ show other++assertToolHasDescription :: Text -> Text -> ToolDefinition -> IO ()+assertToolHasDescription toolName expectedDesc toolDef = do+  toolDefinitionName toolDef `shouldBe` toolName+  toolDefinitionDescription toolDef `shouldBe` expectedDesc++assertPropertyHasDescription :: Text -> Text -> ToolDefinition -> IO ()+assertPropertyHasDescription propName expectedDesc toolDef = do+  case toolDefinitionInputSchema toolDef of+    InputSchemaDefinitionObject props _ -> +      case lookup propName props of+        Just prop -> propertyDescription prop `shouldBe` expectedDesc+        Nothing -> expectationFailure $ "Property not found: " ++ T.unpack propName+    other -> expectationFailure $ "Expected InputSchemaDefinitionObject but got: " ++ show other++spec :: Spec+spec = describe "Advanced Template Haskell Derivation" $ do+  +  describe "Separate Parameter Types" $ do+    it "generates correct schema for separate parameter tools" $ do+      let (listHandler, _) = testSeparateParamsToolHandlers+      toolDefs <- listHandler+      +      -- Test GetValue tool schema+      let getValueDef = findToolByName "get_value" toolDefs+      assertSchemaHasProperties ["_gvpKey"] getValueDef+      +      -- Test SetValue tool schema  +      let setValueDef = findToolByName "set_value" toolDefs+      assertSchemaHasProperties ["_svpKey", "_svpValue"] setValueDef+    +    forM_ separateParamsTestCases $ \testCase ->+      it (T.unpack $ sepTestDescription testCase) $ do+        let (_, callHandler) = testSeparateParamsToolHandlers+        assertToolCallResult callHandler (sepToolName testCase) (sepArgs testCase) (sepExpectedResult testCase)++  describe "Recursive Parameter Types" $ do+    it "generates correct schema for recursive parameter tools" $ do+      let (listHandler, _) = testRecursiveToolHandlers+      toolDefs <- listHandler+      +      let processDataDef = findToolByName "process_data" toolDefs+      assertSchemaHasProperties ["_ipName", "_ipAge"] processDataDef+    +    forM_ recursiveParamsTestCases $ \testCase ->+      it (T.unpack $ recTestDescription testCase) $ do+        let (_, callHandler) = testRecursiveToolHandlers+        assertToolCallResult callHandler (recToolName testCase) (recArgs testCase) (recExpectedResult testCase)++  describe "Custom Descriptions with Separate Parameters" $ do+    it "applies correct tool descriptions for separate parameter tools" $ do+      let (listHandler, _) = testSeparateParamsToolHandlersWithDescriptions+      toolDefs <- listHandler+      +      let getValueDef = findToolByName "get_value" toolDefs+      assertToolHasDescription "get_value" "Retrieves a value from the key-value store" getValueDef+      +      let setValueDef = findToolByName "set_value" toolDefs+      assertToolHasDescription "set_value" "Sets a value in the key-value store" setValueDef+    +    it "applies correct field descriptions for separate parameter tools" $ do+      let (listHandler, _) = testSeparateParamsToolHandlersWithDescriptions+      toolDefs <- listHandler+      +      let getValueDef = findToolByName "get_value" toolDefs+      assertPropertyHasDescription "_gvpKey" "The key to retrieve the value for" getValueDef+      +      let setValueDef = findToolByName "set_value" toolDefs+      assertPropertyHasDescription "_svpKey" "The key to set the value for" setValueDef+      assertPropertyHasDescription "_svpValue" "The value to store" setValueDef++  describe "Recursive Tool Descriptions" $ do+    it "applies correct descriptions for recursive parameter tools" $ do+      let (listHandler, _) = testRecursiveToolHandlersWithDescriptions+      toolDefs <- listHandler+      +      let processDataDef = findToolByName "process_data" toolDefs+      assertToolHasDescription "process_data" "Processes user data with age validation" processDataDef+    +    it "applies correct field descriptions for recursive parameters" $ do+      let (listHandler, _) = testRecursiveToolHandlersWithDescriptions+      toolDefs <- listHandler+      +      let processDataDef = findToolByName "process_data" toolDefs+      assertPropertyHasDescription "_ipName" "The person's full name" processDataDef+      assertPropertyHasDescription "_ipAge" "The person's age in years" processDataDef
+ test/Spec/BasicDerivation.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-}++module Spec.BasicDerivation (spec) where++import Control.Monad (forM_)+import Data.Text (Text)+import qualified Data.Text as T+import MCP.Server+import MCP.Server.Derive+import Network.URI (parseURI)+import Test.Hspec+import TestTypes+import TestData++-- Generate handlers using Template Haskell+testPromptHandlers :: (PromptListHandler IO, PromptGetHandler IO)+testPromptHandlers = $(derivePromptHandler ''TestPrompt 'handleTestPrompt)++testResourceHandlers :: (ResourceListHandler IO, ResourceReadHandler IO)+testResourceHandlers = $(deriveResourceHandler ''TestResource 'handleTestResource)++testToolHandlers :: (ToolListHandler IO, ToolCallHandler IO)+testToolHandlers = $(deriveToolHandler ''TestTool 'handleTestTool)++-- Helper functions for common test patterns+shouldReturnContentText :: IO (Either Error Content) -> Text -> IO ()+shouldReturnContentText action expected = do+  result <- action+  case result of+    Right (ContentText content) -> content `shouldBe` expected+    other -> expectationFailure $ "Expected ContentText '" ++ T.unpack expected ++ "' but got: " ++ show other++shouldContainText :: IO (Either Error Content) -> Text -> IO ()+shouldContainText action expectedSubstring = do+  result <- action+  case result of+    Right (ContentText content) -> +      T.isInfixOf expectedSubstring content `shouldBe` True+    other -> expectationFailure $ "Expected ContentText containing '" ++ T.unpack expectedSubstring ++ "' but got: " ++ show other++testPromptCall :: PromptGetHandler IO -> Text -> [(Text, Text)] -> Text -> IO ()+testPromptCall handler name args expected = +  shouldReturnContentText (handler name args) expected++testResourceCall :: ResourceReadHandler IO -> String -> Text -> IO ()+testResourceCall handler uriString expected = do+  case parseURI uriString of+    Just uri -> shouldReturnContentText (handler uri) expected+    Nothing -> expectationFailure $ "Failed to parse URI: " ++ uriString++testToolCall :: ToolCallHandler IO -> Text -> [(Text, Text)] -> Text -> IO ()+testToolCall handler name args expected = +  shouldReturnContentText (handler name args) expected++spec :: Spec+spec = describe "Basic Template Haskell Derivation" $ do+  +  describe "Prompt derivation" $ do+    let (_, getHandler) = testPromptHandlers+    +    forM_ promptTestCases $ \testCase ->+      it (T.unpack $ testDescription testCase) $ +        testPromptCall getHandler (promptName testCase) (promptArgs testCase) (expectedResult testCase)++  describe "Resource derivation" $ do+    let (_, readHandler) = testResourceHandlers+    +    forM_ resourceTestCases $ \testCase ->+      it (T.unpack $ resourceTestDescription testCase) $ do+        case parseURI (T.unpack $ resourceUri testCase) of+          Just uri -> +            if useSubstringMatch testCase+              then shouldContainText (readHandler uri) (resourceExpectedContent testCase)+              else testResourceCall readHandler (T.unpack $ resourceUri testCase) (resourceExpectedContent testCase)+          Nothing -> expectationFailure $ "Failed to parse URI: " ++ T.unpack (resourceUri testCase)++  describe "Tool derivation" $ do+    let (_, callHandler) = testToolHandlers+    +    forM_ toolTestCases $ \testCase ->+      it (T.unpack $ toolTestDescription testCase) $ +        testToolCall callHandler (toolName testCase) (toolArgs testCase) (toolExpectedResult testCase)
+ test/Spec/JSONConversion.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE OverloadedStrings #-}++module Spec.JSONConversion (spec) where++import Data.Aeson (Value(..), toJSON)+import Data.Text (Text)+import qualified Data.Text as T+import MCP.Server+import Test.Hspec+import Test.QuickCheck+import Text.Read (readMaybe)++-- Arbitrary instance for Text (needed for QuickCheck)+instance Arbitrary Text where+  arbitrary = T.pack <$> arbitrary++spec :: Spec+spec = describe "JSON Type Conversion" $ do+  describe "Property-based tests" $ do+    it "round-trips integers correctly" $ property prop_intRoundTrip+    it "round-trips booleans correctly" $ property prop_boolRoundTrip  +    it "round-trips text correctly" $ property prop_textRoundTrip++  describe "Manual conversion tests" $ do+    it "converts integers manually" testIntConversion+    it "converts booleans manually" testBoolConversion++-- Fixed property-based tests (no more 'error' usage)+prop_intRoundTrip :: Int -> Bool+prop_intRoundTrip i = +    let jsonVal = toJSON i+        textVal = jsonValueToText jsonVal+        parsed = readMaybe (T.unpack textVal)+    in parsed == Just i++prop_boolRoundTrip :: Bool -> Bool+prop_boolRoundTrip b = +    let jsonVal = toJSON b+        textVal = jsonValueToText jsonVal+        parsed = case T.toLower textVal of+                   "true" -> Just True+                   "false" -> Just False+                   _ -> Nothing+    in parsed == Just b++prop_textRoundTrip :: Text -> Bool+prop_textRoundTrip t = +    let jsonVal = toJSON t+        textVal = jsonValueToText jsonVal+    in textVal == t++-- Manual test functions converted to Hspec style+testIntConversion :: IO ()+testIntConversion = do+    let testCases = [0, 42, -17, 999999] :: [Int]+    results <- mapM testSingleInt testCases+    all id results `shouldBe` True+  where+    testSingleInt i = do+        let jsonVal = toJSON i+            textVal = jsonValueToText jsonVal+        case readMaybe (T.unpack textVal) of+            Just parsed -> return (parsed == i)+            Nothing -> do+                expectationFailure $ "Failed to parse Int from: " <> T.unpack textVal+                return False++testBoolConversion :: IO ()+testBoolConversion = do+    let testCases = [True, False]+    results <- mapM testSingleBool testCases+    all id results `shouldBe` True+  where+    testSingleBool b = do+        let jsonVal = toJSON b+            textVal = jsonValueToText jsonVal+            expected = if b then "true" else "false"+        case T.toLower textVal of+            result | result == expected -> return True+            result -> do+                expectationFailure $ "Expected " <> T.unpack expected <> " but got " <> T.unpack result+                return False
+ test/Spec/SchemaValidation.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-}++module Spec.SchemaValidation (spec) where++import Control.Monad (forM_)+import Data.Text (Text)+import qualified Data.Text as T+import MCP.Server+import MCP.Server.Derive+import Test.Hspec+import TestTypes+import TestData++-- Generate handlers for testing+testToolHandlers :: (ToolListHandler IO, ToolCallHandler IO)+testToolHandlers = $(deriveToolHandler ''TestTool 'handleTestTool)++testToolHandlersWithDescriptions :: (ToolListHandler IO, ToolCallHandler IO)+testToolHandlersWithDescriptions = $(deriveToolHandlerWithDescription ''TestTool 'handleTestTool testDescriptions)++-- Helper functions for schema validation+findTool :: Text -> [ToolDefinition] -> ToolDefinition+findTool toolName toolDefs = +  case filter (\def -> toolDefinitionName def == toolName) toolDefs of+    [def] -> def+    [] -> error $ "Tool not found: " ++ T.unpack toolName+    _ -> error $ "Multiple tools found with name: " ++ T.unpack toolName++getProperty :: Text -> ToolDefinition -> InputSchemaDefinitionProperty+getProperty propertyName toolDef = +  case toolDefinitionInputSchema toolDef of+    InputSchemaDefinitionObject props _ -> +      case lookup propertyName props of+        Just prop -> prop+        Nothing -> error $ "Property not found: " ++ T.unpack propertyName+    other -> error $ "Expected InputSchemaDefinitionObject but got: " ++ show other++assertToolExists :: Text -> [ToolDefinition] -> IO ()+assertToolExists toolName toolDefs = do+  toolDefs `shouldSatisfy` any (\def -> toolDefinitionName def == toolName)++assertHasProperty :: Text -> Text -> ToolDefinition -> IO ()+assertHasProperty propertyName expectedType toolDef = do+  let prop = getProperty propertyName toolDef+  propertyType prop `shouldBe` expectedType++assertPropertyDescription :: Text -> ToolDefinition -> Text -> IO ()+assertPropertyDescription propertyName toolDef expectedDesc = do+  let prop = getProperty propertyName toolDef+  propertyDescription prop `shouldBe` expectedDesc++assertRequiredFields :: [Text] -> ToolDefinition -> IO ()+assertRequiredFields expectedFields toolDef = do+  case toolDefinitionInputSchema toolDef of+    InputSchemaDefinitionObject _ required -> +      all (`elem` required) expectedFields `shouldBe` True+    other -> expectationFailure $ "Expected InputSchemaDefinitionObject but got: " ++ show other++assertToolDescription :: ToolDefinition -> Text -> IO ()+assertToolDescription toolDef expectedDesc = +  toolDefinitionDescription toolDef `shouldBe` expectedDesc++spec :: Spec+spec = describe "Schema Validation and Custom Descriptions" $ do+  +  describe "Schema Generation" $ do+    let (listHandler, _) = testToolHandlers+    +    forM_ schemaTestCases $ \testCase -> do+      it (T.unpack $ schemaTestDescription testCase) $ do+        toolDefs <- listHandler+        +        assertToolExists (schemaToolName testCase) toolDefs+        let toolDef = findTool (schemaToolName testCase) toolDefs+        +        -- Validate property types+        forM_ (expectedProperties testCase) $ \(propName, expectedType) ->+          assertHasProperty propName expectedType toolDef+        +        -- Validate required fields+        assertRequiredFields (requiredFields testCase) toolDef++  describe "Custom Descriptions" $ do+    it "applies correct tool descriptions" $ do+      let (listHandler, _) = testToolHandlersWithDescriptions+      toolDefs <- listHandler+      +      assertToolExists "echo" toolDefs+      let echoDef = findTool "echo" toolDefs+      assertToolDescription echoDef "Echoes the input text back to the user"+      +      assertToolExists "calculate" toolDefs+      let calculateDef = findTool "calculate" toolDefs+      assertToolDescription calculateDef "Performs mathematical calculations"+    +    it "applies correct field descriptions for Calculate tool" $ do+      let (listHandler, _) = testToolHandlersWithDescriptions+      toolDefs <- listHandler+      +      assertToolExists "calculate" toolDefs+      let calculateDef = findTool "calculate" toolDefs+      +      assertPropertyDescription "operation" calculateDef "The mathematical operation to perform"+      assertPropertyDescription "x" calculateDef "The first number"  +      assertPropertyDescription "y" calculateDef "The second number"
+ test/TestData.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE OverloadedStrings #-}++module TestData +  ( -- * Prompt Test Data+    promptTestCases+  , PromptTestCase(..)+    +    -- * Resource Test Data  +  , resourceTestCases+  , ResourceTestCase(..)+  +    -- * Tool Test Data+  , toolTestCases+  , ToolTestCase(..)+  +    -- * Schema Test Data+  , schemaTestCases+  , SchemaTestCase(..)+  +    -- * Advanced Derivation Test Data+  , separateParamsTestCases+  , recursiveParamsTestCases+  , SeparateParamsTestCase(..)+  , RecursiveParamsTestCase(..)+  ) where++import Data.Text (Text)++-- | Test case for prompt derivation+data PromptTestCase = PromptTestCase+  { promptName :: Text+  , promptArgs :: [(Text, Text)]+  , expectedResult :: Text+  , testDescription :: Text+  } deriving (Show, Eq)++-- | Test case for resource derivation  +data ResourceTestCase = ResourceTestCase+  { resourceUri :: Text+  , resourceExpectedContent :: Text+  , useSubstringMatch :: Bool  -- True for substring match, False for exact match+  , resourceTestDescription :: Text+  } deriving (Show, Eq)++-- | Test case for tool derivation+data ToolTestCase = ToolTestCase+  { toolName :: Text+  , toolArgs :: [(Text, Text)]+  , toolExpectedResult :: Text+  , toolTestDescription :: Text+  } deriving (Show, Eq)++-- | Test case for schema validation+data SchemaTestCase = SchemaTestCase+  { schemaToolName :: Text+  , expectedProperties :: [(Text, Text)] -- (property name, expected type)+  , requiredFields :: [Text]+  , schemaTestDescription :: Text+  } deriving (Show, Eq)++-- | Test case for separate parameter types+data SeparateParamsTestCase = SeparateParamsTestCase+  { sepToolName :: Text+  , sepArgs :: [(Text, Text)]+  , sepExpectedResult :: Text+  , sepExpectedProperties :: [Text]+  , sepTestDescription :: Text+  } deriving (Show, Eq)++-- | Test case for recursive parameter types+data RecursiveParamsTestCase = RecursiveParamsTestCase+  { recToolName :: Text+  , recArgs :: [(Text, Text)]+  , recExpectedResult :: Text+  , recExpectedProperties :: [Text]+  , recTestDescription :: Text+  } deriving (Show, Eq)++-- | Prompt test cases+promptTestCases :: [PromptTestCase]+promptTestCases =+  [ PromptTestCase+      { promptName = "simple_prompt"+      , promptArgs = [("message", "hello")]+      , expectedResult = "Simple prompt: hello"+      , testDescription = "handles simple prompts correctly"+      }+  , PromptTestCase+      { promptName = "complex_prompt"+      , promptArgs = [("title", "urgent task"), ("priority", "5"), ("urgent", "true")]+      , expectedResult = "Complex prompt: urgent task (priority=5, urgent=True)"+      , testDescription = "handles complex prompts with multiple types"+      }+  , PromptTestCase+      { promptName = "optional_prompt"+      , promptArgs = [("required", "test")]+      , expectedResult = "Optional prompt: test"+      , testDescription = "handles optional prompts with missing optional field"+      }+  , PromptTestCase+      { promptName = "optional_prompt"+      , promptArgs = [("required", "test"), ("optional", "42")]+      , expectedResult = "Optional prompt: test optional=42"+      , testDescription = "handles optional prompts with optional field present"+      }+  ]++-- | Resource test cases+resourceTestCases :: [ResourceTestCase]+resourceTestCases =+  [ ResourceTestCase+      { resourceUri = "resource://config_file"+      , resourceExpectedContent = "Config file contents"+      , useSubstringMatch = True+      , resourceTestDescription = "handles simple resources correctly"+      }+  , ResourceTestCase+      { resourceUri = "resource://database_connection"+      , resourceExpectedContent = "Database at localhost:5432"+      , useSubstringMatch = False+      , resourceTestDescription = "handles parameterized resources correctly"+      }+  ]++-- | Tool test cases+toolTestCases :: [ToolTestCase]+toolTestCases =+  [ ToolTestCase+      { toolName = "calculate"+      , toolArgs = [("operation", "add"), ("x", "10"), ("y", "5")]+      , toolExpectedResult = "15"+      , toolTestDescription = "handles simple tool calls correctly"+      }+  , ToolTestCase+      { toolName = "calculate"+      , toolArgs = [("operation", "multiply"), ("x", "7"), ("y", "6")]+      , toolExpectedResult = "42"+      , toolTestDescription = "handles tool calls with different operations"+      }+  ]++-- | Schema test cases+schemaTestCases :: [SchemaTestCase]+schemaTestCases =+  [ SchemaTestCase+      { schemaToolName = "calculate"+      , expectedProperties = [("x", "integer"), ("y", "integer"), ("operation", "string")]+      , requiredFields = ["operation", "x", "y"]+      , schemaTestDescription = "generates correct schema for Calculate tool"+      }+  , SchemaTestCase+      { schemaToolName = "echo"+      , expectedProperties = [("text", "string")]+      , requiredFields = ["text"]+      , schemaTestDescription = "generates correct schema for Echo tool"+      }+  ]++-- | Separate parameter types test cases+separateParamsTestCases :: [SeparateParamsTestCase]+separateParamsTestCases =+  [ SeparateParamsTestCase+      { sepToolName = "get_value"+      , sepArgs = [("_gvpKey", "mykey")]+      , sepExpectedResult = "Getting value for key: mykey"+      , sepExpectedProperties = ["_gvpKey"]+      , sepTestDescription = "executes GetValue with separate parameters correctly"+      }+  , SeparateParamsTestCase+      { sepToolName = "set_value"+      , sepArgs = [("_svpKey", "mykey"), ("_svpValue", "myvalue")]+      , sepExpectedResult = "Setting mykey = myvalue"+      , sepExpectedProperties = ["_svpKey", "_svpValue"]+      , sepTestDescription = "executes SetValue with separate parameters correctly"+      }+  ]++-- | Recursive parameter types test cases+recursiveParamsTestCases :: [RecursiveParamsTestCase]+recursiveParamsTestCases =+  [ RecursiveParamsTestCase+      { recToolName = "process_data"+      , recArgs = [("_ipName", "Alice"), ("_ipAge", "30")]+      , recExpectedResult = "Processing data for Alice (age 30)"+      , recExpectedProperties = ["_ipName", "_ipAge"]+      , recTestDescription = "executes recursive parameter tools correctly"+      }+  ]