shikumi 0.3.0.2 → 0.3.0.3
raw patch · 19 files changed
+150/−126 lines, 19 filesdep ~aesondep ~baikaidep ~baikai-claudePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: aeson, baikai, baikai-claude, baikai-effectful, baikai-openai, base64-bytestring, bytestring, containers, effectful, filepath, generic-lens, scientific, stm, time, vector
API changes (from Hackage documentation)
Files
- CHANGELOG.md +18/−0
- shikumi.cabal +21/−21
- src/Shikumi/Adapter.hs +6/−6
- src/Shikumi/Compaction.hs +4/−4
- src/Shikumi/Module.hs +4/−4
- src/Shikumi/Program.hs +3/−3
- src/Shikumi/Routing.hs +2/−2
- src/Shikumi/Stream.hs +7/−7
- test/AdapterSpec.hs +6/−6
- test/EndToEndSpec.hs +5/−5
- test/LiveSpec.hs +2/−2
- test/MultimodalEndToEndSpec.hs +5/−5
- test/ProgramFixtures.hs +3/−3
- test/RefineSpec.hs +7/−7
- test/RoutingSpec.hs +7/−5
- test/StreamSpec.hs +10/−10
- test/StubProvider.hs +34/−30
- test/TwoStepSpec.hs +3/−3
- test/XmlAdapterSpec.hs +3/−3
CHANGELOG.md view
@@ -2,6 +2,24 @@ ## Unreleased +## 0.3.0.3 — 2026-08-29++### Changed++- Every library dependency now carries a PVP upper bound: `aeson`,+ `base64-bytestring`, `bytestring`, `containers`, `effectful`, `filepath`,+ `generic-lens`, `scientific`, `stm`, `time`, `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.+ ## 0.3.0.2 — 2026-08-07 ### Changed
shikumi.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.4 name: shikumi-version: 0.3.0.2+version: 0.3.0.3 synopsis: Typed, structured, evaluable LM programs over baikai category: AI description:@@ -52,24 +52,24 @@ Shikumi.Stream build-depends:- , aeson- , baikai >=0.5 && <0.6- , baikai-claude >=0.5 && <0.6- , baikai-effectful >=0.3.0.3 && <0.4- , baikai-openai >=0.5 && <0.6- , base >=4.20 && <5- , base64-bytestring- , bytestring- , containers- , effectful- , filepath- , generic-lens+ , aeson >=2.2 && <2.3+ , baikai >=0.6 && <0.7+ , baikai-claude >=0.6 && <0.7+ , baikai-effectful >=0.4 && <0.5+ , baikai-openai >=0.6 && <0.7+ , base >=4.20 && <5+ , base64-bytestring >=1.2 && <1.3+ , bytestring >=0.11 && <0.13+ , containers >=0.6 && <0.9+ , effectful >=2.5 && <2.7+ , filepath >=1.4 && <1.6+ , generic-lens >=2.2 && <2.4 , lens ^>=5.3- , scientific- , stm+ , scientific >=0.3 && <0.4+ , stm >=2.5 && <2.6 , text ^>=2.1- , time- , vector+ , time >=1.12 && <1.17+ , vector >=0.13 && <0.14 test-suite shikumi-test import: common-options@@ -109,10 +109,10 @@ build-depends: , aeson- , baikai >=0.5 && <0.6- , baikai-claude >=0.5 && <0.6- , baikai-effectful >=0.3.0.3 && <0.4- , baikai-openai >=0.5 && <0.6+ , baikai >=0.6 && <0.7+ , baikai-claude >=0.6 && <0.7+ , baikai-effectful >=0.4 && <0.5+ , baikai-openai >=0.6 && <0.7 , base , base64-bytestring , bytestring
src/Shikumi/Adapter.hs view
@@ -71,11 +71,11 @@ Response, TextContent (..), assistant,+ emptyContext,+ emptyOptions, flattenAssistantBlocks, user, userImage,- _Context,- _Options, ) import Control.Lens (at, (&), (.~), (?~), (^.)) import Data.Aeson (Object, Value (..), eitherDecodeStrict, toJSON)@@ -281,7 +281,7 @@ { render = \sig i -> let sys = systemHeader sig <> nativeOutputGuide sig ctx = buildContext sys (nativeDemoMessages sig ++ [userTurn i])- opts = attachSchema (deriveSchema @o) _Options+ opts = attachSchema (deriveSchema @o) emptyOptions in (ctx, opts), parse = \_sig resp -> assistantJSON resp >>= fromModelChecked }@@ -297,7 +297,7 @@ { render = \sig i -> let sys = systemHeader sig <> fallbackOutputGuide sig ctx = buildContext sys (demoMessages sig ++ [userTurn i])- in (ctx, _Options),+ in (ctx, emptyOptions), parse = \_sig resp -> let sections = parseMarkers (responseText resp) obj = sectionsToObject (deriveSchema @o) sections@@ -329,7 +329,7 @@ { render = \sig i -> let sys = systemHeader sig <> xmlOutputGuide sig ctx = buildContext sys (xmlDemoMessages sig ++ [userTurn i])- in (ctx, _Options),+ in (ctx, emptyOptions), parse = \sig resp -> let names = map fieldName (outputFields sig) sections = parseXmlTags names (responseText resp)@@ -343,7 +343,7 @@ buildContext :: Text -> [Message] -> Context buildContext sys msgs =- _Context & #systemPrompt .~ Just sys & #messages .~ V.fromList msgs+ emptyContext & #systemPrompt .~ Just sys & #messages .~ V.fromList msgs -- | Build the final user turn for an input. If the input has an image field, it is -- lowered to a baikai 'userImage' block, with the remaining (text) fields rendered
src/Shikumi/Compaction.hs view
@@ -17,10 +17,10 @@ Response, TextContent (..), Usage,+ emptyContext,+ emptyOptions, flattenAssistantBlocks, user,- _Context,- _Options, ) import Control.Lens ((&), (.~), (^.)) import Data.Generics.Labels ()@@ -94,7 +94,7 @@ summaryRequest :: Text -> (Context, Options) summaryRequest rendered =- ( _Context+ ( emptyContext & #systemPrompt .~ Just ( T.unlines@@ -104,7 +104,7 @@ ] ) & #messages .~ V.singleton (user rendered),- _Options+ emptyOptions ) renderItems :: (a -> Text) -> [a] -> Text
src/Shikumi/Module.hs view
@@ -28,7 +28,7 @@ ) where -import Baikai (user, _Context, _Model, _Options)+import Baikai (emptyContext, emptyModel, emptyOptions, user) import Control.Lens ((&), (.~)) import Data.Aeson (Object, Value (Object)) import Data.Aeson.Key qualified as Key@@ -191,15 +191,15 @@ twoStep sig = embed $ \i -> do -- 1. Free-form call: plain prose, no structured shape requested. let ffCtx =- _Context+ emptyContext & #systemPrompt .~ Just (freeFormSystem sig) & #messages .~ V.fromList [user (toPrompt i)]- ffResp <- complete _Model ffCtx _Options+ ffResp <- complete emptyModel ffCtx emptyOptions -- 2. Extraction call: coerce the prose into the typed output via the marker -- fallback adapter (a robust extraction target that already round-trips). let exSig = extractSig sig (exCtx, exOpts) = render fallbackAdapter exSig (ExtractIn (responseText ffResp))- exResp <- complete _Model exCtx exOpts+ exResp <- complete emptyModel exCtx exOpts either throwError pure (parse fallbackAdapter exSig exResp) -- | The plain-prose system prompt for the free-form call (mirrors DSPy's
src/Shikumi/Program.hs view
@@ -82,7 +82,7 @@ ) where -import Baikai (Model, _Model)+import Baikai (Model, emptyModel) import Data.Aeson (FromJSON, ToJSON, Value) import Data.Functor.Const (Const (..)) import Data.Functor.Identity (Identity (..))@@ -255,10 +255,10 @@ -- ambient model is supplied below the stack by "Shikumi.Routing".@runRouting@ and -- the router ("Shikumi.Routing".@routeLLM@) overwrites this placeholder with it on -- every outgoing call. With no router installed (the bare-stub test path) the call--- still carries '_Model', which 'adapterFor' maps to the prompt-fallback adapter —+-- still carries 'emptyModel', which 'adapterFor' maps to the prompt-fallback adapter — -- preserving EP-4's original behaviour for un-routed runs. placeholderModel :: Model-placeholderModel = _Model+placeholderModel = emptyModel -- | Interpret a program as a typed @Eff@ computation. A 'Predict' node overlays -- its 'Params' onto the signature (effective instruction + decoded demos), renders
src/Shikumi/Routing.hs view
@@ -45,7 +45,7 @@ ) where -import Baikai (Context, Message (..), Model, Options, ResponseFormat (..), assistant)+import Baikai (Context, JsonSchemaFormat (strict), Message (..), Model, Options, ResponseFormat (..), assistant, jsonSchemaFormat) import Control.Lens ((&), (.~), (^.)) import Data.Aeson (FromJSON, Result (..), Value, fromJSON) import Data.Generics.Labels ()@@ -125,7 +125,7 @@ withSchema o | isNative, Just s <- mSchema =- o & #responseFormat .~ Just (JsonSchema {name = "output", schema = s, strict = True})+ o & #responseFormat .~ Just (JsonSchema ((jsonSchemaFormat "output" s) {strict = True})) | otherwise = o withTemp o = case mTemp of Just t -> o & #temperature .~ Just t
src/Shikumi/Stream.hs view
@@ -50,9 +50,9 @@ Options, Response, TerminalPayload (..),- _Model,- _Response,- _TextContent,+ emptyModel,+ emptyResponse,+ emptyTextContent, ) import Control.Lens ((&), (.~)) import Data.Generics.Labels ()@@ -183,7 +183,7 @@ -- program fails with the real transport error, not a decode of a partial body. reassemble :: [AssistantMessageEvent] -> Response reassemble evs = case terminalPayloads of- (p : _) -> _Response & #message .~ p+ (p : _) -> emptyResponse & #message .~ p [] -> synthResponse (fromMaybe "" (firstTextEnd evs)) where terminalPayloads =@@ -193,7 +193,7 @@ -- | A response carrying @t@ as its single assistant text block. synthResponse :: Text -> Response synthResponse t =- _Response & #message . #content .~ V.singleton (AssistantText (_TextContent & #text .~ t))+ emptyResponse & #message . #content .~ V.singleton (AssistantText (emptyTextContent & #text .~ t)) -- --------------------------------------------------------------------------- -- M2/M3: streaming a whole program@@ -260,7 +260,7 @@ Eff es o streamPredict sig ps i cb = do sig' <- effectiveSignature sig ps- let adapter = adapterFor _Model+ let adapter = adapterFor emptyModel (ctx, opts0) = render adapter sig' i (nativeSys, nativeDemos) = nativeRenderPieces @i @o sig' opts = attachNativeRender nativeSys nativeDemos (attachSchema (deriveSchema @o) opts0)@@ -268,7 +268,7 @@ (x : _) -> x [] -> "" cb (StreamStatus (Status LmStart "LM call started"))- resp <- streamComplete fieldNm _Model ctx opts cb+ resp <- streamComplete fieldNm emptyModel ctx opts cb cb (StreamStatus (Status LmEnd "LM call finished")) either throwError pure (parseResponse sig' resp)
test/AdapterSpec.hs view
@@ -9,9 +9,9 @@ AssistantContent (..), Model, Response,- _Model,- _Response,- _TextContent,+ emptyModel,+ emptyResponse,+ emptyTextContent, ) import Control.Lens ((&), (.~), (^.)) import Data.Generics.Labels ()@@ -34,10 +34,10 @@ import Test.Tasty.HUnit (testCase, (@?=)) anthropicModel :: Model-anthropicModel = _Model & #provider .~ "anthropic" & #api .~ AnthropicMessages+anthropicModel = emptyModel & #provider .~ "anthropic" & #api .~ AnthropicMessages ollamaModel :: Model-ollamaModel = _Model & #provider .~ "ollama" & #api .~ Custom "ollama"+ollamaModel = emptyModel & #provider .~ "ollama" & #api .~ Custom "ollama" sig :: Signature Article Summary sig = setDemos [Demo sampleArticle sampleSummary] (mkSignature "Summarize the article")@@ -45,7 +45,7 @@ -- | Build a response whose single assistant text block carries the given body. mkResponse :: Text -> Response mkResponse t =- _Response & #message . #content .~ V.singleton (AssistantText (_TextContent & #text .~ t))+ emptyResponse & #message . #content .~ V.singleton (AssistantText (emptyTextContent & #text .~ t)) markerBody :: Text markerBody =
test/EndToEndSpec.hs view
@@ -8,9 +8,9 @@ ( AssistantContent (..), Model, Response,- _Model,- _Response,- _TextContent,+ emptyModel,+ emptyResponse,+ emptyTextContent, ) import Control.Lens ((&), (.~)) import Data.Generics.Labels ()@@ -39,12 +39,12 @@ runSig :: (LLM :> es) => Adapter i o -> Signature i o -> i -> Eff es (Either ShikumiError o) runSig adapter signature i = do let (ctx, opts) = render adapter signature i- resp <- complete (_Model :: Model) ctx opts+ resp <- complete (emptyModel :: Model) ctx opts pure (parse adapter signature resp) mkResponse :: Text -> Response mkResponse t =- _Response & #message . #content .~ V.singleton (AssistantText (_TextContent & #text .~ t))+ emptyResponse & #message . #content .~ V.singleton (AssistantText (emptyTextContent & #text .~ t)) sig :: Signature Article Summary sig = setDemos [Demo sampleArticle sampleSummary] (mkSignature "Summarize the article")
test/LiveSpec.hs view
@@ -32,8 +32,8 @@ case live of Just "1" -> do OpenAI.register- let ctx = _Context & #messages .~ V.singleton (user "Reply with a single word.")- opts = _Options & #maxTokens .~ Just 16+ let ctx = emptyContext & #messages .~ V.singleton (user "Reply with a single word.")+ opts = emptyOptions & #maxTokens .~ Just 16 cfg = defaultLLMConfig globalProviderRegistry out <- runEff . runConcurrent . runErrorNoCallStack @ShikumiError . runLLMResilient cfg $ do
test/MultimodalEndToEndSpec.hs view
@@ -17,9 +17,9 @@ Response, TextContent (..), UserContent (..),- _Model,- _Response,- _TextContent,+ emptyModel,+ emptyResponse,+ emptyTextContent, ) import Control.Lens ((&), (.~), (^.)) import Data.ByteString qualified as BS@@ -69,12 +69,12 @@ runSig :: (LLM :> es) => Adapter i o -> Signature i o -> i -> Eff es (Either ShikumiError o) runSig adapter signature i = do let (ctx, opts) = render adapter signature i- resp <- complete (_Model :: Model) ctx opts+ resp <- complete (emptyModel :: Model) ctx opts pure (parse adapter signature resp) mkResponse :: Text -> Response mkResponse t =- _Response & #message . #content .~ V.singleton (AssistantText (_TextContent & #text .~ t))+ emptyResponse & #message . #content .~ V.singleton (AssistantText (emptyTextContent & #text .~ t)) cannedAnswer :: Response cannedAnswer =
test/ProgramFixtures.hs view
@@ -36,8 +36,8 @@ ( AssistantContent (..), Context, Response,- _Response,- _TextContent,+ emptyResponse,+ emptyTextContent, ) import Control.Lens ((&), (.~), (^.)) import Data.Generics.Labels ()@@ -150,7 +150,7 @@ -- | An assistant 'Response' carrying @t@ as its single text block. mkResponse :: Text -> Response mkResponse t =- _Response & #message . #content .~ V.singleton (AssistantText (_TextContent & #text .~ t))+ emptyResponse & #message . #content .~ V.singleton (AssistantText (emptyTextContent & #text .~ t)) outlineResponse :: Response outlineResponse = mkResponse (markerBody [("points", "[\"intro\", \"body\", \"end\"]")])
test/RefineSpec.hs view
@@ -4,13 +4,13 @@ -- ('Shikumi.Refine.bestOfN', 'Shikumi.Refine.refine', -- 'Shikumi.Refine.multiChainComparison'). ----- Every test installs the production router (@routeLLM . runRouting _Model@) above a+-- Every test installs the production router (@routeLLM . runRouting emptyModel@) above a -- deterministic stub @LLM@ (see "RefineStub") so per-sample temperature reaches the -- wire exactly as in production — no network, no API key. The headline assertion -- (M4) shows a deliberately-weak program's score strictly improves once wrapped. module RefineSpec (tests) where -import Baikai (Context, Options, _Model)+import Baikai (Context, Options, emptyModel) import Data.IORef (newIORef, readIORef) import Data.Text (Text) import Data.Text qualified as T@@ -70,7 +70,7 @@ -- Run helpers — router over the stub, mirroring production install order -- --------------------------------------------------------------------------- --- | Run a program sequentially under @routeLLM . runRouting _Model@ over the+-- | Run a program sequentially under @routeLLM . runRouting emptyModel@ over the -- decision-rule stub; returns the result and the completion count. runCounted :: (Context -> Options -> Text) ->@@ -82,7 +82,7 @@ res <- runEff . runErrorNoCallStack @ShikumiError- . runRouting _Model+ . runRouting emptyModel . runStub ref decide . routeLLM $ runProgram prog input@@ -100,7 +100,7 @@ runEff . runErrorNoCallStack @ShikumiError . runConcurrent- . runRouting _Model+ . runRouting emptyModel . runStub ref decide . routeLLM $ runProgramConc prog input@@ -116,7 +116,7 @@ res <- runEff . runErrorNoCallStack @ShikumiError- . runRouting _Model+ . runRouting emptyModel . runThrowingLLM ref . routeLLM $ runProgram prog input@@ -134,7 +134,7 @@ res <- runEff . runErrorNoCallStack @ShikumiError- . runRouting _Model+ . runRouting emptyModel . runRecordingStub cap decide . routeLLM $ runProgram prog input
test/RoutingSpec.hs view
@@ -13,6 +13,7 @@ ( AssistantContent (..), AssistantMessageEvent (..), Context,+ JsonSchemaFormat (strict), Message (..), Model, Options,@@ -20,7 +21,8 @@ StopReason (..), TextContent (..), doneTerminal,- _Model,+ emptyModel,+ jsonSchemaFormat, ) import Baikai.Models.Generated (openai_gpt_4o_mini) import Control.Lens ((^.))@@ -162,7 +164,7 @@ case captured of [(_, _, o)] -> do o ^. #responseFormat- @?= Just (JsonSchema {name = "output", schema = deriveSchema @Outline, strict = True})+ @?= Just (JsonSchema ((jsonSchemaFormat "output" (deriveSchema @Outline)) {strict = True})) assertBool "private schema key stripped before transport" (Map.notMember metaResponseSchemaKey (o ^. #metadata))@@ -171,7 +173,7 @@ fallbackLeavesSchemaUnset :: TestTree fallbackLeavesSchemaUnset = testCase "fallback model leaves responseFormat unset" $ do- captured <- captureRouted _Model (predict topicToOutline) (Topic "cats")+ captured <- captureRouted emptyModel (predict topicToOutline) (Topic "cats") case captured of [(_, _, o)] -> do o ^. #responseFormat @?= Nothing@@ -228,7 +230,7 @@ fallbackPromptUnchangedAndStampsStripped :: TestTree fallbackPromptUnchangedAndStampsStripped = testCase "fallback model keeps the marker prompt and native stamps are stripped" $ do- captured <- captureRouted _Model (predict topicToOutline) (Topic "cats")+ captured <- captureRouted emptyModel (predict topicToOutline) (Topic "cats") case captured of [(_, ctx, o)] -> do let sys = maybe "" id (ctx ^. #systemPrompt)@@ -265,7 +267,7 @@ [(m, _, o)] -> do m ^. #modelId @?= openai_gpt_4o_mini ^. #modelId o ^. #responseFormat- @?= Just (JsonSchema {name = "output", schema = deriveSchema @Outline, strict = True})+ @?= Just (JsonSchema ((jsonSchemaFormat "output" (deriveSchema @Outline)) {strict = True})) assertBool "private schema key stripped before transport" (Map.notMember metaResponseSchemaKey (o ^. #metadata))
test/StreamSpec.hs view
@@ -20,11 +20,11 @@ StopReason (..), TerminalPayload (..), doneTerminal,- _Context,- _Model,- _Options,- _Response,- _TextContent,+ emptyContext,+ emptyModel,+ emptyOptions,+ emptyResponse,+ emptyTextContent, ) import Control.Lens ((&), (.~), (^.)) import Data.Generics.Labels ()@@ -102,13 +102,13 @@ -- | A response carrying @t@ as its single assistant text block. mkResponse :: Text -> Response mkResponse t =- _Response & #message . #content .~ V.singleton (AssistantText (_TextContent & #text .~ t))+ emptyResponse & #message . #content .~ V.singleton (AssistantText (emptyTextContent & #text .~ t)) -- | The 'Response' assembled from a stream's terminal event. terminalResponse :: [AssistantMessageEvent] -> Response terminalResponse evs = case [p | EventDone TerminalPayload {message = AssistantMessage p} <- evs] of- (p : _) -> _Response & #message .~ p+ (p : _) -> emptyResponse & #message .~ p [] -> mkResponse "" -- | A valid event sequence: @deltas@ stream as text chunks, and the terminal event@@ -117,7 +117,7 @@ -- the value streaming incrementally, the terminal carries the whole structured reply. streamEventsFor :: [Text] -> Text -> [AssistantMessageEvent] streamEventsFor deltas terminalText =- [ EventStart (StartPayload (AssistantMessage (_Response ^. #message)) Nothing),+ [ EventStart (StartPayload (AssistantMessage (emptyResponse ^. #message)) Nothing), TextStart (IndexPayload 0) ] ++ [TextDelta (DeltaPayload 0 d) | d <- deltas]@@ -125,7 +125,7 @@ EventDone (doneTerminal Nothing Nothing Stop (AssistantMessage (payloadWith terminalText))) ] where- payloadWith t = (_Response ^. #message) & #content .~ V.singleton (AssistantText (_TextContent & #text .~ t))+ payloadWith t = (emptyResponse ^. #message) & #content .~ V.singleton (AssistantText (emptyTextContent & #text .~ t)) -- | A recording callback: append each event to the IORef in order. recorder :: (IOE :> es) => IORef [StreamEvent] -> StreamEvent -> Eff es ()@@ -144,7 +144,7 @@ rec <- newIORef [] resp <- runEff . runStreamingLLM ref $- streamComplete "answer" _Model _Context _Options (recorder rec)+ streamComplete "answer" emptyModel emptyContext emptyOptions (recorder rec) evs <- readIORef rec evs @?= [ StreamFieldChunk (FieldChunk "answer" "Hel" False),
test/StubProvider.hs view
@@ -64,7 +64,7 @@ -- | A hand-built 'Model' whose 'api' routes to the stub provider. stubModel :: Model stubModel =- _Model+ emptyModel & #api .~ stubApi & #modelId@@ -76,23 +76,23 @@ -- | A minimal request context (one user turn). stubContext :: Context-stubContext = _Context & #messages .~ V.singleton (user "ping")+stubContext = emptyContext & #messages .~ V.singleton (user "ping") -- | Default request options. stubOptions :: Options-stubOptions = _Options+stubOptions = emptyOptions -- | An assistant payload carrying the given text as its single text block. stubPayloadWith :: Text -> AssistantPayload stubPayloadWith t =- (_Response ^. #message)+ (emptyResponse ^. #message) & #content- .~ V.singleton (AssistantText (_TextContent & #text .~ t))+ .~ V.singleton (AssistantText (emptyTextContent & #text .~ t)) -- | A fixed assistant response carrying the given text as its single text block. stubResponse :: Text -> Response stubResponse t =- _Response+ emptyResponse & #message .~ stubPayloadWith t & #model@@ -105,7 +105,7 @@ -- | A deterministic, valid event sequence for the given text. stubEvents :: Text -> [AssistantMessageEvent] stubEvents t =- [ EventStart StartPayload {partial = AssistantMessage (_Response ^. #message), responseId = Nothing},+ [ EventStart StartPayload {partial = AssistantMessage (emptyResponse ^. #message), responseId = Nothing}, TextStart IndexPayload {contentIndex = 0}, TextDelta DeltaPayload {contentIndex = 0, delta = t}, TextEnd BlockEndPayload {contentIndex = 0, content = t},@@ -119,11 +119,12 @@ reg <- newProviderRegistry registerApiProviderWith reg- ApiProvider- { apiTag = stubApi,- complete = completeFn,- stream = \_ _ _ -> Stream.fromList (stubEvents streamText),- describeThinking = stubDescribeThinking+ ( apiProviderWith+ stubApi+ (\_ _ _ -> Stream.fromList (stubEvents streamText))+ completeFn+ )+ { describeThinking = stubDescribeThinking } pure reg @@ -167,12 +168,12 @@ -- interpreters map this to a transient 'Shikumi.Error.ProviderFailure'. streamErrorEvents :: Rational -> Text -> [AssistantMessageEvent] streamErrorEvents cost msg =- [ EventStart StartPayload {partial = AssistantMessage (_Response ^. #message), responseId = Nothing},+ [ EventStart StartPayload {partial = AssistantMessage (emptyResponse ^. #message), responseId = Nothing}, EventError (doneTerminal Nothing Nothing ErrorReason (AssistantMessage errPayload)) ] where errPayload =- (_Response ^. #message)+ (emptyResponse ^. #message) & #errorMessage .~ Just msg & #usage@@ -189,17 +190,19 @@ reg <- newProviderRegistry registerApiProviderWith reg- ApiProvider- { apiTag = stubApi,- complete = \_ _ _ -> pure (stubResponse t),- stream = \_ _ _ -> Stream.concatEffect $ do- n <- atomicModifyIORef' ref (\k -> (k + 1, k + 1))- pure $- Stream.fromList $- if n <= failTimes- then streamErrorEvents 0 ("stub stream failure #" <> T.pack (show n))- else stubEvents t,- describeThinking = stubDescribeThinking+ ( apiProviderWith+ stubApi+ ( \_ _ _ -> Stream.concatEffect $ do+ n <- atomicModifyIORef' ref (\k -> (k + 1, k + 1))+ pure $+ Stream.fromList $+ if n <= failTimes+ then streamErrorEvents 0 ("stub stream failure #" <> T.pack (show n))+ else stubEvents t+ )+ (\_ _ _ -> pure (stubResponse t))+ )+ { describeThinking = stubDescribeThinking } pure reg @@ -211,11 +214,12 @@ reg <- newProviderRegistry registerApiProviderWith reg- ApiProvider- { apiTag = stubApi,- complete = \_ _ _ -> pure (stubResponse ""),- stream = \_ _ _ -> Stream.fromList (streamErrorEvents cost "stub stream failure"),- describeThinking = stubDescribeThinking+ ( apiProviderWith+ stubApi+ (\_ _ _ -> Stream.fromList (streamErrorEvents cost "stub stream failure"))+ (\_ _ _ -> pure (stubResponse ""))+ )+ { describeThinking = stubDescribeThinking } pure reg
test/TwoStepSpec.hs view
@@ -8,8 +8,8 @@ import Baikai ( AssistantContent (..), Response,- _Response,- _TextContent,+ emptyResponse,+ emptyTextContent, ) import Control.Lens ((&), (.~)) import Data.Generics.Labels ()@@ -38,7 +38,7 @@ -- | Build a response whose single assistant text block carries the given body. mkResponse :: Text -> Response mkResponse t =- _Response & #message . #content .~ V.singleton (AssistantText (_TextContent & #text .~ t))+ emptyResponse & #message . #content .~ V.singleton (AssistantText (emptyTextContent & #text .~ t)) -- | The first scripted call's reply: free-form prose (no structure requested). freeFormResponse :: Response
test/XmlAdapterSpec.hs view
@@ -7,8 +7,8 @@ import Baikai ( AssistantContent (..), Response,- _Response,- _TextContent,+ emptyResponse,+ emptyTextContent, ) import Control.Lens ((&), (.~), (^.)) import Data.Generics.Labels ()@@ -30,7 +30,7 @@ -- | Build a response whose single assistant text block carries the given body. mkResponse :: Text -> Response mkResponse t =- _Response & #message . #content .~ V.singleton (AssistantText (_TextContent & #text .~ t))+ emptyResponse & #message . #content .~ V.singleton (AssistantText (emptyTextContent & #text .~ t)) -- | A hand-written XML reply wrapping each 'Summary' field in tags. xmlBody :: Text