mcp-server 0.1.0.12 → 0.1.0.13
raw patch · 6 files changed
+33/−41 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- app/Main.hs +0/−6
- examples/HttpSimple/Main.hs +1/−5
- examples/Simple/Main.hs +1/−5
- mcp-server.cabal +1/−1
- src/MCP/Server/Transport/Stdio.hs +13/−7
- test/Spec/UnicodeHandling.hs +17/−17
app/Main.hs view
@@ -2,12 +2,6 @@ module Main where -import System.IO (hSetEncoding, stderr, stdout, utf8)- main :: IO () main = do- -- Set UTF-8 encoding to handle Unicode characters properly- hSetEncoding stdout utf8- hSetEncoding stderr utf8- putStrLn "Hello, World!"
examples/HttpSimple/Main.hs view
@@ -6,15 +6,11 @@ import Data.IORef import MCP.Server import MCP.Server.Derive-import System.IO (hPutStrLn, hSetEncoding, stderr, stdout, utf8)+import System.IO (hPutStrLn, stderr) import Types main :: IO () main = do- -- Set UTF-8 encoding to handle Unicode characters properly- hSetEncoding stdout utf8- hSetEncoding stderr utf8- hPutStrLn stderr "Starting HTTP Simple MCP Server..." -- Create a simple in-memory store
examples/Simple/Main.hs view
@@ -6,15 +6,11 @@ import Data.IORef import MCP.Server import MCP.Server.Derive-import System.IO (hPutStrLn, hSetEncoding, stderr, stdout, utf8)+import System.IO (hPutStrLn, stderr) import Types main :: IO () main = do- -- Set UTF-8 encoding to handle Unicode characters properly- hSetEncoding stdout utf8- hSetEncoding stderr utf8- hPutStrLn stderr "Starting Simple MCP Server..." -- Create a simple in-memory store
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.12+version: 0.1.0.13 -- A short (one-line) description of the package. synopsis: Library for building Model Context Protocol (MCP) servers -- A longer description of the package.
src/MCP/Server/Transport/Stdio.hs view
@@ -21,29 +21,35 @@ -- | Transport-specific implementation for STDIO+import System.IO (hSetEncoding, utf8)+ transportRunStdio :: (MonadIO m) => McpServerInfo -> McpServerHandlers m -> m () transportRunStdio serverInfo handlers = do+ -- Ensure UTF-8 encoding for all handles+ liftIO $ do+ hSetEncoding stderr utf8+ hSetEncoding stdout utf8 loop where loop = do input <- liftIO TIO.getLine when (not $ T.null $ T.strip input) $ do- liftIO $ hPutStrLn stderr $ "Received request: " ++ T.unpack input+ -- Use TIO.hPutStrLn for UTF-8 output+ liftIO $ TIO.hPutStrLn stderr $ "Received request: " <> input case eitherDecode (BSL.fromStrict $ TE.encodeUtf8 input) of- Left err -> liftIO $ hPutStrLn stderr $ "Parse error: " ++ err+ Left err -> liftIO $ TIO.hPutStrLn stderr $ "Parse error: " <> T.pack err Right jsonValue -> do case parseJsonRpcMessage jsonValue of- Left err -> liftIO $ hPutStrLn stderr $ "JSON-RPC parse error: " ++ err+ Left err -> liftIO $ TIO.hPutStrLn stderr $ "JSON-RPC parse error: " <> T.pack err Right message -> do- liftIO $ hPutStrLn stderr $ "Processing message: " ++ show (getMessageSummary message)+ liftIO $ TIO.hPutStrLn stderr $ "Processing message: " <> T.pack (show (getMessageSummary message)) response <- handleMcpMessage serverInfo handlers message case response of Just responseMsg -> do- liftIO $ hPutStrLn stderr $ "Sending response for: " ++ show (getMessageSummary message)+ liftIO $ TIO.hPutStrLn stderr $ "Sending response for: " <> T.pack (show (getMessageSummary message)) let responseText = TE.decodeUtf8 $ BSL.toStrict $ encode $ encodeJsonRpcMessage responseMsg liftIO $ TIO.putStrLn responseText liftIO $ hFlush stdout- Nothing -> liftIO $ hPutStrLn stderr $ "No response needed for: " ++ show (getMessageSummary message)+ Nothing -> liftIO $ TIO.hPutStrLn stderr $ "No response needed for: " <> T.pack (show (getMessageSummary message)) loop-
test/Spec/UnicodeHandling.hs view
@@ -3,16 +3,16 @@ module Spec.UnicodeHandling (spec) where import Data.Aeson-import qualified Data.Aeson.KeyMap as KM-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import qualified Data.ByteString.Lazy as BSL+import qualified Data.Aeson.KeyMap as KM+import qualified Data.ByteString.Lazy as BSL+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE import MCP.Server.Protocol import MCP.Server.Types-import System.IO (hSetEncoding, stderr, stdout, utf8)+import System.IO (hSetEncoding, stderr, stdout, utf8) import Test.Hspec -spec :: Spec +spec :: Spec spec = describe "Unicode Handling" $ do describe "Unicode in Content Types" $ do it "handles Unicode in ContentText" $ do@@ -29,7 +29,7 @@ it "handles Unicode in ResourceContent" $ do uri <- case parseURI "test://unicode" of- Just u -> return u+ Just u -> return u Nothing -> fail "Invalid URI" let resource = ResourceText uri "text/plain" "Unicode content: ∀x∈ℝ: √x²=|x|" let json = toJSON resource@@ -55,10 +55,10 @@ let decoded = eitherDecode encoded case decoded of Right decodedContent -> decodedContent `shouldBe` originalContent- Left err -> expectationFailure $ "Failed to decode: " ++ err+ Left err -> expectationFailure $ "Failed to decode: " ++ err it "handles Unicode in JSON-RPC messages" $ do- let response = ToolsCallResponse + let response = ToolsCallResponse { toolsCallContent = [ContentText "Result: √16 = 4, π ≈ 3.14159"] , toolsCallIsError = Nothing }@@ -83,7 +83,7 @@ describe "Protocol Messages with Unicode" $ do it "handles Unicode in tool responses" $ do- let response = ToolsCallResponse + let response = ToolsCallResponse { toolsCallContent = [ContentText "Mathematical result: √(π²+e²) ≈ 4.53"] , toolsCallIsError = Nothing }@@ -108,7 +108,7 @@ case json of Object obj -> case KM.lookup "message" obj of Just (String msg) -> "√" `T.isInfixOf` msg `shouldBe` True- _ -> expectationFailure "Expected message field"+ _ -> expectationFailure "Expected message field" _ -> expectationFailure "Expected Object" describe "Manual Handler Tests with Unicode" $ do@@ -151,9 +151,9 @@ else return $ Left $ ResourceNotFound $ T.pack uriStr uri <- case parseURI "resource://unicode_test" of- Just u -> return u+ Just u -> return u Nothing -> fail "Invalid URI"- + result <- resourceHandler uri case result of Right (ResourceText _ _ txt) -> do@@ -165,13 +165,13 @@ it "handles complete Unicode workflow without Template Haskell" $ do -- Create manual handlers with Unicode content let promptListHandler = return [- PromptDefinition + PromptDefinition { promptDefinitionName = "math_formula" , promptDefinitionDescription = "Generate mathematical formulas with Unicode: ∀∃∈√" , promptDefinitionArguments = [ArgumentDefinition "formula" "Mathematical expression" True] } ]- + let promptGetHandler name args = case name of "math_formula" -> case lookup "formula" args of Just formula -> return $ Right $ ContentText $ "Formula: " <> formula <> " → √(solution)"@@ -187,7 +187,7 @@ } ] - let resourceReadHandler uri = + let resourceReadHandler uri = if show uri == "resource://unicode_symbols" then return $ Right $ ResourceText uri "text/plain" "Symbols: ∀∃∈∉∪∩⊆⊇√∑∏∞≤≥≠≈π∅" else return $ Left $ ResourceNotFound $ T.pack $ show uri@@ -232,7 +232,7 @@ _ -> expectationFailure "Expected successful prompt result" uri <- case parseURI "resource://unicode_symbols" of- Just u -> return u+ Just u -> return u Nothing -> fail "Invalid URI" resourceResult <- snd (case resources handlers of Just h -> h; Nothing -> error "No resources") uri case resourceResult of