BasicDerivation.hs

{-# 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)