shikumi-tools 0.3.0.2 → 0.3.0.3
raw patch · 13 files changed
+97/−76 lines, 13 filesdep ~aesondep ~baikaidep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: aeson, baikai, bytestring, containers, directory, effectful, filepath, generic-lens, http-client, http-client-tls, http-types, process, regex-tdfa, vector
API changes (from Hackage documentation)
Files
- CHANGELOG.md +21/−0
- shikumi-tools.cabal +16/−16
- src/Shikumi/Agent/ReAct.hs +17/−17
- src/Shikumi/CodeExec/CodeAct.hs +8/−8
- src/Shikumi/CodeExec/ProgramOfThought.hs +3/−3
- src/Shikumi/CodeExec/Prompt.hs +3/−3
- src/Shikumi/Tool.hs +2/−2
- test/CodeActSpec.hs +2/−2
- test/CompactionSpec.hs +12/−12
- test/MockLLM.hs +6/−6
- test/ProtocolSpec.hs +3/−3
- test/ToolSpec.hs +2/−2
- test/WebSpec.hs +2/−2
CHANGELOG.md view
@@ -2,6 +2,27 @@ ## Unreleased +## 0.3.0.3 — 2026-08-29++### Changed++- Every library dependency now carries a PVP upper bound: `aeson`, `bytestring`,+ `containers`, `directory`, `effectful`, `filepath`, `generic-lens`,+ `http-client`, `http-client-tls`, `http-types`, `process`, `regex-tdfa`,+ `vector`. `cabal check` reported these under `missing-upper-bounds`. Without+ one, a future breaking release of a dependency enters a consumer's build plan+ unchecked — which is the failure the bound exists to prevent.++ Each bound admits the version this package is built and tested against and+ stops below the next major.++ `aeson` stops at `<2.3` rather than `<2.4`: baikai-openai 0.5 constrains it to+ `^>=2.2`, so aeson 2.3 is not reachable for this cohort and a wider bound+ would assert compatibility that cannot be exercised here.++ `http-client-tls` stops at `<0.4` for the same reason — baikai-openai 0.5+ constrains it to `^>=0.3`.+ ## 0.3.0.2 — 2026-08-07 ### Changed
shikumi-tools.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.4 name: shikumi-tools-version: 0.3.0.2+version: 0.3.0.3 synopsis: Typed tools and ReAct agents for shikumi LM programs (EP-11) @@ -57,24 +57,24 @@ Shikumi.Tool.Web build-depends:- , aeson- , baikai >=0.5 && <0.6+ , aeson >=2.2 && <2.3+ , baikai >=0.6 && <0.7 , base >=4.20 && <5- , bytestring- , containers- , directory- , effectful- , filepath- , generic-lens- , http-client- , http-client-tls- , http-types+ , bytestring >=0.11 && <0.13+ , containers >=0.6 && <0.9+ , directory >=1.3 && <1.4+ , effectful >=2.5 && <2.7+ , filepath >=1.4 && <1.6+ , generic-lens >=2.2 && <2.4+ , http-client >=0.7 && <0.8+ , http-client-tls >=0.3 && <0.4+ , http-types >=0.12 && <0.13 , lens ^>=5.3- , process- , regex-tdfa+ , process >=1.6 && <1.7+ , regex-tdfa >=1.3 && <1.4 , shikumi ^>=0.3.0.0 , text ^>=2.1- , vector+ , vector >=0.13 && <0.14 test-suite shikumi-tools-test import: common-options@@ -102,7 +102,7 @@ build-depends: , aeson- , baikai >=0.5 && <0.6+ , baikai >=0.6 && <0.7 , base , bytestring , containers
src/Shikumi/Agent/ReAct.hs view
@@ -62,12 +62,12 @@ ToolCall, ToolChoice (..), Usage,+ emptyContext,+ emptyModel,+ emptyOptions,+ emptyToolCall, flattenAssistantBlocks, user,- _Context,- _Model,- _Options,- _ToolCall, ) import Control.Lens ((&), (.~), (^.)) import Data.Aeson (Value (..), eitherDecodeStrict, encode)@@ -208,7 +208,7 @@ pure (o, traj) where impl :: ProtocolImpl i o- impl = resolveProtocol (protocol cfg) _Model sig reg+ impl = resolveProtocol (protocol cfg) emptyModel sig reg -- Propose -> dispatch -> observe, accumulating steps (newest first). The -- iteration counter advances once per model turn, even when a native model@@ -235,14 +235,14 @@ let (ctx, opts) = renderExtract impl i traj (trajForExtract, resp) <- catchError- ((traj,) <$> complete _Model ctx opts)+ ((traj,) <$> complete emptyModel ctx opts) ( \_cs -> \case e@(ContextWindowExceeded {}) | not (enabled (compaction cfg)) -> throwError e ContextWindowExceeded {} -> do compacted <- forceCompactTrajectory traj let (ctx', opts') = renderExtract impl i compacted- (compacted,) <$> complete _Model ctx' opts'+ (compacted,) <$> complete emptyModel ctx' opts' e -> throwError e ) o <- either throwError pure (parseExtract impl resp)@@ -252,14 +252,14 @@ completeProposeRecover acc = do let (ctx, opts) = renderPropose impl i (soFar acc) catchError- ((acc,) <$> complete _Model ctx opts)+ ((acc,) <$> complete emptyModel ctx opts) ( \_cs -> \case e@(ContextWindowExceeded {}) | not (enabled (compaction cfg)) -> throwError e ContextWindowExceeded {} -> do compacted <- forceCompactAcc acc let (ctx', opts') = renderPropose impl i (soFar compacted)- (compacted,) <$> complete _Model ctx' opts'+ (compacted,) <$> complete emptyModel ctx' opts' e -> throwError e ) @@ -270,11 +270,11 @@ forceCompactAcc :: [Step] -> Eff es [Step] forceCompactAcc acc =- reverse <$> compactTail (compaction cfg) _Model renderStepLine summaryStep (reverse acc)+ reverse <$> compactTail (compaction cfg) emptyModel renderStepLine summaryStep (reverse acc) forceCompactTrajectory :: Trajectory -> Eff es Trajectory forceCompactTrajectory traj = do- compacted <- compactTail (compaction cfg) _Model renderStepLine summaryStep (V.toList (steps traj))+ compacted <- compactTail (compaction cfg) emptyModel renderStepLine summaryStep (V.toList (steps traj)) pure (traj {steps = V.fromList compacted}) dispatchCalls :: Text -> NonEmpty (Text, Value) -> [Step] -> Eff es [Step]@@ -321,7 +321,7 @@ -- | A baikai 'ToolCall' built from a name and a raw arguments object (the call id -- is irrelevant on the prompt path and synthesized on the native path). mkToolCall :: Text -> Value -> ToolCall-mkToolCall nm args = _ToolCall & #name .~ nm & #arguments .~ args+mkToolCall nm args = emptyToolCall & #name .~ nm & #arguments .~ args -- --------------------------------------------------------------------------- -- The protocol seam@@ -387,7 +387,7 @@ <> "\n" <> proposeGrammar msg = user (taskBlock i <> "\n\n" <> historyBlock traj)- in (buildCtx sys [msg] V.empty Nothing, _Options),+ in (buildCtx sys [msg] V.empty Nothing, emptyOptions), parsePropose = \resp -> actionToProposal <$> parseActionText (responseText resp), renderExtract = \i traj -> let sys =@@ -395,7 +395,7 @@ <> "\n\n" <> extractGuide (toSchema (Proxy @o)) msg = user (taskBlock i <> "\n\n" <> historyBlock traj)- in (buildCtx sys [msg] V.empty Nothing, _Options),+ in (buildCtx sys [msg] V.empty Nothing, emptyOptions), parseExtract = \resp -> parseOutput (stripFences (responseText resp)) } @@ -416,7 +416,7 @@ getInstruction sig <> "\n\nUse a tool when you need one, or answer directly when you have enough information." msg = user (taskBlock i <> "\n\n" <> historyBlock traj)- opts = _Options & #toolChoice .~ Just ToolChoiceAuto+ opts = emptyOptions & #toolChoice .~ Just ToolChoiceAuto in (buildCtx sys [msg] (registryBaikai reg) Nothing, opts), -- Tool-call blocks -> calls executed in order; no tool call (plain text) -> finish. parsePropose = \resp ->@@ -436,7 +436,7 @@ -- Suppress tools so the model answers; attach the output schema (a -- no-op until EP-2's responseFormat is wired in the local baikai). opts =- attachSchema (toSchema (Proxy @o)) _Options+ attachSchema (toSchema (Proxy @o)) emptyOptions & #toolChoice .~ Just ToolChoiceNone in (buildCtx sys [msg] V.empty Nothing, opts), parseExtract = \resp -> parseOutput (stripFences (responseText resp))@@ -448,7 +448,7 @@ buildCtx :: Text -> [Message] -> Vector Tool -> Maybe ToolChoice -> Context buildCtx sys msgs tools _ =- _Context+ emptyContext & #systemPrompt .~ Just sys & #messages .~ V.fromList msgs & #tools .~ tools
src/Shikumi/CodeExec/CodeAct.hs view
@@ -25,7 +25,7 @@ ) where -import Baikai (Model, Response, ToolCall, Usage, _Model, _ToolCall)+import Baikai (Model, Response, ToolCall, Usage, emptyModel, emptyToolCall) import Control.Lens ((&), (.~), (^.)) import Data.Aeson (Value (..), eitherDecodeStrict) import Data.Aeson.KeyMap qualified as KM@@ -130,7 +130,7 @@ (ctx, opts) = simpleContext extractSys prompt (trajForExtract, resp) <- catchError- ((traj,) <$> complete _Model ctx opts)+ ((traj,) <$> complete emptyModel ctx opts) ( \_cs -> \case e@(ContextWindowExceeded {}) | not (enabled (compaction cfg)) -> throwError e@@ -138,7 +138,7 @@ compacted <- forceCompactTrajectory traj let prompt' = "Task:\n" <> toPrompt i <> "\n\nTrajectory:\n" <> renderTrajectory compacted (ctx', opts') = simpleContext extractSys prompt'- (compacted,) <$> complete _Model ctx' opts'+ (compacted,) <$> complete emptyModel ctx' opts' e -> throwError e ) o <- either throwError pure (parseOutput (stripFences (responseText resp)))@@ -148,14 +148,14 @@ completeTurnRecover acc = do let (ctx, opts) = simpleContext turnSys (turnUser acc) catchError- ((acc,) <$> complete _Model ctx opts)+ ((acc,) <$> complete emptyModel ctx opts) ( \_cs -> \case e@(ContextWindowExceeded {}) | not (enabled (compaction cfg)) -> throwError e ContextWindowExceeded {} -> do compacted <- forceCompactAcc acc let (ctx', opts') = simpleContext turnSys (turnUser compacted)- (compacted,) <$> complete _Model ctx' opts'+ (compacted,) <$> complete emptyModel ctx' opts' e -> throwError e ) @@ -166,11 +166,11 @@ forceCompactAcc :: [Step] -> Eff es [Step] forceCompactAcc acc =- reverse <$> compactTail (compaction cfg) _Model renderStepLine summaryStep (reverse acc)+ reverse <$> compactTail (compaction cfg) emptyModel renderStepLine summaryStep (reverse acc) forceCompactTrajectory :: Trajectory -> Eff es Trajectory forceCompactTrajectory traj = do- compacted <- compactTail (compaction cfg) _Model renderStepLine summaryStep (V.toList (steps traj))+ compacted <- compactTail (compaction cfg) emptyModel renderStepLine summaryStep (V.toList (steps traj)) pure (traj {steps = V.fromList compacted}) turnUser acc =@@ -213,7 +213,7 @@ -- | A baikai 'ToolCall' from a name and raw arguments object (the id is irrelevant). mkToolCall :: Text -> Value -> ToolCall-mkToolCall nm args = _ToolCall & #name .~ nm & #arguments .~ args+mkToolCall nm args = emptyToolCall & #name .~ nm & #arguments .~ args -- | A synthetic step recording an unparseable reply, fed back as an observation. correctiveStep :: Text -> Step
src/Shikumi/CodeExec/ProgramOfThought.hs view
@@ -21,7 +21,7 @@ ) where -import Baikai (_Model)+import Baikai (emptyModel) import Data.Proxy (Proxy (..)) import Data.Text (Text) import Data.Text qualified as T@@ -90,7 +90,7 @@ propose :: Maybe (Text, Text) -> Eff es Text propose mPrev = do let (ctx, opts) = simpleContext (proposeSys mPrev) (toPrompt i)- resp <- complete _Model ctx opts+ resp <- complete emptyModel ctx opts pure (stripFences (responseText resp)) -- Extract: hand the model the final code and its output, ask for the typed o.@@ -98,7 +98,7 @@ extract code out = do let prompt = toPrompt i <> "\n\nThe code:\n" <> code <> "\n\nIts output:\n" <> out (ctx, opts) = simpleContext extractSys prompt- resp <- complete _Model ctx opts+ resp <- complete emptyModel ctx opts either throwError pure (parseOutput (stripFences (responseText resp))) proposeSys Nothing =
src/Shikumi/CodeExec/Prompt.hs view
@@ -11,7 +11,7 @@ ) where -import Baikai (Context, Options, user, _Context, _Options)+import Baikai (Context, Options, emptyContext, emptyOptions, user) import Control.Lens ((&), (.~)) import Data.Aeson (Value, encode) import Data.ByteString.Lazy qualified as LBS@@ -25,8 +25,8 @@ -- options. The neutral one-turn shape both code-execution loops use per model call. simpleContext :: Text -> Text -> (Context, Options) simpleContext sys userMsg =- ( _Context & #systemPrompt .~ Just sys & #messages .~ V.singleton (user userMsg),- _Options+ ( emptyContext & #systemPrompt .~ Just sys & #messages .~ V.singleton (user userMsg),+ emptyOptions ) -- | Strip a leading/trailing Markdown code fence (@```@ / @```json … ```@), if any,
src/Shikumi/Tool.hs view
@@ -48,7 +48,7 @@ ) where -import Baikai (ToolCall, _Tool)+import Baikai (ToolCall, emptyTool) import Baikai qualified as B import Control.Lens ((&), (.~), (^.)) import Data.Aeson (ToJSON, Value, encode)@@ -100,7 +100,7 @@ -- schema into @parameters@. This is the single sanctioned typed -> wire lowering. lowerTool :: forall i o. (ToSchema i) => Tool i o -> B.Tool lowerTool t =- _Tool+ emptyTool & #name .~ name t & #description .~ description t & #parameters .~ toolSchemaOf t
test/CodeActSpec.hs view
@@ -8,7 +8,7 @@ -- typed answer is extracted. module CodeActSpec (tests) where -import Baikai (_Model)+import Baikai (emptyModel) import Control.Lens ((&), (.~)) import Data.Aeson (object, (.=)) import Data.Generics.Labels ()@@ -108,7 +108,7 @@ { maxIters = 3, compaction = defaultCompactionConfig {reserveTokens = 10, keepRecent = 1} }- model = _Model & #contextWindow .~ 100+ model = emptyModel & #contextWindow .~ 100 script = [ mkUsageResponse model 10 (turn "result = 1" False), mkUsageResponse model 90 (turn "result = 2" False),
test/CompactionSpec.hs view
@@ -1,6 +1,6 @@ module CompactionSpec (tests) where -import Baikai (_Model, _Usage)+import Baikai (emptyModel, zeroUsage) import Control.Lens ((&), (.~)) import Data.Aeson (Value (..)) import Data.Generics.Labels ()@@ -50,24 +50,24 @@ "Compaction" [ testCase "usageExceedsWindow flips at the boundary" $ do let cfg = defaultCompactionConfig {reserveTokens = 100}- model = _Model & #contextWindow .~ 1000- usage n = _Usage & #inputTokens .~ n+ model = emptyModel & #contextWindow .~ 1000+ usage n = zeroUsage & #inputTokens .~ n overflowThreshold cfg model @?= 900 usageExceedsWindow cfg model (usage 899) @?= False usageExceedsWindow cfg model (usage 900) @?= True usageExceedsWindow (cfg {enabled = False}) model (usage 900) @?= False- usageExceedsWindow cfg _Model (usage 0) @?= False- overflowThreshold cfg (_Model & #contextWindow .~ 50) @?= 0,+ usageExceedsWindow cfg emptyModel (usage 0) @?= False+ overflowThreshold cfg (emptyModel & #contextWindow .~ 50) @?= 0, testCase "compactTail folds older items and keeps the recent tail" $ do let cfg = defaultCompactionConfig {keepRecent = 2} res <- runEffMock [mkTextResponse "S"] $- compactTail cfg _Model id ("summary:" <>) (["e1", "e2", "e3", "e4", "e5", "e6"] :: [Text])+ compactTail cfg emptyModel id ("summary:" <>) (["e1", "e2", "e3", "e4", "e5", "e6"] :: [Text]) res @?= Right ["summary:S", "e5", "e6"], testCase "compactTail with enabled=False is the identity and calls no model" $ do let cfg = defaultCompactionConfig {enabled = False, keepRecent = 0} items = ["e1", "e2", "e3"] :: [Text]- res <- runEffMock [] $ compactTail cfg _Model id ("summary:" <>) items+ res <- runEffMock [] $ compactTail cfg emptyModel id ("summary:" <>) items res @?= Right items, testCase "agent on tiny window compacts and completes" $ do let cfg =@@ -76,7 +76,7 @@ protocol = ProtocolPrompt, compaction = defaultCompactionConfig {reserveTokens = 10, keepRecent = 1} }- model = _Model & #contextWindow .~ 100+ model = emptyModel & #contextWindow .~ 100 script = [ mkUsageResponse model 10 (callReply "first"), mkUsageResponse model 90 (callReply "second"),@@ -108,7 +108,7 @@ protocol = ProtocolPrompt, compaction = defaultCompactionConfig {reserveTokens = 10, keepRecent = 0} }- model = _Model & #contextWindow .~ 100+ model = emptyModel & #contextWindow .~ 100 script = [ mkUsageResponse model 10 (callReply "first"), mkTextResponse "reactive summary",@@ -133,7 +133,7 @@ compaction = defaultCompactionConfig {enabled = False, reserveTokens = 10, keepRecent = 0} } script =- [ mkUsageResponse (_Model & #contextWindow .~ 100) 10 (callReply "first"),+ [ mkUsageResponse (emptyModel & #contextWindow .~ 100) 10 (callReply "first"), mkTextResponse "unused summary", mkTextResponse finishReply, mkTextResponse extractReply@@ -152,7 +152,7 @@ protocol = ProtocolPrompt, compaction = defaultCompactionConfig {reserveTokens = 10, keepRecent = 1} }- model = _Model & #contextWindow .~ 100+ model = emptyModel & #contextWindow .~ 100 script = [ mkUsageResponse model 10 (callReply "first"), mkTextResponse finishReply,@@ -176,7 +176,7 @@ protocol = ProtocolPrompt, compaction = defaultCompactionConfig {reserveTokens = 10, keepRecent = 0} }- model = _Model & #contextWindow .~ 100+ model = emptyModel & #contextWindow .~ 100 script = [ mkUsageResponse model 10 (callReply "first"), mkTextResponse "reactive summary"
test/MockLLM.hs view
@@ -22,9 +22,9 @@ ( AssistantContent (..), Model, Response,- _Response,- _TextContent,- _ToolCall,+ emptyResponse,+ emptyTextContent,+ emptyToolCall, ) import Control.Lens ((&), (.~)) import Data.Aeson (Value)@@ -110,7 +110,7 @@ -- | An assistant 'Response' carrying @t@ as its single text block. mkTextResponse :: Text -> Response mkTextResponse t =- _Response & #message . #content .~ V.singleton (AssistantText (_TextContent & #text .~ t))+ emptyResponse & #message . #content .~ V.singleton (AssistantText (emptyTextContent & #text .~ t)) -- | A text response that also carries a resolved model and input-token usage. mkUsageResponse :: Model -> Natural -> Text -> Response@@ -127,10 +127,10 @@ -- | An assistant 'Response' carrying several native tool-call blocks in order. mkToolCallsResponse :: [(Text, Text, Value)] -> Response mkToolCallsResponse calls =- _Response+ emptyResponse & #message . #content .~ V.fromList- [ AssistantToolCall (_ToolCall & #id_ .~ callId & #name .~ nm & #arguments .~ args)+ [ AssistantToolCall (emptyToolCall & #id_ .~ callId & #name .~ nm & #arguments .~ args) | (callId, nm, args) <- calls ]
test/ProtocolSpec.hs view
@@ -6,7 +6,7 @@ -- prompt path; a native-capable model picks the native path). module ProtocolSpec (tests) where -import Baikai (Api (..), _Model)+import Baikai (Api (..), emptyModel) import Control.Lens ((&), (.~)) import Data.Aeson (object, (.=)) import Data.Generics.Labels ()@@ -60,9 +60,9 @@ V.length (steps tP) @?= 2 _ -> assertFailure "both protocols should succeed", testCase "ProtocolAuto picks prompt for a CLI model" $- resolveProtocolKind ProtocolAuto (_Model & #api .~ AnthropicMessagesCli) @?= ProtocolPrompt,+ resolveProtocolKind ProtocolAuto (emptyModel & #api .~ AnthropicMessagesCli) @?= ProtocolPrompt, testCase "ProtocolAuto picks native for a native-capable model" $- resolveProtocolKind ProtocolAuto (_Model & #provider .~ "openai" & #api .~ OpenAIChatCompletions) @?= ProtocolNative,+ resolveProtocolKind ProtocolAuto (emptyModel & #provider .~ "openai" & #api .~ OpenAIChatCompletions) @?= ProtocolNative, testCase "native turn with two tool calls executes both in order" $ do let parisArgs = object ["city" .= ("Paris" :: Text), "units" .= ("c" :: Text)] londonArgs = object ["city" .= ("London" :: Text), "units" .= ("c" :: Text)]
test/ToolSpec.hs view
@@ -5,7 +5,7 @@ -- typed 'ToolError' (a value), never an exception. module ToolSpec (tests) where -import Baikai (ToolCall, _ToolCall)+import Baikai (ToolCall, emptyToolCall) import Control.Lens ((&), (.~)) import Data.Aeson (Value, object, (.=)) import Data.Generics.Labels ()@@ -20,7 +20,7 @@ import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=)) tc :: Text -> Value -> ToolCall-tc nm args = _ToolCall & #name .~ nm & #arguments .~ args+tc nm args = emptyToolCall & #name .~ nm & #arguments .~ args budgetTool :: Tool WeatherReq WeatherResp budgetTool =
test/WebSpec.hs view
@@ -3,7 +3,7 @@ module WebSpec (tests) where -import Baikai (ToolCall, _ToolCall)+import Baikai (ToolCall, emptyToolCall) import Control.Lens ((&), (.~)) import Data.Aeson (Value, object, (.=)) import Data.ByteString qualified as BS@@ -31,7 +31,7 @@ import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=)) tc :: Text -> Value -> ToolCall-tc nm args = _ToolCall & #name .~ nm & #arguments .~ args+tc nm args = emptyToolCall & #name .~ nm & #arguments .~ args tests :: TestTree tests =