diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,12 @@ +1.2.0: + +- Add `Thinking` type with `ThinkingAdaptive` and `ThinkingEnabled` constructors + - `thinking` field on `CreateMessage` + - `ContentBlock_Thinking` and `ContentBlock_Redacted_Thinking` response blocks + - `Content_Thinking` and `Content_Redacted_Thinking` for replaying thinking in multi-turn + - `Delta_Thinking_Delta` and `Delta_Signature_Delta` for streaming +- Add `Model_Context_Window_Exceeded` constructor to `StopReason` + 1.1.0: - Replace `output_format` with `output_config` on `CreateMessage` (breaking change) 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.1.0 +version: 1.2.0 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 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 @@ -249,6 +249,10 @@ where unless False action = action unless True _ = pure () +printContentBlock (Messages.ContentBlock_Thinking{}) = + Text.IO.putStrLn " [Thinking]" +printContentBlock (Messages.ContentBlock_Redacted_Thinking{}) = + Text.IO.putStrLn " [Redacted thinking]" printContentBlock (Messages.ContentBlock_Unknown{ Messages.type_ = t }) = Text.IO.putStrLn $ " [Unknown] " <> t diff --git a/examples/claude-stream-example/Main.hs b/examples/claude-stream-example/Main.hs --- a/examples/claude-stream-example/Main.hs +++ b/examples/claude-stream-example/Main.hs @@ -27,6 +27,8 @@ case d of Messages.Delta_Text_Delta{ Messages.text = t } -> TIO.putStr t >> hFlush stdout + Messages.Delta_Thinking_Delta{ Messages.thinking = t } -> + TIO.putStr t >> hFlush stdout _ -> pure () -- Print newline when message is done Messages.Message_Stop -> putStrLn "" 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 @@ -186,5 +186,9 @@ Text.IO.putStrLn $ "[Tool search result for: " <> tid <> "]" printContent (Messages.ContentBlock_Code_Execution_Tool_Result{ Messages.tool_use_id = tid, Messages.code_execution_content = _ }) = Text.IO.putStrLn $ "[Code execution result for: " <> tid <> "]" +printContent (Messages.ContentBlock_Thinking{}) = + Text.IO.putStrLn "[Thinking]" +printContent (Messages.ContentBlock_Redacted_Thinking{}) = + Text.IO.putStrLn "[Redacted thinking]" printContent (Messages.ContentBlock_Unknown{ Messages.type_ = t }) = Text.IO.putStrLn $ "[Unknown block type: " <> t <> "]" 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 @@ -193,5 +193,9 @@ Text.IO.putStrLn " Unknown result type" printContent (Messages.ContentBlock_Code_Execution_Tool_Result{ Messages.tool_use_id = tid }) = Text.IO.putStrLn $ " [code_execution_result] for tool_use_id: " <> tid +printContent (Messages.ContentBlock_Thinking{}) = + Text.IO.putStrLn " [thinking]" +printContent (Messages.ContentBlock_Redacted_Thinking{}) = + Text.IO.putStrLn " [redacted_thinking]" printContent (Messages.ContentBlock_Unknown{ Messages.type_ = t }) = Text.IO.putStrLn $ " [unknown] type: " <> t 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 @@ -13,6 +13,8 @@ , jsonSchemaConfig , jsonSchemaFormat , effortConfig + -- * Thinking + , Thinking(..) -- * Content types , Content(..) , ContentBlock(..) @@ -194,6 +196,8 @@ , input :: Value } | Content_Tool_Result { tool_use_id :: Text, content :: Maybe Text, is_error :: Maybe Bool } + | Content_Thinking { thinking :: Text, signature :: Text } + | Content_Redacted_Thinking { data_ :: Text } deriving stock (Generic, Show) -- | Create a text content block without cache control @@ -245,6 +249,10 @@ } contentBlockToContent ContentBlock_Tool_Search_Tool_Result{} = Nothing contentBlockToContent ContentBlock_Code_Execution_Tool_Result{} = Nothing +contentBlockToContent (ContentBlock_Thinking t sig) = + Just Content_Thinking{ thinking = t, signature = sig } +contentBlockToContent (ContentBlock_Redacted_Thinking d) = + Just Content_Redacted_Thinking{ data_ = d } contentBlockToContent ContentBlock_Unknown{} = Nothing -- | A reference to a tool found by tool search @@ -411,6 +419,8 @@ { tool_use_id :: Text , code_execution_content :: CodeExecutionToolResultContent } + | ContentBlock_Thinking { thinking :: Text, signature :: Text } + | ContentBlock_Redacted_Thinking { data_ :: Text } | ContentBlock_Unknown { type_ :: Text, raw :: Value } deriving stock (Generic, Show) @@ -442,6 +452,11 @@ { tool_use_id = toolUseId , code_execution_content = execContent } + "thinking" -> ContentBlock_Thinking + <$> o Aeson..: "thinking" + <*> o Aeson..: "signature" + "redacted_thinking" -> ContentBlock_Redacted_Thinking + <$> o Aeson..: "data" _ -> pure (ContentBlock_Unknown t (Aeson.Object o)) instance ToJSON ContentBlock where @@ -471,6 +486,15 @@ , "tool_use_id" Aeson..= toolUseId , "content" Aeson..= execContent ] + toJSON (ContentBlock_Thinking t sig) = Aeson.object + [ "type" Aeson..= ("thinking" :: Text) + , "thinking" Aeson..= t + , "signature" Aeson..= sig + ] + toJSON (ContentBlock_Redacted_Thinking d) = Aeson.object + [ "type" Aeson..= ("redacted_thinking" :: Text) + , "data" Aeson..= d + ] toJSON (ContentBlock_Unknown _typeName rawVal) = rawVal -- | A message in the conversation @@ -496,7 +520,9 @@ | Stop_Sequence | Tool_Use | Refusal - -- ^ Model refused the request for safety reasons (structured outputs only) + -- ^ Model refused the request for safety reasons + | Model_Context_Window_Exceeded + -- ^ Generation stopped because the context window limit was reached (Claude 4.5+) deriving stock (Eq, Generic, Show) stopReasonOptions :: Options @@ -664,6 +690,43 @@ , format = Just $ jsonSchemaFormat s } +-- | Thinking configuration for extended thinking +-- +-- * 'ThinkingAdaptive': Let Claude decide when and how much to think (Opus 4.6+). +-- Use the effort parameter ('effortConfig') to guide thinking depth. +-- * 'ThinkingEnabled': Enable thinking with a fixed token budget +-- (all models; deprecated on Opus 4.6). +-- +-- @ +-- -- Adaptive thinking (recommended for Opus 4.6) +-- thinking = Just ThinkingAdaptive +-- +-- -- Manual thinking with budget (older models) +-- thinking = Just ThinkingEnabled{ budget_tokens = 32000 } +-- @ +data Thinking + = ThinkingAdaptive + | ThinkingEnabled { budget_tokens :: Natural } + deriving stock (Eq, Generic, Show) + +instance FromJSON Thinking where + parseJSON = Aeson.withObject "Thinking" $ \o -> do + t <- o Aeson..: "type" + case (t :: Text) of + "adaptive" -> pure ThinkingAdaptive + "enabled" -> do + budget <- o Aeson..: "budget_tokens" + pure ThinkingEnabled{ budget_tokens = budget } + _ -> fail $ "Unknown thinking type: " <> show t + +instance ToJSON Thinking where + toJSON ThinkingAdaptive = Aeson.object + [ "type" Aeson..= ("adaptive" :: Text) ] + toJSON (ThinkingEnabled budget) = Aeson.object + [ "type" Aeson..= ("enabled" :: Text) + , "budget_tokens" Aeson..= budget + ] + -- | Create a JSON schema output format jsonSchemaFormat :: Value -> OutputFormat jsonSchemaFormat s = OutputFormat @@ -692,6 +755,9 @@ , output_config :: Maybe OutputConfig -- ^ Output configuration: effort level and/or structured output format. -- Use 'effortConfig', 'jsonSchemaConfig', or construct 'OutputConfig' directly. + , thinking :: Maybe Thinking + -- ^ Thinking configuration. Use 'ThinkingAdaptive' for Opus 4.6 + -- or 'ThinkingEnabled' with @budget_tokens@ for older models. } deriving stock (Generic, Show) instance FromJSON CreateMessage where @@ -717,6 +783,7 @@ , tool_choice = Nothing , container = Nothing , output_config = Nothing + , thinking = Nothing } -- | Text delta in streaming @@ -740,6 +807,8 @@ data ContentBlockDelta = Delta_Text_Delta { text :: Text } | Delta_Input_Json_Delta { partial_json :: Text } + | Delta_Thinking_Delta { thinking :: Text } + | Delta_Signature_Delta { signature :: Text } deriving stock (Generic, Show) contentBlockDeltaOptions :: Options @@ -749,6 +818,8 @@ , constructorTagModifier = \s -> case s of "Delta_Text_Delta" -> "text_delta" "Delta_Input_Json_Delta" -> "input_json_delta" + "Delta_Thinking_Delta" -> "thinking_delta" + "Delta_Signature_Delta" -> "signature_delta" _ -> s } diff --git a/tasty/Main.hs b/tasty/Main.hs --- a/tasty/Main.hs +++ b/tasty/Main.hs @@ -339,6 +339,84 @@ HUnit.assertFailure "user_id should be present and be an integer" _ -> HUnit.assertFailure "Expected exactly one tool_use block" + let adaptiveThinkingTest = + HUnit.testCase "Create message - adaptive thinking" do + Messages.MessageResponse{ content } <- + createMessage + Messages._CreateMessage + { Messages.model = "claude-opus-4-6" + , Messages.messages = + [ Messages.Message + { Messages.role = Messages.User + , Messages.content = + [ Messages.textContent "What is 2+2? Answer with just the number." + ] + , Messages.cache_control = Nothing + } + ] + , Messages.max_tokens = 4096 + , Messages.thinking = Just Messages.ThinkingAdaptive + } + + -- Should have at least one text block + let hasText = any isTextBlock (toList content) + HUnit.assertBool "Should have text content" hasText + + -- Thinking blocks may or may not be present (model decides), + -- but verify we can parse them without errors + let thinkingBlocks = + [ () + | Messages.ContentBlock_Thinking{} <- toList content + ] + let redactedBlocks = + [ () + | Messages.ContentBlock_Redacted_Thinking{} <- toList content + ] + -- Just verify counts are non-negative (always true, but exercises the pattern matches) + HUnit.assertBool "Thinking block count should be non-negative" + (length thinkingBlocks >= 0 && length redactedBlocks >= 0) + + let adaptiveThinkingStreamingTest = + HUnit.testCase "Create message - adaptive thinking streaming" do + textAcc <- IORef.newIORef Text.empty + thinkingAcc <- IORef.newIORef Text.empty + done <- Concurrent.newEmptyMVar + + let onEvent (Left _err) = Concurrent.putMVar done () + onEvent (Right ev) = case ev of + Messages.Content_Block_Delta{ Messages.delta = d } -> + case d of + Messages.Delta_Text_Delta{ Messages.text = t } -> + IORef.modifyIORef' textAcc (<> t) + Messages.Delta_Thinking_Delta{ Messages.thinking = t } -> + IORef.modifyIORef' thinkingAcc (<> t) + _ -> pure () + Messages.Message_Stop -> + Concurrent.putMVar done () + _ -> pure () + + createMessageStreamTyped + Messages._CreateMessage + { Messages.model = "claude-opus-4-6" + , Messages.messages = + [ Messages.Message + { Messages.role = Messages.User + , Messages.content = + [ Messages.textContent "What is 2+2? Answer with just the number." + ] + , Messages.cache_control = Nothing + } + ] + , Messages.max_tokens = 4096 + , Messages.thinking = Just Messages.ThinkingAdaptive + } + onEvent + + _ <- Concurrent.takeMVar done + text <- IORef.readIORef textAcc + HUnit.assertBool "Expected non-empty streamed text" + (not (Text.null text)) + -- Tool search test requires beta header let betaOptions = V1.defaultClientOptions { V1.apiKey = Text.pack key @@ -557,11 +635,18 @@ , tokenCountingTest , jsonOutputsTest , strictToolUseTest + , adaptiveThinkingTest + , adaptiveThinkingStreamingTest , toolSearchTest , programmaticToolCallingTest ] Tasty.defaultMain (Tasty.testGroup "Claude API Tests" tests) + +-- | Check if a content block is a text block +isTextBlock :: Messages.ContentBlock -> Bool +isTextBlock (Messages.ContentBlock_Text{}) = True +isTextBlock _ = False -- | Check if a content block is a server_tool_use for code_execution isCodeExecutionServerToolUse :: Messages.ContentBlock -> Bool