diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,13 @@ +1.0.1: + +- Add structured outputs support (beta feature `structured-outputs-2025-11-13`) + - `OutputFormat` type and `jsonSchemaFormat` helper for JSON outputs + - `output_format` field on `CreateMessage` + - `strict` field on `Tool` and `strictFunctionTool` helper for strict tool validation + - `additionalProperties` field on `InputSchema` + - `Refusal` constructor for `StopReason` +- Add `claude-structured-outputs-example` + 1.0.0: - Initial release diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -80,6 +80,8 @@ ## Running the Examples +See [examples/README.md](examples/README.md) for descriptions of each example. + ```bash cabal run claude-example cabal run claude-stream-example @@ -87,21 +89,26 @@ cabal run claude-vision-example cabal run claude-tool-search-example cabal run claude-programmatic-tool-calling-example +cabal run claude-structured-outputs-example ``` ### Advanced Examples -The `claude-tool-search-example` and `claude-programmatic-tool-calling-example` demonstrate beta features that require the `advanced-tool-use-2025-11-20` beta header: +Several examples demonstrate beta features: -- **[Tool Search Tool](https://platform.claude.com/docs/en/agents-and-tools/tool-use/tool-search-tool)**: Server-side tool search for efficiently handling large numbers of tools -- **[Programmatic Tool Calling (PTC)](https://platform.claude.com/docs/en/agents-and-tools/tool-use/programmatic-tool-calling)**: Claude writes and executes code to call multiple tools and aggregate results +**Tool Search & Programmatic Tool Calling** (`advanced-tool-use-2025-11-20`): +- **[Tool Search Tool](https://docs.anthropic.com/en/docs/agents-and-tools/tool-use/tool-search-tool)**: Server-side tool search for efficiently handling large numbers of tools +- **[Programmatic Tool Calling (PTC)](https://docs.anthropic.com/en/docs/agents-and-tools/tool-use/programmatic-tool-calling)**: Claude writes and executes code to call multiple tools and aggregate results -To enable these features, use `makeMethodsWith` with the beta header: +**Structured Outputs** (`structured-outputs-2025-11-13`): +- **[Structured Outputs](https://docs.anthropic.com/en/docs/build-with-claude/structured-outputs)**: Constrain Claude's responses to follow a specific JSON schema, or validate tool parameters with strict mode +To enable beta features, use `makeMethodsWith` with the appropriate beta header: + ```haskell let options = defaultClientOptions { apiKey = key - , anthropicBeta = Just "advanced-tool-use-2025-11-20" + , anthropicBeta = Just "structured-outputs-2025-11-13" } let Methods{ createMessage } = makeMethodsWith clientEnv options ``` diff --git a/claude.cabal b/claude.cabal --- a/claude.cabal +++ b/claude.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: claude -version: 1.0.0 +version: 1.0.1 synopsis: Servant bindings to Anthropic's Claude API description: This package provides comprehensive and type-safe bindings to Anthropic's Claude API, providing both a Servant interface @@ -84,7 +84,7 @@ , OverloadedLists , OverloadedStrings , RecordWildCards - ghc-options: -Wall + ghc-options: -Wall -Wno-missing-fields executable claude-example default-language: Haskell2010 @@ -127,7 +127,7 @@ , NamedFieldPuns , OverloadedLists , OverloadedStrings - ghc-options: -Wall + ghc-options: -Wall -Wno-missing-fields executable claude-vision-example default-language: Haskell2010 @@ -142,7 +142,7 @@ , NamedFieldPuns , OverloadedLists , OverloadedStrings - ghc-options: -Wall + ghc-options: -Wall -Wno-missing-fields executable claude-tool-search-example default-language: Haskell2010 @@ -156,7 +156,7 @@ , NamedFieldPuns , OverloadedLists , OverloadedStrings - ghc-options: -Wall + ghc-options: -Wall -Wno-missing-fields executable claude-programmatic-tool-calling-example default-language: Haskell2010 @@ -171,4 +171,19 @@ , NamedFieldPuns , OverloadedLists , OverloadedStrings - ghc-options: -Wall + ghc-options: -Wall -Wno-missing-fields + +executable claude-structured-outputs-example + default-language: Haskell2010 + hs-source-dirs: examples/claude-structured-outputs-example + main-is: Main.hs + build-depends: base + , aeson + , bytestring + , claude + , text + default-extensions: DuplicateRecordFields + , NamedFieldPuns + , OverloadedLists + , OverloadedStrings + ghc-options: -Wall -Wno-missing-fields diff --git a/examples/claude-programmatic-tool-calling-example/Main.hs b/examples/claude-programmatic-tool-calling-example/Main.hs --- a/examples/claude-programmatic-tool-calling-example/Main.hs +++ b/examples/claude-programmatic-tool-calling-example/Main.hs @@ -33,21 +33,19 @@ -- | Define a query_database tool that Claude can call programmatically queryDatabaseTool :: Tool.Tool -queryDatabaseTool = Tool.Tool - { Tool.name = "query_database" - , Tool.description = Just "Query a regional database for sales data. Returns sales figures for the specified region." - , Tool.input_schema = Tool.InputSchema - { Tool.type_ = "object" - , Tool.properties = Just $ Aeson.object +queryDatabaseTool = Tool.functionTool + "query_database" + (Just "Query a regional database for sales data. Returns sales figures for the specified region.") + $ Aeson.object + [ "properties" Aeson..= Aeson.object [ "region" Aeson..= Aeson.object [ "type" Aeson..= ("string" :: Text) , "description" Aeson..= ("The region to query: west, east, or central" :: Text) , "enum" Aeson..= (["west", "east", "central"] :: [Text]) ] ] - , Tool.required = Just ["region"] - } - } + , "required" Aeson..= (["region"] :: [Text]) + ] -- | Fake database query - returns sales data for a region queryDatabase :: Text -> Text diff --git a/examples/claude-structured-outputs-example/Main.hs b/examples/claude-structured-outputs-example/Main.hs new file mode 100644 --- /dev/null +++ b/examples/claude-structured-outputs-example/Main.hs @@ -0,0 +1,225 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Example demonstrating structured outputs with Claude +-- +-- This example shows how to use: +-- 1. JSON outputs (output_format) to get structured JSON responses +-- 2. Strict tool use (strict: true) to validate tool parameters +-- +-- Requires the structured-outputs-2025-11-13 beta header. +module Main where + +import Data.Aeson (FromJSON(..), (.:), (.=)) +import Data.Foldable (toList) +import Data.Text (Text) + +import qualified Claude.V1 as V1 +import qualified Claude.V1.Messages as Messages +import qualified Claude.V1.Tool as Tool +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.KeyMap as KeyMap +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text.Encoding +import qualified Data.Text.IO as Text.IO +import qualified System.Environment as Environment + +-- | Structured output type for contact extraction +data ContactInfo = ContactInfo + { name :: Text + , email :: Text + , company :: Maybe Text + , interested_in :: Text + } deriving Show + +instance FromJSON ContactInfo where + parseJSON = Aeson.withObject "ContactInfo" $ \obj -> do + n <- obj .: "name" + e <- obj .: "email" + c <- obj .: "company" + i <- obj .: "interested_in" + pure ContactInfo{ name = n, email = e, company = c, interested_in = i } + +main :: IO () +main = do + key <- Text.pack <$> Environment.getEnv "ANTHROPIC_KEY" + env <- V1.getClientEnv "https://api.anthropic.com" + + -- Use makeMethodsWith to pass the structured outputs beta header + let options = V1.defaultClientOptions + { V1.apiKey = key + , V1.anthropicBeta = Just "structured-outputs-2025-11-13" + } + + let V1.Methods{ V1.createMessage } = V1.makeMethodsWith env options + + -- Example 1: JSON outputs for data extraction + Text.IO.putStrLn "=== Example 1: JSON Outputs (Data Extraction) ===\n" + jsonOutputsExample createMessage + + Text.IO.putStrLn "\n" + + -- Example 2: Strict tool use for validated parameters + Text.IO.putStrLn "=== Example 2: Strict Tool Use ===\n" + strictToolUseExample createMessage + +-- | Example using output_format to get structured JSON responses +jsonOutputsExample :: (Messages.CreateMessage -> IO Messages.MessageResponse) -> IO () +jsonOutputsExample createMessage = do + let emailText = "Hi there! I'm John Smith from Acme Corp (john.smith@acme.com). \ + \I saw your demo at the conference and I'm very interested in \ + \your Enterprise plan. Could we schedule a call next week?" + + -- Define the JSON schema for our expected output + let outputSchema = Aeson.object + [ "type" .= ("object" :: Text) + , "properties" .= Aeson.object + [ "name" .= Aeson.object + [ "type" .= ("string" :: Text) + , "description" .= ("Full name of the contact" :: Text) + ] + , "email" .= Aeson.object + [ "type" .= ("string" :: Text) + , "description" .= ("Email address" :: Text) + ] + , "company" .= Aeson.object + [ "type" .= ("string" :: Text) + , "description" .= ("Company name if mentioned" :: Text) + ] + , "interested_in" .= Aeson.object + [ "type" .= ("string" :: Text) + , "description" .= ("What product/service they're interested in" :: Text) + ] + ] + , "required" .= (["name", "email", "interested_in"] :: [Text]) + , "additionalProperties" .= False + ] + + let message = Messages.Message + { Messages.role = Messages.User + , Messages.content = [Messages.textContent $ "Extract contact information from this email:\n\n" <> emailText] + , Messages.cache_control = Nothing + } + + Text.IO.putStrLn $ "Input email: " <> emailText + Text.IO.putStrLn "\nExtracting structured data..." + + response <- createMessage Messages._CreateMessage + { Messages.model = "claude-sonnet-4-5-20250929" + , Messages.messages = [message] + , Messages.max_tokens = 1024 + , Messages.output_format = Just (Messages.jsonSchemaFormat outputSchema) + } + + let Messages.MessageResponse{ Messages.content = responseContent, Messages.stop_reason = stopReason } = response + + Text.IO.putStrLn $ "Stop reason: " <> Text.pack (show stopReason) + + -- The response text should be valid JSON matching our schema + case toList responseContent of + [Messages.ContentBlock_Text{ Messages.text = jsonText }] -> do + Text.IO.putStrLn $ "\nRaw JSON response:\n" <> jsonText + + -- Parse and display the structured data + case Aeson.eitherDecodeStrict (Text.Encoding.encodeUtf8 jsonText) of + Left err -> Text.IO.putStrLn $ "Parse error: " <> Text.pack err + Right ContactInfo{ name, email, company, interested_in } -> do + Text.IO.putStrLn "\nParsed contact info:" + Text.IO.putStrLn $ " Name: " <> name + Text.IO.putStrLn $ " Email: " <> email + Text.IO.putStrLn $ " Company: " <> maybe "(not specified)" id company + Text.IO.putStrLn $ " Interested in: " <> interested_in + _ -> Text.IO.putStrLn "Unexpected response format" + +-- | Example using strict: true for validated tool parameters +strictToolUseExample :: (Messages.CreateMessage -> IO Messages.MessageResponse) -> IO () +strictToolUseExample createMessage = do + -- Define a tool with strict mode enabled + -- This guarantees the tool input will match the schema exactly + let flightSearchTool = Tool.strictFunctionTool + "search_flights" + (Just "Search for available flights between two cities") + $ Aeson.object + [ "type" .= ("object" :: Text) + , "properties" .= Aeson.object + [ "origin" .= Aeson.object + [ "type" .= ("string" :: Text) + , "description" .= ("Origin airport code (e.g., SFO)" :: Text) + ] + , "destination" .= Aeson.object + [ "type" .= ("string" :: Text) + , "description" .= ("Destination airport code (e.g., JFK)" :: Text) + ] + , "date" .= Aeson.object + [ "type" .= ("string" :: Text) + , "format" .= ("date" :: Text) + , "description" .= ("Travel date in YYYY-MM-DD format" :: Text) + ] + , "passengers" .= Aeson.object + [ "type" .= ("integer" :: Text) + , "enum" .= ([1, 2, 3, 4, 5, 6, 7, 8, 9, 10] :: [Int]) + , "description" .= ("Number of passengers (1-10)" :: Text) + ] + ] + , "required" .= (["origin", "destination", "date", "passengers"] :: [Text]) + , "additionalProperties" .= False + ] + + let message = Messages.Message + { Messages.role = Messages.User + , Messages.content = [Messages.textContent "Find me flights from San Francisco to New York for 2 people on January 15th, 2025"] + , Messages.cache_control = Nothing + } + + Text.IO.putStrLn "Asking Claude to search for flights with strict tool validation..." + + response <- createMessage Messages._CreateMessage + { Messages.model = "claude-sonnet-4-5-20250929" + , Messages.messages = [message] + , Messages.max_tokens = 1024 + , Messages.tools = Just [Tool.inlineTool flightSearchTool] + , Messages.tool_choice = Just Tool.toolChoiceAny -- Force tool use + } + + let Messages.MessageResponse{ Messages.content = responseContent, Messages.stop_reason = stopReason } = response + + Text.IO.putStrLn $ "Stop reason: " <> Text.pack (show stopReason) + + -- With strict mode, we're guaranteed the tool input matches the schema + mapM_ processBlock (toList responseContent) + where + processBlock (Messages.ContentBlock_Tool_Use{ Messages.id = toolId, Messages.name = toolName, Messages.input = toolInput }) = do + Text.IO.putStrLn $ "\nTool called: " <> toolName + Text.IO.putStrLn $ "Tool ID: " <> toolId + Text.IO.putStrLn $ "Input (guaranteed to match schema):" + Text.IO.putStrLn $ " " <> Text.Encoding.decodeUtf8 (LBS.toStrict (Aeson.encode toolInput)) + + -- In strict mode, we can safely extract fields without error handling + case toolInput of + Aeson.Object obj -> do + let origin = lookupString "origin" obj + let destination = lookupString "destination" obj + let date = lookupString "date" obj + let passengers = lookupInt "passengers" obj + Text.IO.putStrLn "\nParsed parameters:" + Text.IO.putStrLn $ " Origin: " <> origin + Text.IO.putStrLn $ " Destination: " <> destination + Text.IO.putStrLn $ " Date: " <> date + Text.IO.putStrLn $ " Passengers: " <> Text.pack (show passengers) + _ -> pure () + + processBlock (Messages.ContentBlock_Text{ Messages.text = t }) = + Text.IO.putStrLn $ "Text: " <> t + + processBlock _ = pure () + + lookupString key obj = case KeyMap.lookup key obj of + Just (Aeson.String s) -> s + _ -> "(missing)" + + lookupInt key obj = case KeyMap.lookup key obj of + Just (Aeson.Number n) -> round n :: Int + _ -> 0 diff --git a/examples/claude-tool-example/Main.hs b/examples/claude-tool-example/Main.hs --- a/examples/claude-tool-example/Main.hs +++ b/examples/claude-tool-example/Main.hs @@ -49,12 +49,11 @@ -- | Define our weather tool weatherTool :: Tool.Tool -weatherTool = Tool.Tool - { Tool.name = "get_weather" - , Tool.description = Just "Get the current weather for a location" - , Tool.input_schema = Tool.InputSchema - { Tool.type_ = "object" - , Tool.properties = Just $ Aeson.object +weatherTool = Tool.functionTool + "get_weather" + (Just "Get the current weather for a location") + $ Aeson.object + [ "properties" .= Aeson.object [ "location" .= Aeson.object [ "type" .= ("string" :: Text) , "description" .= ("City and state, e.g. San Francisco, CA" :: Text) @@ -65,9 +64,8 @@ , "description" .= ("Temperature unit" :: Text) ] ] - , Tool.required = Just ["location"] - } - } + , "required" .= (["location"] :: [Text]) + ] main :: IO () main = do diff --git a/examples/claude-tool-search-example/Main.hs b/examples/claude-tool-search-example/Main.hs --- a/examples/claude-tool-search-example/Main.hs +++ b/examples/claude-tool-search-example/Main.hs @@ -26,44 +26,39 @@ -- In a real application, you might have hundreds of tools weatherTool :: Tool.Tool -weatherTool = Tool.Tool - { Tool.name = "get_weather" - , Tool.description = Just "Get the current weather for a location" - , Tool.input_schema = Tool.InputSchema - { Tool.type_ = "object" - , Tool.properties = Just $ Aeson.object +weatherTool = Tool.functionTool + "get_weather" + (Just "Get the current weather for a location") + $ Aeson.object + [ "properties" Aeson..= Aeson.object [ "location" Aeson..= Aeson.object [ "type" Aeson..= ("string" :: Text) , "description" Aeson..= ("City and state, e.g. San Francisco, CA" :: Text) ] ] - , Tool.required = Just ["location"] - } - } + , "required" Aeson..= (["location"] :: [Text]) + ] stockPriceTool :: Tool.Tool -stockPriceTool = Tool.Tool - { Tool.name = "get_stock_price" - , Tool.description = Just "Get the current stock price for a ticker symbol" - , Tool.input_schema = Tool.InputSchema - { Tool.type_ = "object" - , Tool.properties = Just $ Aeson.object +stockPriceTool = Tool.functionTool + "get_stock_price" + (Just "Get the current stock price for a ticker symbol") + $ Aeson.object + [ "properties" Aeson..= Aeson.object [ "ticker" Aeson..= Aeson.object [ "type" Aeson..= ("string" :: Text) , "description" Aeson..= ("Stock ticker symbol, e.g. AAPL" :: Text) ] ] - , Tool.required = Just ["ticker"] - } - } + , "required" Aeson..= (["ticker"] :: [Text]) + ] currencyConvertTool :: Tool.Tool -currencyConvertTool = Tool.Tool - { Tool.name = "convert_currency" - , Tool.description = Just "Convert an amount from one currency to another" - , Tool.input_schema = Tool.InputSchema - { Tool.type_ = "object" - , Tool.properties = Just $ Aeson.object +currencyConvertTool = Tool.functionTool + "convert_currency" + (Just "Convert an amount from one currency to another") + $ Aeson.object + [ "properties" Aeson..= Aeson.object [ "amount" Aeson..= Aeson.object [ "type" Aeson..= ("number" :: Text) , "description" Aeson..= ("Amount to convert" :: Text) @@ -77,41 +72,36 @@ , "description" Aeson..= ("Target currency code, e.g. EUR" :: Text) ] ] - , Tool.required = Just ["amount", "from_currency", "to_currency"] - } - } + , "required" Aeson..= (["amount", "from_currency", "to_currency"] :: [Text]) + ] calculatorTool :: Tool.Tool -calculatorTool = Tool.Tool - { Tool.name = "calculator" - , Tool.description = Just "Perform basic arithmetic calculations" - , Tool.input_schema = Tool.InputSchema - { Tool.type_ = "object" - , Tool.properties = Just $ Aeson.object +calculatorTool = Tool.functionTool + "calculator" + (Just "Perform basic arithmetic calculations") + $ Aeson.object + [ "properties" Aeson..= Aeson.object [ "expression" Aeson..= Aeson.object [ "type" Aeson..= ("string" :: Text) , "description" Aeson..= ("Math expression to evaluate, e.g. 2+2" :: Text) ] ] - , Tool.required = Just ["expression"] - } - } + , "required" Aeson..= (["expression"] :: [Text]) + ] searchWebTool :: Tool.Tool -searchWebTool = Tool.Tool - { Tool.name = "search_web" - , Tool.description = Just "Search the web for information" - , Tool.input_schema = Tool.InputSchema - { Tool.type_ = "object" - , Tool.properties = Just $ Aeson.object +searchWebTool = Tool.functionTool + "search_web" + (Just "Search the web for information") + $ Aeson.object + [ "properties" Aeson..= Aeson.object [ "query" Aeson..= Aeson.object [ "type" Aeson..= ("string" :: Text) , "description" Aeson..= ("Search query" :: Text) ] ] - , Tool.required = Just ["query"] - } - } + , "required" Aeson..= (["query"] :: [Text]) + ] main :: IO () main = do diff --git a/src/Claude/V1/Messages.hs b/src/Claude/V1/Messages.hs --- a/src/Claude/V1/Messages.hs +++ b/src/Claude/V1/Messages.hs @@ -7,6 +7,9 @@ , _CreateMessage , MessageResponse(..) , MessageStreamEvent(..) + -- * Structured outputs + , OutputFormat(..) + , jsonSchemaFormat -- * Content types , Content(..) , ContentBlock(..) @@ -38,6 +41,7 @@ , ToolSearchTool(..) , ToolSearchToolType(..) , functionTool + , strictFunctionTool , inlineTool , deferredTool , toolSearchRegex @@ -84,15 +88,16 @@ , deferredTool , functionTool , inlineTool + , strictFunctionTool , toolChoiceAny , toolChoiceAuto , toolChoiceTool , toolSearchBm25 , toolSearchRegex ) -import Data.Time (UTCTime) import qualified Data.Aeson as Aeson import qualified Data.Aeson.KeyMap as KeyMap +import Data.Time (UTCTime) -- | Role of a message participant data Role = User | Assistant @@ -487,6 +492,8 @@ | Max_Tokens | Stop_Sequence | Tool_Use + | Refusal + -- ^ Model refused the request for safety reasons (structured outputs only) deriving stock (Eq, Generic, Show) stopReasonOptions :: Options @@ -549,6 +556,43 @@ instance ToJSON MessageResponse where toJSON = genericToJSON aesonOptions +-- | Output format specification for structured outputs +-- +-- Use with the @structured-outputs-2025-11-13@ beta header. +-- +-- Example: +-- +-- @ +-- let outputFormat = jsonSchemaFormat $ Aeson.object +-- [ "type" .= ("object" :: Text) +-- , "properties" .= Aeson.object +-- [ "name" .= Aeson.object ["type" .= ("string" :: Text)] +-- , "age" .= Aeson.object ["type" .= ("integer" :: Text)] +-- ] +-- , "required" .= (["name", "age"] :: [Text]) +-- , "additionalProperties" .= False +-- ] +-- @ +data OutputFormat = OutputFormat + { type_ :: Text -- ^ Currently only "json_schema" is supported + , schema :: Value -- ^ JSON Schema for the output + } deriving stock (Eq, Generic, Show) + +instance FromJSON OutputFormat where + parseJSON = genericParseJSON aesonOptions + +instance ToJSON OutputFormat where + toJSON = genericToJSON aesonOptions + +-- | Create a JSON schema output format +-- +-- This is the primary way to use structured outputs. +jsonSchemaFormat :: Value -> OutputFormat +jsonSchemaFormat s = OutputFormat + { type_ = "json_schema" + , schema = s + } + -- | Request body for @\/v1\/messages@ -- -- For programmatic tool calling (PTC), use the @container@ field to reuse @@ -567,6 +611,8 @@ , tools :: Maybe (Vector ToolDefinition) , tool_choice :: Maybe ToolChoice , container :: Maybe Text + , output_format :: Maybe OutputFormat + -- ^ Structured output format (requires @structured-outputs-2025-11-13@ beta header) } deriving stock (Generic, Show) instance FromJSON CreateMessage where @@ -591,6 +637,7 @@ , tools = Nothing , tool_choice = Nothing , container = Nothing + , output_format = Nothing } -- | Text delta in streaming diff --git a/src/Claude/V1/Tool.hs b/src/Claude/V1/Tool.hs --- a/src/Claude/V1/Tool.hs +++ b/src/Claude/V1/Tool.hs @@ -33,6 +33,7 @@ , ToolSearchToolType(..) -- * Tool constructors , functionTool + , strictFunctionTool , simpleInputSchema -- * ToolDefinition constructors , inlineTool @@ -64,17 +65,31 @@ -- | Tool input schema (JSON Schema) -- -- The schema follows JSON Schema format. At minimum, specify @type_@ as \"object\". +-- For strict mode (structured outputs), set @additionalProperties = Just False@. data InputSchema = InputSchema { type_ :: Text , properties :: Maybe Value , required :: Maybe (Vector Text) + , additionalProperties :: Maybe Bool + -- ^ For strict mode, must be @Just False@ } deriving stock (Eq, Generic, Show) instance FromJSON InputSchema where - parseJSON = genericParseJSON aesonOptions + parseJSON = Aeson.withObject "InputSchema" $ \o -> do + type_ <- o Aeson..: "type" + properties <- o Aeson..:? "properties" + required <- o Aeson..:? "required" + additionalProperties <- o Aeson..:? "additionalProperties" + pure InputSchema{ type_, properties, required, additionalProperties } instance ToJSON InputSchema where - toJSON = genericToJSON aesonOptions + toJSON InputSchema{ type_, properties, required, additionalProperties } = + Aeson.object $ filter ((/= Aeson.Null) . snd) + [ "type" Aeson..= type_ + , "properties" Aeson..= properties + , "required" Aeson..= required + , "additionalProperties" Aeson..= additionalProperties + ] -- | Create a simple input schema with properties and required fields simpleInputSchema @@ -85,16 +100,22 @@ { type_ = "object" , properties = Just props , required = Just reqs + , additionalProperties = Nothing } -- | A tool that can be used by Claude -- -- Tools allow Claude to call external functions. When Claude decides to use a tool, -- it will return a @tool_use@ content block with the tool name and input arguments. +-- +-- Set @strict = Just True@ to enable strict schema validation (structured outputs). +-- This requires the @structured-outputs-2025-11-13@ beta header. data Tool = Tool { name :: Text , description :: Maybe Text , input_schema :: InputSchema + , strict :: Maybe Bool + -- ^ Enable strict schema validation for tool inputs (structured outputs beta) } deriving stock (Eq, Generic, Show) instance FromJSON Tool where @@ -106,6 +127,7 @@ -- | Create a function tool with a name, description, and JSON schema for parameters -- -- This is the primary way to define tools for Claude. +-- To enable strict schema validation, use 'strictFunctionTool' instead. functionTool :: Text -- ^ Tool name (must match [a-zA-Z0-9_-]+) -> Maybe Text -- ^ Description of what the tool does @@ -126,13 +148,33 @@ Just (Aeson.Array arr) -> Just (Vector.mapMaybe getString arr) _ -> Nothing _ -> Nothing + , additionalProperties = Nothing } + , strict = Nothing } where getString (Aeson.String s) = Just s getString _ = Nothing lookupKey k obj = KeyMap.lookup (Key.fromText k) obj +-- | Create a function tool with strict schema validation enabled +-- +-- This is like 'functionTool' but enables strict mode for structured outputs. +-- Automatically sets @additionalProperties = False@ as required by the API. +-- Requires the @structured-outputs-2025-11-13@ beta header. +strictFunctionTool + :: Text -- ^ Tool name (must match [a-zA-Z0-9_-]+) + -> Maybe Text -- ^ Description of what the tool does + -> Value -- ^ JSON Schema for the input parameters + -> Tool +strictFunctionTool toolName toolDescription schema = + let tool = functionTool toolName toolDescription schema + inputSchema = input_schema tool + in tool + { strict = Just True + , input_schema = inputSchema{ additionalProperties = Just False } + } + -- | Controls which tool the model should use data ToolChoice = ToolChoice_Auto @@ -258,7 +300,7 @@ isCodeExecutionType t = t == "code_execution_20250825" instance ToJSON ToolDefinition where - toJSON (ToolDef_Function Tool{ name, description, input_schema } defer_loading allowed_callers) = + toJSON (ToolDef_Function Tool{ name, description, input_schema, strict } defer_loading allowed_callers) = Aeson.Object (baseMap <> optionalFields) where baseObj = Aeson.object $ @@ -270,7 +312,8 @@ _ -> KeyMap.empty optionalFields = KeyMap.fromList $ maybe [] (\dl -> [("defer_loading", Aeson.toJSON dl)]) defer_loading <> - maybe [] (\ac -> [("allowed_callers", Aeson.toJSON ac)]) allowed_callers + maybe [] (\ac -> [("allowed_callers", Aeson.toJSON ac)]) allowed_callers <> + maybe [] (\s -> [("strict", Aeson.toJSON s)]) strict toJSON (ToolDef_SearchTool searchTool) = Aeson.toJSON searchTool toJSON (ToolDef_CodeExecutionTool name type_) = Aeson.object [ "name" Aeson..= name diff --git a/tasty/Main.hs b/tasty/Main.hs --- a/tasty/Main.hs +++ b/tasty/Main.hs @@ -21,6 +21,7 @@ import qualified Data.IORef as IORef import Data.Maybe (mapMaybe) import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text import qualified Data.Vector as Vector import qualified Network.HTTP.Client as HTTP.Client import qualified Network.HTTP.Client.TLS as TLS @@ -166,20 +167,18 @@ let toolUseTest = HUnit.testCase "Create message - tool use" do - let calculatorTool = Tool.Tool - { Tool.name = "calculator" - , Tool.description = Just "Perform basic arithmetic" - , Tool.input_schema = Tool.InputSchema - { Tool.type_ = "object" - , Tool.properties = Just $ Aeson.object + let calculatorTool = Tool.functionTool + "calculator" + (Just "Perform basic arithmetic") + $ Aeson.object + [ "properties" Aeson..= Aeson.object [ "expression" Aeson..= Aeson.object [ "type" Aeson..= ("string" :: Text.Text) , "description" Aeson..= ("Math expression like 2+2" :: Text.Text) ] ] - , Tool.required = Just ["expression"] - } - } + , "required" Aeson..= (["expression"] :: [Text.Text]) + ] Messages.MessageResponse{ stop_reason, content } <- createMessage @@ -233,6 +232,121 @@ HUnit.assertBool "Should have positive token count" (input_tokens > 0) + -- Structured outputs tests require beta header + let structuredOutputsOptions = V1.defaultClientOptions + { V1.apiKey = Text.pack key + , V1.anthropicBeta = Just "structured-outputs-2025-11-13" + } + let V1.Methods{ V1.createMessage = createMessageStructured } = + V1.makeMethodsWith clientEnv structuredOutputsOptions + + let jsonOutputsTest = + HUnit.testCase "Create message - JSON outputs" do + -- Define output schema + let outputSchema = Aeson.object + [ "type" Aeson..= ("object" :: Text.Text) + , "properties" Aeson..= Aeson.object + [ "name" Aeson..= Aeson.object + [ "type" Aeson..= ("string" :: Text.Text) + ] + , "age" Aeson..= Aeson.object + [ "type" Aeson..= ("integer" :: Text.Text) + ] + ] + , "required" Aeson..= (["name", "age"] :: [Text.Text]) + , "additionalProperties" Aeson..= False + ] + + Messages.MessageResponse{ stop_reason, content } <- + createMessageStructured + Messages._CreateMessage + { Messages.model = model + , Messages.messages = + [ Messages.Message + { Messages.role = Messages.User + , Messages.content = + [ Messages.textContent "Extract: John Smith is 30 years old." + ] + , Messages.cache_control = Nothing + } + ] + , Messages.max_tokens = 200 + , Messages.output_format = Just (Messages.jsonSchemaFormat outputSchema) + } + + -- Should complete normally + HUnit.assertEqual "Should complete with end_turn" + (Just Messages.End_Turn) + stop_reason + + -- Should have text content that is valid JSON + case toList content of + [Messages.ContentBlock_Text{ Messages.text = jsonText }] -> do + case Aeson.eitherDecodeStrict (Text.encodeUtf8 jsonText) of + Left err -> HUnit.assertFailure $ "Invalid JSON: " <> err + Right (obj :: Aeson.Value) -> do + -- Check it has the expected structure + case obj of + Aeson.Object _ -> pure () + _ -> HUnit.assertFailure "Expected JSON object" + _ -> HUnit.assertFailure "Expected single text content block" + + let strictToolUseTest = + HUnit.testCase "Create message - strict tool use" do + -- Define a tool with strict mode + let strictTool = Tool.strictFunctionTool + "get_user" + (Just "Get user by ID") + $ Aeson.object + [ "type" Aeson..= ("object" :: Text.Text) + , "properties" Aeson..= Aeson.object + [ "user_id" Aeson..= Aeson.object + [ "type" Aeson..= ("integer" :: Text.Text) + , "description" Aeson..= ("The user ID" :: Text.Text) + ] + ] + , "required" Aeson..= (["user_id"] :: [Text.Text]) + ] + + Messages.MessageResponse{ stop_reason, content } <- + createMessageStructured + Messages._CreateMessage + { Messages.model = model + , Messages.messages = + [ Messages.Message + { Messages.role = Messages.User + , Messages.content = + [ Messages.textContent "Get user 42" + ] + , Messages.cache_control = Nothing + } + ] + , Messages.max_tokens = 200 + , Messages.tools = Just [Tool.inlineTool strictTool] + , Messages.tool_choice = Just Tool.ToolChoice_Any + } + + -- Should stop for tool use + HUnit.assertEqual "Should stop for tool use" + (Just Messages.Tool_Use) + stop_reason + + -- Should have a tool_use block with integer user_id + let toolUseBlocks = + [ (toolId, toolInput) + | Messages.ContentBlock_Tool_Use{ Messages.id = toolId, Messages.input = toolInput } + <- toList content + ] + case toolUseBlocks of + [(_, toolInput)] -> do + -- Verify user_id is an integer (strict mode guarantees this) + case Aeson.Types.parseMaybe (Aeson.withObject "input" (\o -> o Aeson..: "user_id")) toolInput of + Just (userId :: Int) -> + HUnit.assertEqual "user_id should be 42" 42 userId + Nothing -> + HUnit.assertFailure "user_id should be present and be an integer" + _ -> HUnit.assertFailure "Expected exactly one tool_use block" + -- Tool search test requires beta header let betaOptions = V1.defaultClientOptions { V1.apiKey = Text.pack key @@ -244,47 +358,41 @@ let toolSearchTest = HUnit.testCase "Create message - tool search" do -- Define several tools to search through - let weatherTool = Tool.Tool - { Tool.name = "get_weather" - , Tool.description = Just "Get the current weather for a location" - , Tool.input_schema = Tool.InputSchema - { Tool.type_ = "object" - , Tool.properties = Just $ Aeson.object + let weatherTool = Tool.functionTool + "get_weather" + (Just "Get the current weather for a location") + $ Aeson.object + [ "properties" Aeson..= Aeson.object [ "location" Aeson..= Aeson.object [ "type" Aeson..= ("string" :: Text.Text) ] ] - , Tool.required = Just ["location"] - } - } + , "required" Aeson..= (["location"] :: [Text.Text]) + ] - let stockTool = Tool.Tool - { Tool.name = "get_stock_price" - , Tool.description = Just "Get the stock price for a ticker" - , Tool.input_schema = Tool.InputSchema - { Tool.type_ = "object" - , Tool.properties = Just $ Aeson.object + let stockTool = Tool.functionTool + "get_stock_price" + (Just "Get the stock price for a ticker") + $ Aeson.object + [ "properties" Aeson..= Aeson.object [ "ticker" Aeson..= Aeson.object [ "type" Aeson..= ("string" :: Text.Text) ] ] - , Tool.required = Just ["ticker"] - } - } + , "required" Aeson..= (["ticker"] :: [Text.Text]) + ] - let calculatorTool' = Tool.Tool - { Tool.name = "calculator" - , Tool.description = Just "Perform arithmetic calculations" - , Tool.input_schema = Tool.InputSchema - { Tool.type_ = "object" - , Tool.properties = Just $ Aeson.object + let calculatorTool' = Tool.functionTool + "calculator" + (Just "Perform arithmetic calculations") + $ Aeson.object + [ "properties" Aeson..= Aeson.object [ "expression" Aeson..= Aeson.object [ "type" Aeson..= ("string" :: Text.Text) ] ] - , Tool.required = Just ["expression"] - } - } + , "required" Aeson..= (["expression"] :: [Text.Text]) + ] -- Use tool search with deferred tools let tools = @@ -328,19 +436,17 @@ let programmaticToolCallingTest = HUnit.testCase "Create message - programmatic tool calling" do -- Define a simple tool for PTC - let queryTool = Tool.Tool - { Tool.name = "get_data" - , Tool.description = Just "Get data for a key" - , Tool.input_schema = Tool.InputSchema - { Tool.type_ = "object" - , Tool.properties = Just $ Aeson.object + let queryTool = Tool.functionTool + "get_data" + (Just "Get data for a key") + $ Aeson.object + [ "properties" Aeson..= Aeson.object [ "key" Aeson..= Aeson.object [ "type" Aeson..= ("string" :: Text.Text) ] ] - , Tool.required = Just ["key"] - } - } + , "required" Aeson..= (["key"] :: [Text.Text]) + ] -- Tools: code execution + query tool with allowed_callers let tools = @@ -457,6 +563,8 @@ , messagesConversationTest , toolUseTest , tokenCountingTest + , jsonOutputsTest + , strictToolUseTest , toolSearchTest , programmaticToolCallingTest ]