diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -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!" diff --git a/examples/HttpSimple/Main.hs b/examples/HttpSimple/Main.hs --- a/examples/HttpSimple/Main.hs +++ b/examples/HttpSimple/Main.hs @@ -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 diff --git a/examples/Simple/Main.hs b/examples/Simple/Main.hs --- a/examples/Simple/Main.hs +++ b/examples/Simple/Main.hs @@ -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 diff --git a/mcp-server.cabal b/mcp-server.cabal --- a/mcp-server.cabal +++ b/mcp-server.cabal @@ -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. diff --git a/src/MCP/Server/Transport/Stdio.hs b/src/MCP/Server/Transport/Stdio.hs --- a/src/MCP/Server/Transport/Stdio.hs +++ b/src/MCP/Server/Transport/Stdio.hs @@ -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 - diff --git a/test/Spec/UnicodeHandling.hs b/test/Spec/UnicodeHandling.hs --- a/test/Spec/UnicodeHandling.hs +++ b/test/Spec/UnicodeHandling.hs @@ -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