{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

module MCP.Server
  ( -- * Server Runtime
    runMcpServerStdio
  , runMcpServerHttp
  , runMcpServerHttpWithConfig

    -- * Transport Configuration
  , HttpConfig(..)

    -- * Utility Functions
  , jsonValueToText

    -- * Re-exports
  , module MCP.Server.Types
  ) where

import           Control.Monad.IO.Class (MonadIO)
import           Data.Aeson
import           Data.Text              (Text)
import qualified Data.Text              as T

import           MCP.Server.Transport.Stdio (transportRunStdio)
import           MCP.Server.Transport.Http (HttpConfig(..), transportRunHttp, defaultHttpConfig)
import           MCP.Server.Types

-- | Convert JSON Value to Text representation suitable for handlers
jsonValueToText :: Value -> Text
jsonValueToText :: Value -> Text
jsonValueToText (String Text
t) = Text
t
jsonValueToText (Number Scientific
n) = 
    -- Check if it's a whole number, if so format as integer
    if Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger (Scientific -> Integer
forall b. Integral b => Scientific -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Scientific
n) Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
== Scientific
n
        then String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show (Scientific -> Integer
forall b. Integral b => Scientific -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Scientific
n :: Integer)
        else String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Scientific -> String
forall a. Show a => a -> String
show Scientific
n
jsonValueToText (Bool Bool
True) = Text
"true"
jsonValueToText (Bool Bool
False) = Text
"false"
jsonValueToText Value
Null = Text
""
jsonValueToText Value
v = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. Show a => a -> String
show Value
v

-- | Run an MCP server using STDIO transport
runMcpServerStdio :: McpServerInfo -> McpServerHandlers IO -> IO ()
runMcpServerStdio :: McpServerInfo -> McpServerHandlers IO -> IO ()
runMcpServerStdio McpServerInfo
serverInfo McpServerHandlers IO
handlers = McpServerInfo -> McpServerHandlers IO -> IO ()
forall (m :: * -> *).
MonadIO m =>
McpServerInfo -> McpServerHandlers m -> m ()
transportRunStdio McpServerInfo
serverInfo McpServerHandlers IO
handlers

-- | Run an MCP server using HTTP transport with default configuration
runMcpServerHttp :: McpServerInfo -> McpServerHandlers IO -> IO ()
runMcpServerHttp :: McpServerInfo -> McpServerHandlers IO -> IO ()
runMcpServerHttp McpServerInfo
serverInfo McpServerHandlers IO
handlers = HttpConfig -> McpServerInfo -> McpServerHandlers IO -> IO ()
transportRunHttp HttpConfig
defaultHttpConfig McpServerInfo
serverInfo McpServerHandlers IO
handlers

-- | Run an MCP server using HTTP transport with custom configuration
runMcpServerHttpWithConfig :: HttpConfig -> McpServerInfo -> McpServerHandlers IO -> IO ()
runMcpServerHttpWithConfig :: HttpConfig -> McpServerInfo -> McpServerHandlers IO -> IO ()
runMcpServerHttpWithConfig HttpConfig
config McpServerInfo
serverInfo McpServerHandlers IO
handlers = HttpConfig -> McpServerInfo -> McpServerHandlers IO -> IO ()
transportRunHttp HttpConfig
config McpServerInfo
serverInfo McpServerHandlers IO
handlers