shikumi 0.2.0.0 → 0.3.0.0
raw patch · 29 files changed
+1088/−243 lines, 29 filesdep ~baikaidep ~baikai-claudedep ~baikai-effectfulPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: baikai, baikai-claude, baikai-effectful, baikai-openai, shikumi
API changes (from Hackage documentation)
- Shikumi.LLM.Budget: tryReserve :: Budget -> IO Bool
- Shikumi.Schema: instance Shikumi.Schema.Validatable a
+ Shikumi.Adapter: assistantJSON :: Response -> Either ShikumiError Value
+ Shikumi.Adapter: attachNativeRender :: Text -> [Text] -> Options -> Options
+ Shikumi.Adapter: metaNativeDemosKey :: Text
+ Shikumi.Adapter: metaNativePromptKey :: Text
+ Shikumi.Adapter: nativeRenderPieces :: forall i o. (ToSchema o, ToPrompt o) => Signature i o -> (Text, [Text])
+ Shikumi.Adapter: renderOutputNative :: (ToSchema o, ToPrompt o) => o -> Text
+ Shikumi.Error: CodeExecFailed :: !Text -> ShikumiError
+ Shikumi.LLM.Budget: admitCall :: Budget -> IO Bool
+ Shikumi.Module: instance Shikumi.Schema.Validatable o => Shikumi.Schema.Validatable (Shikumi.Module.WithReasoning o)
+ Shikumi.Program: effectiveSignature :: forall i o (es :: [Effect]). (FromModel i, FromModel o, Error ShikumiError :> es) => Signature i o -> Params -> Eff es (Signature i o)
+ Shikumi.Program: parseResponse :: forall i o. (FromModel o, ToSchema o, Validatable o, ToPrompt i, ToPrompt o) => Signature i o -> Response -> Either ShikumiError o
- Shikumi.Combinator: chain :: [Program a a] -> Program a a
+ Shikumi.Combinator: chain :: NonEmpty (Program a a) -> Program a a
- Shikumi.Module: chainOfThought :: (FromModel i, FromModel o, ToSchema o, ToPrompt i, ToPrompt o) => Signature i o -> Program i o
+ Shikumi.Module: chainOfThought :: (FromModel i, FromModel o, ToSchema o, Validatable o, ToPrompt i, ToPrompt o) => Signature i o -> Program i o
- Shikumi.Module: chainOfThoughtRaw :: (FromModel i, FromModel o, ToSchema o, ToPrompt i, ToPrompt o) => Signature i o -> Program i (WithReasoning o)
+ Shikumi.Module: chainOfThoughtRaw :: (FromModel i, FromModel o, ToSchema o, Validatable o, ToPrompt i, ToPrompt o) => Signature i o -> Program i (WithReasoning o)
- Shikumi.Program: [MajorityVote] :: forall o i. Eq o => Int -> TempSchedule -> Program i o -> Program i o
+ Shikumi.Program: [MajorityVote] :: forall o i. Int -> TempSchedule -> (NonEmpty o -> o) -> Program i o -> Program i o
- Shikumi.Program: modal :: Eq o => [o] -> o
+ Shikumi.Program: modal :: Eq o => NonEmpty o -> o
- Shikumi.Program: sampleTemps :: Int -> TempSchedule -> [Maybe Double]
+ Shikumi.Program: sampleTemps :: Int -> TempSchedule -> NonEmpty (Maybe Double)
Files
- CHANGELOG.md +62/−0
- shikumi.cabal +10/−10
- src/Shikumi/Adapter.hs +94/−8
- src/Shikumi/Combinator.hs +18/−12
- src/Shikumi/Compaction.hs +3/−1
- src/Shikumi/Error.hs +6/−3
- src/Shikumi/LLM.hs +80/−14
- src/Shikumi/LLM/Budget.hs +24/−13
- src/Shikumi/Module.hs +18/−4
- src/Shikumi/Program.hs +86/−42
- src/Shikumi/Refine.hs +15/−4
- src/Shikumi/Routing.hs +95/−31
- src/Shikumi/Schema.hs +44/−21
- src/Shikumi/Schema/Types.hs +4/−2
- src/Shikumi/Stream.hs +34/−32
- test/CombinatorSpec.hs +10/−5
- test/ConstraintSpec.hs +20/−1
- test/ErrorSpec.hs +1/−0
- test/LiveSpec.hs +1/−1
- test/ModuleSpec.hs +16/−1
- test/ProgramFixtures.hs +27/−1
- test/ProgramSpec.hs +37/−2
- test/RefineSpec.hs +12/−0
- test/RefineStub.hs +12/−1
- test/ResilienceSpec.hs +71/−4
- test/RoutingSpec.hs +171/−19
- test/SchemaSpec.hs +8/−2
- test/StreamSpec.hs +30/−4
- test/StubProvider.hs +79/−5
CHANGELOG.md view
@@ -2,6 +2,68 @@ ## Unreleased +## 0.3.0.0 - 2026-07-05++### Changed++- **BREAKING** Combinator and budget semantics cleanup. `MajorityVote` now carries+ its reducer, so `majorityVoteBy` applies its `TempSchedule` per sample (routed+ temperatures reach the wire) and exposes the sub-program's `Params` once instead+ of K times — parameter vectors saved from an old `majorityVoteBy` program no+ longer load and must be re-saved. `chain` takes a `NonEmpty` (empty is a compile+ error, not a runtime crash); `modal` and `sampleTemps` take/return `NonEmpty`.+ `TempSpread` temperatures are clamped to `[0, 2]` (`TempFixed` values pass through+ unclamped). A malformed numeric bound in a `Constrained` field+ (e.g. `MinVal "abc"`) no longer crashes at schema-derivation time — the schema+ keyword is omitted and every decode of the field fails with a located+ `ValidationFailure` naming the bad symbol. `Shikumi.LLM.Budget.tryReserve` is+ renamed `admitCall` with documented optimistic-admission semantics (concurrent+ calls can overshoot the ceiling; no reservation is held). `refine` survives a+ failed advice-generation call, returning its best-so-far output instead of+ aborting.++- **BREAKING** `Validatable` is now opt-in and enforced by the decode path in+ every program runner. The catch-all `instance {-# OVERLAPPABLE #-} Validatable a`+ has been removed, so a type's `Validatable` rule is no longer silently skipped+ when a program runs through `runProgram`, `runProgramConc`, `streamProgram`, or+ `chainOfThought` — a violated rule now surfaces as `Left (ValidationFailure …)`.+ Migration: declare an instance for every `Predict` output type and every typed+ tool input. A type with no rules needs one line — `instance Validatable Foo`+ (the default `validate = Right` applies) or add `Validatable` to a+ `deriving anyclass (…)` list. `runPredict`, `streamPredict`, `chainOfThought`,+ and `chainOfThoughtRaw` gained a `Validatable o` constraint, and+ `WithReasoning o` now has a delegating `Validatable` instance that runs the+ wrapped value's rule.++- **BREAKING** Derived JSON Schemas now satisfy OpenAI strict mode. A `Maybe`+ field is emitted as required-but-nullable (listed in `required` with a nullable+ schema) instead of being omitted from `required`, and `enumSchema` carries an+ explicit `"type": "string"`. This changes the shape real OpenAI/Anthropic+ requests send; the decode path is unchanged and still tolerates a missing key or+ explicit `null` for `Maybe` fields.++- Native structured-output requests are now coherent. When a program routes to a+ native-capable model, the request carries a system prompt describing the JSON+ object to produce and demos rendered as JSON — not `[[ ## field ## ]]` marker+ sections — via a new native render channel (`attachNativeRender` /+ `nativeRenderPieces`, swapped in by `routeLLM`/`translateForWire`). Fallback+ models are unchanged. `parseResponse` now keeps the precise native decode error+ for JSON reply bodies instead of masking it behind a misleading `MissingField`+ from the marker parser. `Shikumi.Routing.translateForWire` widened to+ `Model -> Context -> Options -> (Context, Options)`.++- `streamProgram` now works against real providers. `routeLLM` rewrites the+ `Stream` operation exactly as it rewrites `Complete` (ambient model, translated+ and stripped metadata, native `Context` swap), so a routed streaming call sends+ the real model id and wire options instead of the inert placeholder. `streamPredict`+ reuses the blocking path's `effectiveSignature`, schema/native stamps, and the+ dual-format `parseResponse` (both newly exported from `Shikumi.Program`), so a+ native (JSON) stream decodes correctly. Stream failures now surface out-of-band:+ a terminal `EventError` becomes a transient `ProviderFailure` thrown through+ `Error ShikumiError` (so retry policies fire), and the budget is charged from the+ terminal payload — success or error — before the throw. The event list returned+ by `Shikumi.LLM.stream` never terminates in `EventError`.+ ## 0.2.0.0 - 2026-06-28 ### Added
shikumi.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.4 name: shikumi-version: 0.2.0.0+version: 0.3.0.0 synopsis: Typed, structured, evaluable LM programs over baikai category: AI description:@@ -53,10 +53,10 @@ build-depends: , aeson- , baikai >=0.2 && <0.3- , baikai-claude >=0.2 && <0.3- , baikai-effectful >=0.2 && <0.3- , baikai-openai >=0.2 && <0.3+ , baikai >=0.3 && <0.4+ , baikai-claude >=0.3 && <0.4+ , baikai-effectful >=0.3 && <0.4+ , baikai-openai >=0.3 && <0.4 , base >=4.20 && <5 , base64-bytestring , bytestring@@ -109,10 +109,10 @@ build-depends: , aeson- , baikai >=0.2 && <0.3- , baikai-claude >=0.2 && <0.3- , baikai-effectful >=0.2 && <0.3- , baikai-openai >=0.2 && <0.3+ , baikai >=0.3 && <0.4+ , baikai-claude >=0.3 && <0.4+ , baikai-effectful >=0.3 && <0.4+ , baikai-openai >=0.3 && <0.4 , base , base64-bytestring , bytestring@@ -122,7 +122,7 @@ , generic-lens , lens , QuickCheck- , shikumi ^>=0.2.0.0+ , shikumi ^>=0.3.0.0 , stm , streamly-core , tasty
src/Shikumi/Adapter.hs view
@@ -23,6 +23,16 @@ -- the router ("Shikumi.Routing".@routeLLM@) translates those into -- @responseFormat@\/@temperature@ against the real model and strips the keys before -- transport.+--+-- The same channel also carries the /native render alternative/ (EP-33). Because+-- the runtime always renders the model-agnostic marker prompt, 'attachNativeRender'+-- additionally stamps the native-format system prompt under 'metaNativePromptKey'+-- and the native (JSON) demo assistant turns under 'metaNativeDemosKey'+-- ('nativeRenderPieces' produces both). For a native-capable model the router swaps+-- these into the @Context@ (so the model is told to reply as JSON and shown JSON+-- demos, not @[[ ## … ## ]]@ markers); for fallback models the marker prompt stands+-- and the keys are stripped. 'renderOutputNative' is the shared demo renderer, also+-- used by 'nativeAdapter' when a caller drives it directly. module Shikumi.Adapter ( -- * Input rendering ToPrompt (..),@@ -37,11 +47,17 @@ adapterFor, attachSchema, responseText,+ assistantJSON, -- * The private request-metadata channel (consumed by "Shikumi.Routing") stampTemperature, metaResponseSchemaKey, metaTemperatureKey,+ metaNativePromptKey,+ metaNativeDemosKey,+ attachNativeRender,+ nativeRenderPieces,+ renderOutputNative, ) where @@ -63,15 +79,17 @@ ) import Control.Lens (at, (&), (.~), (?~), (^.)) import Data.Aeson (Object, Value (..), eitherDecodeStrict, toJSON)+import Data.Aeson qualified as Aeson import Data.Aeson.Key qualified as Key import Data.Aeson.KeyMap qualified as KM+import Data.ByteString.Lazy qualified as LBS import Data.Generics.Labels () import Data.Kind (Type) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Text (Text) import Data.Text qualified as T-import Data.Text.Encoding (encodeUtf8)+import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Vector qualified as V import GHC.Generics import Shikumi.Error (ShikumiError (..))@@ -197,6 +215,21 @@ metaTemperatureKey :: Text metaTemperatureKey = "shikumi.temperature" +-- | Reserved 'Options.metadata' key carrying the full native-format system prompt+-- (instruction + native output guide) as a JSON string. Stamped by+-- 'Shikumi.Program.runPredict'; "Shikumi.Routing".@routeLLM@ swaps it into the+-- 'Context' for native-capable models and strips it before transport. Because+-- @runPredict@ renders model-agnostically (the marker prompt), this carries the+-- native alternative so the router can install it once the real model is known.+metaNativePromptKey :: Text+metaNativePromptKey = "shikumi.native.systemPrompt"++-- | Reserved 'Options.metadata' key carrying the native-format demo assistant+-- turns, in order, as a JSON array of strings. Same lifecycle as+-- 'metaNativePromptKey'.+metaNativeDemosKey :: Text+metaNativeDemosKey = "shikumi.native.demos"+ -- | Stamp the derived JSON schema onto a request's private metadata channel. This -- is no longer a no-op: it records the schema under 'metaResponseSchemaKey' so the -- router can attach a real @responseFormat@ once the ambient model is known. (The@@ -206,6 +239,28 @@ attachSchema schema opts = opts & #metadata . at metaResponseSchemaKey ?~ schema +-- | Stamp the native-format system prompt and demo assistant turns onto a+-- request's private metadata channel, under 'metaNativePromptKey' and+-- 'metaNativeDemosKey'. Mirrors 'attachSchema': the router swaps these into the+-- 'Context' for native-capable models and strips the keys before transport.+attachNativeRender :: Text -> [Text] -> Options -> Options+attachNativeRender sys demos opts =+ opts+ & #metadata . at metaNativePromptKey ?~ toJSON sys+ & #metadata . at metaNativeDemosKey ?~ toJSON demos++-- | The native-format render pieces for a signature: the system prompt a+-- native-capable model should see (instruction + native output guide, /not/ the+-- marker guide) and the demo assistant turns rendered as JSON objects, in order.+-- 'Shikumi.Program.runPredict' stamps these via 'attachNativeRender' so the router+-- can install them once the real model is known.+nativeRenderPieces ::+ forall i o. (ToSchema o, ToPrompt o) => Signature i o -> (Text, [Text])+nativeRenderPieces sig =+ ( systemHeader sig <> nativeOutputGuide sig,+ [renderOutputNative @o o | Demo _ o <- getDemos sig]+ )+ -- | Stamp a per-sample temperature onto a request's private metadata channel under -- 'metaTemperatureKey'. Used by 'Shikumi.Program.runProgram' to thread a -- 'Shikumi.Program.MajorityVote' sample's temperature down to its 'Predict' nodes;@@ -225,7 +280,7 @@ Adapter { render = \sig i -> let sys = systemHeader sig <> nativeOutputGuide sig- ctx = buildContext sys (demoMessages sig ++ [userTurn i])+ ctx = buildContext sys (nativeDemoMessages sig ++ [userTurn i]) opts = attachSchema (deriveSchema @o) _Options in (ctx, opts), parse = \_sig resp -> assistantJSON resp >>= fromModelChecked@@ -252,11 +307,19 @@ -- | The XML adapter (EP-26). A third wire format on the same typed seam: @render@ -- asks the model to wrap each output field in @\<field\>…\</field\>@ tags, and -- @parse@ reads those tags back. Some models follow an XML shape more reliably than--- JSON or the @[[ ## … ## ]]@ markers. Opt-in — a caller selects it explicitly;--- 'adapterFor' does not auto-select it (XML is a caller choice, not a detectable--- model capability). Reuses the same 'sectionsToObject' + 'fromModelChecked'--- decode path as 'fallbackAdapter', so nested records and lists in tags coerce the--- same way.+-- JSON or the @[[ ## … ## ]]@ markers. Reuses the same 'sectionsToObject' ++-- 'fromModelChecked' decode path as 'fallbackAdapter', so nested records and lists+-- in tags coerce the same way.+--+-- Reachability: 'xmlAdapter' is /not/ selectable by the runtime router. The router+-- ("Shikumi.Routing".@routeLLM@) picks between the native and fallback wire shapes+-- from the model's detected 'ModelCapability' (native vs. prompt-fallback); XML is a+-- caller choice, not a detectable capability, so 'adapterFor' never returns it. To+-- use it, hold the 'Adapter' value directly and render/parse with it inside an+-- 'Shikumi.Program.embed' node — the same way 'Shikumi.Module.twoStep' drives+-- 'fallbackAdapter' by hand. A per-node adapter selector through the 'Program' GADT+-- was considered and deferred (see the parent MasterPlan's scope), as it is+-- disproportionate to the need. xmlAdapter :: forall i o. (ToSchema o, FromModel o, Validatable o, ToPrompt i, ToPrompt o) =>@@ -333,6 +396,26 @@ where one (Demo i o) = [user (toPrompt i), assistant (renderOutputSections o)] +-- | Render a demo output as the JSON object a native model is asked to reply+-- with. Reuses 'sectionsToObject' so each field's text coerces against the+-- derived schema exactly as the fallback parse path coerces marker sections —+-- one source of truth for the text-to-typed-JSON coercion (there is no @o ->+-- Value@ inverse to render directly, as 'FromModel' has no dual).+renderOutputNative :: forall o. (ToSchema o, ToPrompt o) => o -> Text+renderOutputNative o =+ decodeUtf8 (LBS.toStrict (Aeson.encode obj))+ where+ obj = sectionsToObject (deriveSchema @o) (Map.fromList (toPromptFields o))++-- | Demo turns for the native path: user prompt as usual, assistant turn as the+-- JSON object (not marker sections), so a native model sees examples in the same+-- shape as the reply it is asked to produce.+nativeDemoMessages ::+ forall i o. (ToSchema o, ToPrompt i, ToPrompt o) => Signature i o -> [Message]+nativeDemoMessages sig = concatMap one (getDemos sig)+ where+ one (Demo i o) = [user (toPrompt i), assistant (renderOutputNative @o o)]+ -- | Render a demo output as @[[ ## field ## ]]@ sections (shared by both adapters -- for demo presentation). renderOutputSections :: (ToPrompt o) => o -> Text@@ -376,7 +459,10 @@ responseText resp = T.concat [t | AssistantText (TextContent t) <- V.toList (flattenAssistantBlocks resp)] --- | Read the assistant text and parse it as a JSON value (native path).+-- | Read the assistant text and parse it as a JSON value (native path). Exported+-- for 'Shikumi.Program.parseResponse', which uses it to detect the wire shape: a+-- body that parses as JSON is the native shape and is decoded by the native+-- parser (keeping its located error), while a non-JSON body is the marker shape. assistantJSON :: Response -> Either ShikumiError Value assistantJSON resp = case eitherDecodeStrict (encodeUtf8 (responseText resp)) of
src/Shikumi/Combinator.hs view
@@ -56,11 +56,14 @@ ) where +import Data.List.NonEmpty (NonEmpty)+import Data.List.NonEmpty qualified as NE import Data.Text (Text) import Shikumi.Error (ShikumiError) import Shikumi.Program ( Program (Compose, Ensemble, MajorityVote, Map, Parallel, Retry, RetryWhen, Validate), TempSchedule (..),+ modal, ) -- ---------------------------------------------------------------------------@@ -80,11 +83,11 @@ -- @pipeline@\/@Compose@; this n-ary helper is restricted to a single carried type -- because the GADT has no identity node to seed an empty fold.) ----- Applying it to the empty list is a programmer error (there is no identity--- 'Program').-chain :: [Program a a] -> Program a a-chain [] = error "Shikumi.Combinator.chain: empty stage list"-chain ps = foldr1 (>>>) ps+-- The argument is a 'NonEmpty' — there is no identity 'Program' to seed an empty+-- fold, so emptiness is unrepresentable rather than a runtime crash. Write+-- @chain (a ':|' [b, c])@ (or @chain (NE.fromList [a, b, c])@).+chain :: NonEmpty (Program a a) -> Program a a+chain ps = foldr1 (>>>) (NE.toList ps) -- --------------------------------------------------------------------------- -- Map@@ -148,16 +151,19 @@ -- --------------------------------------------------------------------------- -- | Sample a program @K@ times and return the modal output (most frequent under--- 'Eq', ties broken by first appearance). The 'TempSchedule' is carried and--- serialized but not yet applied to the wire — see 'TempSchedule'.+-- 'Eq', ties broken by first appearance). The 'TempSchedule' is live: each+-- sample's temperature is stamped onto its request and realized on the wire by the+-- router (see 'TempSchedule'). majorityVote :: (Eq o) => Int -> TempSchedule -> Program i o -> Program i o-majorityVote = MajorityVote+majorityVote k sched = MajorityVote k sched modal --- | Sample a program @K@ times and fold the @K@ outputs with a custom reducer,--- for outputs that are not usefully 'Eq'. Defined as an 'ensemble' over @K@--- copies of the program.+-- | Sample a program @K@ times and fold the @K@ (non-empty) outputs with a custom+-- reducer, for outputs that are not usefully 'Eq'. Like 'majorityVote' it applies+-- the 'TempSchedule' per sample and exposes the sub-program's 'Params' once (not+-- @K@ times) — the samples are runs of a single node, not @K@ distinct 'ensemble'+-- members. majorityVoteBy :: Int -> TempSchedule -> ([o] -> o) -> Program i o -> Program i o-majorityVoteBy k _sched reducer p = Ensemble (replicate (max 1 k) p) reducer+majorityVoteBy k sched reducer = MajorityVote k sched (reducer . NE.toList) -- --------------------------------------------------------------------------- -- Ensemble
src/Shikumi/Compaction.hs view
@@ -62,7 +62,8 @@ enabled cfg && (model ^. #contextWindow) > 0 && (usage ^. #inputTokens) >= overflowThreshold cfg model -- | Fold the older portion of an oldest-first list into one synthesized summary--- item, preserving the most recent 'keepRecent' items verbatim.+-- item, preserving the most recent 'keepRecent' items verbatim. A disabled+-- config is the identity and does not call the model. compactTail :: (LLM :> es, Error ShikumiError :> es) => CompactionConfig ->@@ -72,6 +73,7 @@ [a] -> Eff es [a] compactTail cfg model render inject xs+ | not (enabled cfg) = pure xs | olderCount <= 0 = pure xs | otherwise = do requireErrorRow Nothing
src/Shikumi/Error.hs view
@@ -36,6 +36,8 @@ Timeout !Text | -- | the running cost ceiling was reached; the call was refused BudgetExceeded !Text+ | -- | generated code failed after exhausting correction attempts+ CodeExecFailed !Text deriving stock (Eq, Show) -- | Total mapping from baikai's transport-level errors into shikumi's@@ -56,9 +58,10 @@ _ -> ProviderFailure (message e) -- | Which errors are worth retrying. Provider/transport failures and timeouts are--- transient; decode, schema, validation, and budget errors are deterministic and--- retrying cannot fix them. Centralizing the policy here keeps it auditable--- (the resilience interpreter in "Shikumi.LLM" consults exactly this predicate).+-- transient; decode, schema, validation, budget, and code-execution failures are+-- deterministic and retrying cannot fix them. Centralizing the policy here keeps+-- it auditable (the resilience interpreter in "Shikumi.LLM" consults exactly this+-- predicate). isTransient :: ShikumiError -> Bool isTransient = \case ProviderFailure {} -> True
src/Shikumi/LLM.hs view
@@ -53,6 +53,7 @@ Options, Response, TerminalPayload,+ responseError, ) import Baikai.Effectful (Baikai, runBaikai, runBaikaiWith) import Baikai.Effectful qualified as BE@@ -68,7 +69,8 @@ ) import Control.Lens ((^.)) import Data.Generics.Labels ()-import Data.Maybe (mapMaybe)+import Data.Maybe (fromMaybe, mapMaybe)+import Data.Text qualified as T import Effectful (Dispatch (Dynamic), DispatchOf, Eff, Effect, IOE, liftIO, (:>)) import Effectful.Concurrent (Concurrent, threadDelay) import Effectful.Concurrent.STM (atomically)@@ -76,11 +78,18 @@ import Effectful.Error.Static (Error, catchError, throwError) import Effectful.Exception (bracket_, try) import Shikumi.Error (ShikumiError (..), fromBaikaiError, isTransient)-import Shikumi.LLM.Budget (Budget, recordCost, tryReserve)+import Shikumi.LLM.Budget (Budget, admitCall, recordCost) -- | The provider-neutral LM effect. 'Complete' is a blocking completion; -- 'Stream' returns the assembled list of typed events so callers that need -- deltas can fold them.+--+-- Stream-error contract (all shikumi interpreters): the returned event list+-- never terminates with an @EventError@. A provider failure — which the+-- policy-free @Baikai@ transport surfaces in-band as a terminal @EventError@ — is+-- converted to an out-of-band 'ShikumiError' thrown through @Error ShikumiError@,+-- so 'stream' failures are transient-retryable and reported exactly like+-- 'complete' failures. data LLM :: Effect where Complete :: Model -> Context -> Options -> LLM m Response Stream :: Model -> Context -> Options -> LLM m [AssistantMessageEvent]@@ -119,9 +128,13 @@ -- | The bare handler, shared by both interpreters. It runs in the handler stack -- (@Baikai : es@), so it can call the @Baikai@ transport effect and throw--- through the @Error ShikumiError@ effect. The blocking path catches baikai's--- 'BaikaiError' (thrown by 'BE.complete') and remaps it; the streaming path--- surfaces failures in-band as a terminal @EventError@, so it does not catch.+-- through the @Error ShikumiError@ effect. The blocking path routes baikai's+-- in-band failure (an error-shaped 'Response') through 'raiseResponseError' — plus+-- a defensive 'try' for any residual thrown 'BaikaiError' — and remaps it; the+-- streaming path collects the events and, via 'raiseStreamError', converts a+-- terminal @EventError@ into the same out-of-band 'ShikumiError' — so callers of+-- 'stream' never receive an in-band error terminal and resilience/decoding treat+-- both operations identically. bareHandler :: (Baikai :> es, Error ShikumiError :> es) => LLM (Eff localEs) a ->@@ -129,8 +142,8 @@ bareHandler = \case Complete m c o -> do res <- try @BaikaiError (BE.complete m c o)- either (throwError . fromBaikaiError) pure res- Stream m c o -> BE.streamCollect m c o+ either (throwError . fromBaikaiError) raiseResponseError res+ Stream m c o -> BE.streamCollect m c o >>= raiseStreamError -- --------------------------------------------------------------------------- -- Resilience: retries, rate limiting, budget@@ -162,7 +175,9 @@ -- | Interpretation-time policy for 'runLLMResilient'. data LLMConfig = LLMConfig { retryPolicy :: !RetryPolicy,- -- | 'Nothing' = unlimited cost+ -- | 'Nothing' = unlimited cost. Enforcement is optimistic admission, not+ -- reservation: concurrent calls can overshoot the ceiling by up to the sum of+ -- their in-flight costs (see "Shikumi.LLM.Budget"). budget :: !(Maybe Budget), -- | 'Nothing' = unbounded concurrency rateLimit :: !(Maybe RateLimiter),@@ -197,20 +212,28 @@ case res of Left be -> throwError (fromBaikaiError be) Right resp -> do+ -- Charge before raising: an error-shaped 'Response' may still carry+ -- billable usage (mirrors 'chargeBudgetFromEvents' on the stream path). liftIO (chargeBudget mb resp)- pure resp+ raiseResponseError resp Stream m c o -> withBudget mb . withRateLimit mr . retrying rp $ do evs <- BE.streamCollect m c o+ -- Charge from the terminal payload (success /or/ error) before raising: a+ -- failed stream may still have consumed billable tokens. liftIO (chargeBudgetFromEvents mb evs)- pure evs+ raiseStreamError evs where mb = budget cfg mr = rateLimit cfg rp = retryPolicy cfg --- | Optimistic pre-call budget gate. Refuses the call with 'BudgetExceeded' when--- the running total has already reached the ceiling.+-- | Optimistic pre-call budget gate (admission, not reservation). Refuses the+-- call with 'BudgetExceeded' when the recorded running total has already reached+-- the ceiling. Because 'admitCall' holds nothing, @N@ calls admitted concurrently+-- can each pass the gate and overshoot the ceiling by up to the sum of their costs;+-- the first call after the total reaches the ceiling is refused. See+-- "Shikumi.LLM.Budget". withBudget :: (IOE :> es, Error ShikumiError :> es) => Maybe Budget ->@@ -218,7 +241,7 @@ Eff es a withBudget Nothing act = act withBudget (Just b) act = do- ok <- liftIO (tryReserve b)+ ok <- liftIO (admitCall b) if ok then act else throwError (BudgetExceeded "cost ceiling reached") -- | Bound concurrency to the limiter's permits, releasing on every exit path.@@ -269,8 +292,51 @@ responseCostUSD :: Response -> Rational responseCostUSD resp = resp ^. #message . #usage . #cost . #usd +-- | Enforce the stream-error posture: a terminal 'EventError' becomes an+-- out-of-band 'ShikumiError' — a 'ProviderFailure' carrying the terminal message's+-- @errorMessage@ (or the stop reason if none). A successful event list passes+-- through unchanged, so callers of 'stream' never see an in-band error terminal.+-- Because both interpreters call this /inside/ their retry loop, a transient stream+-- failure is retried exactly like a blocking one ('ProviderFailure' is transient+-- per 'isTransient').+--+-- The baikai version shikumi pins does not attach a structured 'BaikaiError' to a+-- terminal payload (its @TerminalPayload@ is @{reason, message}@; the failure detail+-- lives in the assembled message's @errorMessage@ and @stopReason@), so all stream+-- failures map to 'ProviderFailure' rather than through 'fromBaikaiError'.+raiseStreamError ::+ (Error ShikumiError :> es) => [AssistantMessageEvent] -> Eff es [AssistantMessageEvent]+raiseStreamError evs = case [tp | EventError tp <- evs] of+ (tp : _) -> throwError (streamTerminalError tp)+ [] -> pure evs++-- | Enforce the blocking-error posture, the 'complete' analogue of+-- 'raiseStreamError'. Since baikai 0.3, 'BE.complete' does not throw on+-- provider/registry/CLI failure: it returns an error-shaped 'Response' whose+-- 'responseError' is populated. Convert that in-band failure into the same+-- out-of-band 'ShikumiError' the rest of shikumi consumes, so an error response+-- never masquerades as success and 'runLLMResilient' still retries transient+-- failures (a 'ProviderFailure' thrown /inside/ the retry loop). A success+-- passes through unchanged.+raiseResponseError ::+ (Error ShikumiError :> es) => Response -> Eff es Response+raiseResponseError resp = case responseError resp of+ Just be -> throwError (fromBaikaiError be)+ Nothing -> pure resp++-- | Map a terminal 'EventError' payload to a 'ShikumiError'.+streamTerminalError :: TerminalPayload -> ShikumiError+streamTerminalError tp = ProviderFailure ("stream failed: " <> detail)+ where+ detail = case tp ^. #message of+ AssistantMessage p -> fromMaybe (T.pack (show (tp ^. #reason))) (p ^. #errorMessage)+ _ -> T.pack (show (tp ^. #reason))+ -- | Charge a completed streaming call's cost, read from the terminal event's--- assembled message.+-- assembled message. Note: an /error/ terminal ('EventError') is charged too — a+-- failed stream may still have consumed billable tokens, and the terminal+-- payload's assembled message carries the usage/cost baikai computed; not charging+-- would silently undercount real spend. chargeBudgetFromEvents :: Maybe Budget -> [AssistantMessageEvent] -> IO () chargeBudgetFromEvents Nothing _ = pure () chargeBudgetFromEvents (Just b) evs =
src/Shikumi/LLM/Budget.hs view
@@ -1,16 +1,24 @@ -- | A running US-dollar cost ceiling for LM calls. ----- The budget is enforced /before/ a call by an optimistic 'tryReserve' check and--- updated /after/ each successful call with 'recordCost', reading baikai's--- per-response @Usage.cost.usd@ (a 'Rational', always populated). The semantics--- are deliberately simple: the budget refuses the /next/ call once the running--- total has reached the ceiling. A single in-flight call is never clipped--- mid-stream (baikai exposes no streaming cost preview), but once it pushes the--- total to/over the cap, every subsequent call fails fast.+-- The budget is checked /before/ a call by an optimistic 'admitCall' /admission/+-- and updated /after/ each call with 'recordCost', reading baikai's per-response+-- @Usage.cost.usd@ (a 'Rational', always populated). Admission is /not/ a+-- reservation: nothing is held, because baikai exposes no pre-call cost estimate.+-- The honest contract is:+--+-- * a call is admitted while the recorded running total is /strictly under/ the+-- ceiling;+-- * @N@ calls admitted concurrently — all seeing a total under the ceiling before+-- any of them records its cost — are all admitted and all charged, so the total+-- can overshoot the ceiling by up to the sum of those in-flight calls' costs;+-- * once the recorded total reaches (or exceeds) the ceiling, every subsequent+-- admission is refused.+--+-- An unlimited budget (@ceilingUSD == Nothing@) always admits. module Shikumi.LLM.Budget ( Budget (..), newBudget,- tryReserve,+ admitCall, recordCost, spentUSD, )@@ -36,11 +44,14 @@ newBudget :: Maybe Rational -> IO Budget newBudget c = Budget c <$> newTVarIO 0 --- | Optimistic pre-call check: 'True' if a call is permitted (the running total--- has not yet reached the ceiling), 'False' once the ceiling is met/exceeded.--- An unlimited budget always permits.-tryReserve :: Budget -> IO Bool-tryReserve b = case ceilingUSD b of+-- | Optimistic pre-call admission (not a reservation — nothing is held): 'True'+-- if a call is permitted (the recorded running total is strictly under the+-- ceiling), 'False' once the ceiling is met/exceeded. Because it reserves nothing,+-- @N@ concurrent admissions can each see a sub-ceiling total and all succeed,+-- overshooting by up to the sum of their costs; the first admission after the+-- total reaches the ceiling is refused. An unlimited budget always admits.+admitCall :: Budget -> IO Bool+admitCall b = case ceilingUSD b of Nothing -> pure True Just cap -> atomically $ do s <- readTVar (spentRef b)
src/Shikumi/Module.hs view
@@ -44,7 +44,7 @@ import Shikumi.Error (ShikumiError (..)) import Shikumi.LLM (complete) import Shikumi.Program (Program (FMap, Predict), embed, emptyParams)-import Shikumi.Schema (FromModel (..), ToSchema (..), Validatable)+import Shikumi.Schema (FromModel (..), ToSchema (..), Validatable (..)) import Shikumi.Schema.Types ( FieldMeta (..), FieldPath,@@ -104,6 +104,11 @@ imageFields _ = [] imageFieldNames _ = [] +-- | Validation delegates to the wrapped value; the free-form @reasoning@ text+-- carries no user rules.+instance (Validatable o) => Validatable (WithReasoning o) where+ validate wr = (\v -> wr {value = v}) <$> validate (value wr)+ -- | Look up a required field in a JSON object, locating a miss precisely. getField :: (FromModel a) => FieldPath -> Text -> Object -> Either ShikumiError a getField path nm o = case KM.lookup (Key.fromText nm) o of@@ -111,16 +116,17 @@ Just v -> fromModelP (pushField nm path) v -- | Chain-of-thought that yields the bare @o@: build the reasoning-augmented node,--- then 'FMap' out the answer.+-- then 'FMap' out the answer. The user's @Validatable o@ rule fires on the+-- unwrapped answer via the delegating @Validatable (WithReasoning o)@ instance. chainOfThought ::- (FromModel i, FromModel o, ToSchema o, ToPrompt i, ToPrompt o) =>+ (FromModel i, FromModel o, ToSchema o, Validatable o, ToPrompt i, ToPrompt o) => Signature i o -> Program i o chainOfThought sig = FMap value (chainOfThoughtRaw sig) -- | Chain-of-thought that keeps the reasoning visible in the output. chainOfThoughtRaw ::- (FromModel i, FromModel o, ToSchema o, ToPrompt i, ToPrompt o) =>+ (FromModel i, FromModel o, ToSchema o, Validatable o, ToPrompt i, ToPrompt o) => Signature i o -> Program i (WithReasoning o) chainOfThoughtRaw sig = Predict (withReasoningField sig) emptyParams@@ -129,6 +135,14 @@ -- instruction to ask for step-by-step reasoning before the answer. The input -- field metadata is carried over from the source signature; the output metadata is -- the two fields of 'WithReasoning' (matching its hand-written schema).+--+-- Note: signature-level demos are /not/ carried onto the reasoning-augmented+-- node (@demos = []@), because a @Demo i o@ cannot be turned into a+-- @Demo i (WithReasoning o)@ without inventing reasoning text — and a fabricated+-- or empty reasoning string would teach the model to skip reasoning, defeating+-- the module's purpose. Demos supplied through the node's optimizer @Params@+-- channel are unaffected: they are stored as JSON and decoded against+-- @WithReasoning o@, so they already include a @reasoning@ field. withReasoningField :: Signature i o -> Signature i (WithReasoning o) withReasoningField sig = Signature
src/Shikumi/Program.hs view
@@ -64,6 +64,8 @@ modal, sampleTemps, withSampleTemp,+ effectiveSignature,+ parseResponse, -- * Parameter interface (the optimizer/compiler contract) paramsTraversal,@@ -84,6 +86,8 @@ import Data.Aeson (FromJSON, ToJSON, Value) import Data.Functor.Const (Const (..)) import Data.Functor.Identity (Identity (..))+import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NE import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Text qualified as T@@ -97,9 +101,12 @@ ( Adapter (..), ToPrompt, adapterFor,+ assistantJSON,+ attachNativeRender, attachSchema, fallbackAdapter, nativeAdapter,+ nativeRenderPieces, stampTemperature, ) import Shikumi.Error (ShikumiError (..))@@ -202,10 +209,15 @@ -- normalizing), 'Left' rejects with a reason surfaced as a -- 'ValidationFailure'. Validate :: (o -> Either Text o) -> Program i o -> Program i o- -- | Sample a program @K@ times and return the modal (most-frequent under- -- 'Eq', ties broken by first-seen) output. Each sample is run with its- -- 'TempSchedule' temperature applied to the wire (see 'TempSchedule').- MajorityVote :: (Eq o) => Int -> TempSchedule -> Program i o -> Program i o+ -- | Sample a program @K@ times, then fold the (non-empty) samples with a+ -- total reducer — 'Shikumi.Combinator.majorityVote' passes 'modal' (the modal+ -- value under 'Eq'); 'Shikumi.Combinator.majorityVoteBy' passes a custom+ -- reducer. Each sample is run with its 'TempSchedule' temperature applied to+ -- the wire (see 'TempSchedule'). The reducer is opaque to the parameter+ -- traversal and to 'ProgramShape' (omitted, exactly like 'Ensemble'\'s), so a+ -- @MajorityVote@ exposes the sub-program's 'Params' once. The @Eq o@ that+ -- 'modal' needs now lives on the smart constructor, not the GADT.+ MajorityVote :: Int -> TempSchedule -> (NonEmpty o -> o) -> Program i o -> Program i o -- | Run several programs on the same input, collect their (homogeneous) -- results, and fold them with a total reducer. Ensemble :: [Program i r] -> ([r] -> o) -> Program i o@@ -266,8 +278,8 @@ runProgram (Retry n p) i = retryWith runProgram (const True) n p i runProgram (RetryWhen ok n p) i = retryWith runProgram ok n p i runProgram (Validate v p) i = runProgram p i >>= acceptOrReject v-runProgram (MajorityVote k sched p) i =- modal <$> traverse (\mt -> withSampleTemp mt (runProgram p i)) (sampleTemps (max 1 k) sched)+runProgram (MajorityVote k sched reduce p) i =+ reduce <$> traverse (\mt -> withSampleTemp mt (runProgram p i)) (sampleTemps k sched) runProgram (Ensemble ps reduce) i = reduce <$> traverse (\p -> runProgram p i) ps runProgram (Embed f) i = f i @@ -290,8 +302,8 @@ runProgramConc (Retry n p) i = retryWith runProgramConc (const True) n p i runProgramConc (RetryWhen ok n p) i = retryWith runProgramConc ok n p i runProgramConc (Validate v p) i = runProgramConc p i >>= acceptOrReject v-runProgramConc (MajorityVote k sched p) i =- modal <$> mapConcurrently (\mt -> withSampleTemp mt (runProgramConc p i)) (sampleTemps (max 1 k) sched)+runProgramConc (MajorityVote k sched reduce p) i =+ reduce <$> mapConcurrently (\mt -> withSampleTemp mt (runProgramConc p i)) (sampleTemps k sched) runProgramConc (Ensemble ps reduce) i = reduce <$> mapConcurrently (\p -> runProgramConc p i) ps -- The body requires only @(LLM, Error ShikumiError)@, a subset of this row, so it -- runs unchanged; an embedded agent that wants concurrency uses 'runProgramConc'@@ -303,7 +315,7 @@ -- executors so the wire behaviour is defined once. runPredict :: forall i o es.- (FromModel i, FromModel o, ToSchema o, ToPrompt i, ToPrompt o) =>+ (FromModel i, FromModel o, ToSchema o, Validatable o, ToPrompt i, ToPrompt o) => (LLM :> es, Error ShikumiError :> es) => Signature i o -> Params ->@@ -316,7 +328,13 @@ -- Stamp the derived schema onto the metadata channel regardless of which -- adapter rendered the prompt; the router attaches a real @responseFormat@ -- from it for native-capable models and strips it otherwise.- opts = attachSchema (deriveSchema @o) opts0+ --+ -- Also stamp the native-format alternative (system prompt + JSON demos): the+ -- prompt is rendered model-agnostically as the marker format, so the router+ -- swaps in these native pieces once it knows the real model is native-capable+ -- (and strips them for fallback models / un-routed runs).+ (nativeSys, nativeDemos) = nativeRenderPieces @i @o sig'+ opts = attachNativeRender nativeSys nativeDemos (attachSchema (deriveSchema @o) opts0) resp <- complete placeholderModel ctx opts either throwError pure (parseResponse sig' resp) @@ -324,9 +342,17 @@ -- a native model (whose @responseFormat@ the router enforced) replies with a JSON -- object, while a fallback model replies with @[[ ## field ## ]]@ sections. Because -- a model-agnostic 'runPredict' cannot know at render time which the real model is,--- we try the native JSON parse first and fall back to the section parser, reporting--- the fallback parser's error when both fail (so un-routed runs keep their exact--- prior error behaviour).+-- we detect the shape from the /body/: if it parses as JSON at all it is the native+-- wire shape, so we keep the native parser's precise, located error; otherwise it is+-- the marker shape and the fallback parser handles it exactly as before.+--+-- This detection replaced an older "try native, silently fall back on any native+-- error" rule, which turned a genuine native decode failure (e.g. a JSON body of+-- the wrong shape) into a misleading @MissingField@ from the marker parser finding+-- no sections. One accepted edge: a body that is a bare JSON scalar (e.g. @42@) is+-- now the native shape and reports the native @SchemaMismatch@ ("expected object")+-- rather than a marker @MissingField@ — strictly more accurate. Un-routed runs,+-- whose stub replies are marker bodies, are unaffected. parseResponse :: forall i o. (FromModel o, ToSchema o, Validatable o, ToPrompt i, ToPrompt o) =>@@ -334,27 +360,38 @@ Response -> Either ShikumiError o parseResponse sig' resp =- case parse (nativeAdapter @i @o) sig' resp of- Right o -> Right o+ case assistantJSON resp of+ -- The body is JSON: the native wire shape. Keep the native parser's error.+ Right _ -> parse (nativeAdapter @i @o) sig' resp+ -- Not JSON: the fallback / marker wire shape. Exact prior behaviour. Left _ -> parse (fallbackAdapter @i @o) sig' resp --- | The per-sample temperatures for a 'MajorityVote' of @k@ samples. 'Nothing'--- leaves the provider default in place; 'Just t' is stamped onto the sample's--- requests. The multiset is identical between 'runProgram' and 'runProgramConc'.-sampleTemps :: Int -> TempSchedule -> [Maybe Double]-sampleTemps k (TempFixed xs)- | null xs = replicate k Nothing- | otherwise = map Just (take k (cycle xs))-sampleTemps k (TempSpread base spread) = map Just (spreadTemps k base spread)+-- | The per-sample temperatures for a 'MajorityVote' of @k@ samples (at least+-- one — @k@ is clamped up to 1 here so the executors need not). 'Nothing' leaves+-- the provider default in place; 'Just t' is stamped onto the sample's requests.+-- The multiset is identical between 'runProgram' and 'runProgramConc'.+sampleTemps :: Int -> TempSchedule -> NonEmpty (Maybe Double)+sampleTemps k sched = case sched of+ TempFixed xs+ | null xs -> NE.fromList (replicate k' Nothing)+ | otherwise -> NE.fromList (map Just (take k' (cycle xs)))+ TempSpread base spread -> NE.map Just (spreadTemps k' base spread)+ where+ k' = max 1 k --- | @k@ temperatures fanned evenly across @[base-spread, base+spread]@; a single--- sample sits exactly on @base@.-spreadTemps :: Int -> Double -> Double -> [Double]+-- | @k@ temperatures (@k >= 1@) fanned evenly across @[base-spread, base+spread]@;+-- a single sample sits exactly on @base@. Every derived value is clamped to+-- @[0, 2]@ — the widest range a mainstream provider accepts — so a wide spread+-- never sends a negative (or absurdly high) temperature to the wire. Note this+-- clamps only the /derived/ 'TempSpread' fan-out; 'TempFixed' values are the user's+-- explicit choice and pass through 'sampleTemps' unclamped.+spreadTemps :: Int -> Double -> Double -> NonEmpty Double spreadTemps k base spread- | k <= 1 = [base]- | otherwise = [base - spread + fromIntegral i * step | i <- [0 .. k - 1]]+ | k <= 1 = clampTemp base :| []+ | otherwise = NE.fromList [clampTemp (base - spread + fromIntegral i * step) | i <- [0 .. k - 1]] where step = (2 * spread) / fromIntegral (k - 1)+ clampTemp t = max 0 (min 2 t) -- | Run an action with one sample's temperature stamped onto every outgoing -- 'Complete' (via the private metadata channel the router realizes). 'Nothing' runs@@ -393,16 +430,19 @@ run p i `catchError` \_cs e -> if ok e && left > 1 then go (left - 1) else throwError e --- | The modal value of a non-empty list: most frequent under 'Eq', ties broken--- by first appearance. Tallies in first-seen order, then keeps the first entry--- whose count is strictly greatest.-modal :: (Eq o) => [o] -> o-modal = pickBest . foldl' tally []+-- | The modal value of a non-empty collection of samples: most frequent under+-- 'Eq', ties broken by first appearance. Tallies in first-seen order, then keeps+-- the first entry whose count is strictly greatest. Total: the 'NonEmpty' input+-- guarantees a winner, so there is no empty-list crash.+modal :: (Eq o) => NonEmpty o -> o+modal xs = pickBest (foldl' tally [] (NE.toList xs)) where tally acc x = case break ((== x) . fst) acc of (pre, (y, c) : post) -> pre ++ (y, c + 1) : post (pre, []) -> pre ++ [(x, 1 :: Int)]- pickBest [] = error "Shikumi.Program.modal: empty sample list"+ -- The tally of a non-empty input is non-empty, so the @[]@ case is+ -- unreachable; it returns the first sample to stay total.+ pickBest [] = NE.head xs pickBest (z : zs) = fst (foldl' (\best cur -> if snd cur > snd best then cur else best) z zs) @@ -410,6 +450,10 @@ -- override (when present) and decode the JSON demos into the signature's typed -- demo channel. A demo whose JSON does not decode is reported as the located -- 'ShikumiError' from 'fromModel'.+--+-- Exported as an execution internal: "Shikumi.Stream".@streamPredict@ reuses it+-- (with 'parseResponse') so the streamed and blocking paths overlay 'Params' and+-- decode the reply through one definition, not two divergent copies. effectiveSignature :: (FromModel i, FromModel o, Error ShikumiError :> es) => Signature i o ->@@ -440,7 +484,7 @@ paramsTraversal h (Retry n p) = Retry n <$> paramsTraversal h p paramsTraversal h (RetryWhen ok n p) = RetryWhen ok n <$> paramsTraversal h p paramsTraversal h (Validate v p) = Validate v <$> paramsTraversal h p-paramsTraversal h (MajorityVote k sched p) = MajorityVote k sched <$> paramsTraversal h p+paramsTraversal h (MajorityVote k sched reduce p) = MajorityVote k sched reduce <$> paramsTraversal h p paramsTraversal h (Ensemble ps reduce) = Ensemble <$> traverse (paramsTraversal h) ps <*> pure reduce -- 'Embed' carries no 'Params' (its body is an opaque closure, like 'FMap'\'s -- function), so it is a traversal leaf — preserved untouched.@@ -478,7 +522,7 @@ go (Retry _ p) = go p go (RetryWhen _ _ p) = go p go (Validate _ p) = go p- go (MajorityVote _ _ p) = go p+ go (MajorityVote _ _ _ p) = go p go (Ensemble ps _) = concatMap go ps go (Embed _) = [] @@ -501,7 +545,7 @@ go (Retry _ p) = go p go (RetryWhen _ _ p) = go p go (Validate _ p) = go p- go (MajorityVote _ _ p) = go p+ go (MajorityVote _ _ _ p) = go p go (Ensemble ps _) = concatMap go ps go (Embed _) = [] @@ -541,9 +585,9 @@ go idx (Validate v p) = let (p', idx') = go idx p in (Validate v p', idx')- go idx (MajorityVote k sched p) =+ go idx (MajorityVote k sched reduce p) = let (p', idx') = go idx p- in (MajorityVote k sched p', idx')+ in (MajorityVote k sched reduce p', idx') go idx (Ensemble ps reduce) = let (ps', idx') = goList idx ps in (Ensemble ps' reduce, idx')@@ -610,7 +654,7 @@ programShape (Retry n p) = ShapeRetry n (programShape p) programShape (RetryWhen _ n p) = ShapeRetryWhen n (programShape p) programShape (Validate _ p) = ShapeValidate (programShape p)-programShape (MajorityVote k sched p) = ShapeMajorityVote k sched (programShape p)+programShape (MajorityVote k sched _ p) = ShapeMajorityVote k sched (programShape p) programShape (Ensemble ps _) = ShapeEnsemble (map programShape ps) programShape (Embed _) = ShapeEmbed @@ -662,9 +706,9 @@ go qs (Validate v p) = let (p', qs') = go qs p in (Validate v p', qs')- go qs (MajorityVote k sched p) =+ go qs (MajorityVote k sched reduce p) = let (p', qs') = go qs p- in (MajorityVote k sched p', qs')+ in (MajorityVote k sched reduce p', qs') go qs (Ensemble ms reduce) = let (ms', qs') = goList qs ms in (Ensemble ms' reduce, qs')
src/Shikumi/Refine.hs view
@@ -54,6 +54,7 @@ import Data.Aeson.Key qualified as Key import Data.Aeson.KeyMap qualified as KM import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NE import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Text qualified as T@@ -140,7 +141,7 @@ Program i o -> Program i o bestOfNWith n failCount sched threshold reward inner = embed $ \i ->- let temps = sampleTemps (max 1 n) sched+ let temps = NE.toList (sampleTemps n sched) go [] best lastErr _ = finish best lastErr go (t : ts) best lastErr budget = do res <- tryShikumi (withSampleTemp t (runProgram inner i))@@ -213,6 +214,11 @@ refine n = refineWith n (max 1 n) -- | 'refine' with an explicit @failCount@ budget.+--+-- The advice-generation call between attempts is auxiliary: if it fails, the loop+-- keeps the previous advice (if any) and continues the remaining attempts without+-- consuming the @failCount@ budget, so a failed advice call never discards a valid+-- best-so-far output. @failCount@ guards /inner-program/ failures only. refineWith :: -- | @N@ attempts (clamped to @>= 1@) Int ->@@ -244,8 +250,13 @@ if k == cnt - 1 then finish best' lastErr else do- adv <- generateAdvice r threshold- go (k + 1) best' lastErr (Just adv) budget+ -- The advice call is auxiliary: if it fails, keep the+ -- previous advice (if any) and continue — never discard+ -- a valid best-so-far, and do not consume the failCount+ -- error budget (it guards inner-program failures only).+ advE <- tryShikumi (generateAdvice r threshold)+ let mAdvice' = either (const mAdvice) Just advE+ go (k + 1) best' lastErr mAdvice' budget finish (Just (o, _)) _ = pure o finish Nothing (Just e) = throwError e finish Nothing Nothing = throwError (ProviderFailure "Shikumi.Refine.refine: no attempt produced an output")@@ -374,7 +385,7 @@ Signature (MultiChainInput i o) o2 -> Program i o2 multiChainComparison m reasoner synthSig = embed $ \i -> do- let temps = sampleTemps (max 1 m) defaultSpread+ let temps = NE.toList (sampleTemps m defaultSpread) results <- traverse (\t -> tryShikumi (withSampleTemp t (runProgram reasoner i))) temps let oks = [o | Right o <- results] errs = [e | Left e <- results]
src/Shikumi/Routing.hs view
@@ -11,13 +11,16 @@ -- effect — exactly the seam @cachedLLM@ ("Shikumi.Cache") and @tracedLLM@ -- ("Shikumi.Trace") already use. 'runProgram' renders each 'Predict' node -- model-agnostically against the inert placeholder model and stamps its intentions--- (the derived JSON schema, and any per-sample temperature) onto the private--- request-metadata channel ('Shikumi.Adapter.attachSchema' /--- 'Shikumi.Adapter.stampTemperature'). 'routeLLM' then reads the /ambient/ model--- supplied by 'runRouting', overwrites the placeholder with it, translates the--- stamped metadata into @Options.responseFormat@ (for native-capable models only)--- and @Options.temperature@, strips the private keys, and forwards the call to the--- real @LLM@ interpreter beneath it.+-- (the derived JSON schema, any per-sample temperature, and the native-format render+-- alternative — system prompt + JSON demos) onto the private request-metadata+-- channel ('Shikumi.Adapter.attachSchema' / 'Shikumi.Adapter.stampTemperature' /+-- 'Shikumi.Adapter.attachNativeRender'). 'routeLLM' then reads the /ambient/ model+-- supplied by 'runRouting', overwrites the placeholder with it, and calls+-- 'translateForWire', which for a native-capable model sets+-- @Options.responseFormat@ from the stamped schema and swaps the marker @Context@+-- (system prompt + demo assistant turns) for the stamped native-format alternative;+-- sets @Options.temperature@ when stamped; and in all cases strips the private keys+-- before forwarding the call to the real @LLM@ interpreter beneath it. -- -- Install order (mirroring @runTrace . runKeyedLLM . tracedLLM@): 'runRouting' is -- /outer/ of the real @LLM@ interpreter, which is /outer/ of 'routeLLM' (the@@ -42,20 +45,24 @@ ) where -import Baikai (Model, Options, ResponseFormat (..))+import Baikai (Context, Message (..), Model, Options, ResponseFormat (..), assistant) import Control.Lens ((&), (.~), (^.))-import Data.Aeson (Result (..), Value, fromJSON)+import Data.Aeson (FromJSON, Result (..), Value, fromJSON) import Data.Generics.Labels () import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Vector qualified as V import Effectful (Dispatch (Dynamic), DispatchOf, Eff, Effect, (:>))-import Effectful.Dispatch.Dynamic (interpose, interpret, passthrough, send)+import Effectful.Dispatch.Dynamic (interpose, interpret, send) import Shikumi.Adapter ( ModelCapability (..), capabilityFor,+ metaNativeDemosKey,+ metaNativePromptKey, metaResponseSchemaKey, metaTemperatureKey, )-import Shikumi.LLM (LLM (..), complete)+import Shikumi.LLM (LLM (..), complete, stream) -- | The ambient model-routing effect. Its single operation reads the model every -- 'Predict' node should dispatch against. It is supplied by an interpreter at the@@ -75,39 +82,96 @@ runRouting :: Model -> Eff (Routing : es) a -> Eff es a runRouting m = interpret (\_ CurrentModel -> pure m) --- | The router. Re-interpret the @LLM@ effect so each outgoing 'Complete' is--- dispatched against the ambient model (overwriting the placeholder model the--- model-agnostic 'Shikumi.Program.runProgram' passes), with the private metadata--- channel translated to real wire options and stripped. 'Stream' is forwarded--- unchanged ('runProgram' never streams).+-- | The router. Re-interpret the @LLM@ effect so each outgoing call — /both/+-- 'Complete' and 'Stream' — is dispatched against the ambient model (overwriting+-- the placeholder model the model-agnostic 'Shikumi.Program.runProgram' /+-- 'Shikumi.Stream.streamProgram' passes), with the private metadata channel+-- translated to real wire options (and the marker 'Context' swapped for the native+-- one for native-capable models) and stripped. The two operations are rewritten+-- identically through the single 'translateForWire', so a streamed call gets the+-- same real model id and wire options a blocking call does. routeLLM :: (Routing :> es, LLM :> es) => Eff es a -> Eff es a-routeLLM = interpose $ \env -> \case+routeLLM = interpose $ \_ -> \case Complete _placeholder ctx opts -> do m <- currentModel- complete m ctx (translateForWire m opts)- other -> passthrough env other+ let (ctx', opts') = translateForWire m ctx opts+ complete m ctx' opts'+ Stream _placeholder ctx opts -> do+ m <- currentModel+ let (ctx', opts') = translateForWire m ctx opts+ stream m ctx' opts' --- | Realize the private request-metadata channel against the real model: attach a--- native @responseFormat@ when the schema was stamped /and/ the model is--- native-capable; set @temperature@ when one was stamped; then strip both private--- keys so nothing private reaches the transport.-translateForWire :: Model -> Options -> Options-translateForWire m opts =+-- | Realize the private request-metadata channel against the real model. For a+-- native-capable model: attach the native @responseFormat@ from the stamped+-- schema, and swap the marker-format 'Context' (system prompt + demo assistant+-- turns) for the stamped native-format alternative. In all cases: set+-- @temperature@ when one was stamped, and strip every private @shikumi.*@ key so+-- nothing private reaches the transport. Fallback-capability models keep the+-- marker 'Context' unchanged; non-'Predict' @Complete@ calls (no stamps) are never+-- rewritten.+translateForWire :: Model -> Context -> Options -> (Context, Options)+translateForWire m ctx opts = let md = opts ^. #metadata mSchema = Map.lookup metaResponseSchemaKey md mTemp = Map.lookup metaTemperatureKey md >>= valueToDouble- stripped = Map.delete metaResponseSchemaKey (Map.delete metaTemperatureKey md)- withSchema o = case (mSchema, capabilityFor m) of- (Just s, NativeSchema) ->- o & #responseFormat .~ Just (JsonSchema {name = "output", schema = s, strict = True})- _ -> o+ mNativeSys = Map.lookup metaNativePromptKey md >>= fromJSONMaybe+ mNativeDemos = Map.lookup metaNativeDemosKey md >>= fromJSONMaybe+ stripped =+ foldr+ Map.delete+ md+ [metaResponseSchemaKey, metaTemperatureKey, metaNativePromptKey, metaNativeDemosKey]+ isNative = case capabilityFor m of NativeSchema -> True; PromptFallback -> False+ withSchema o+ | isNative,+ Just s <- mSchema =+ o & #responseFormat .~ Just (JsonSchema {name = "output", schema = s, strict = True})+ | otherwise = o withTemp o = case mTemp of Just t -> o & #temperature .~ Just t Nothing -> o- in withTemp (withSchema (opts & #metadata .~ stripped))+ opts' = withTemp (withSchema (opts & #metadata .~ stripped))+ ctx' = case (isNative, mNativeSys, mNativeDemos) of+ (True, Just sys, Just demos) -> rewriteNativeContext sys demos ctx+ _ -> ctx+ in (ctx', opts') +-- | Install the native-format system prompt and demo assistant turns into a+-- 'Context'. The assistant turns of a 'Predict'-rendered context are exactly the+-- demo outputs, in order; each is replaced (via baikai's deterministic 'assistant'+-- constructor) with the corresponding stamped native text. Defensive: if the count+-- of assistant turns differs from the stamped list length the messages are left+-- untouched (only the system prompt is swapped), so a hand-built or unexpected+-- context is never corrupted.+rewriteNativeContext :: Text -> [Text] -> Context -> Context+rewriteNativeContext sys demos ctx =+ let msgs = V.toList (ctx ^. #messages)+ assistantCount = length [() | AssistantMessage _ <- msgs]+ msgs'+ | assistantCount == length demos = replaceAssistants demos msgs+ | otherwise = msgs+ in ctx & #systemPrompt .~ Just sys & #messages .~ V.fromList msgs'++-- | Replace each assistant message's text with the next demo text, in order,+-- preserving all user/tool messages. Total: if the demo list runs out, remaining+-- assistant messages are kept as-is.+replaceAssistants :: [Text] -> [Message] -> [Message]+replaceAssistants _ [] = []+replaceAssistants ds (m : rest) = case m of+ AssistantMessage _ -> case ds of+ (d : ds') -> assistant d : replaceAssistants ds' rest+ [] -> m : replaceAssistants ds rest+ _ -> m : replaceAssistants ds rest+ -- | Read a JSON number back into a 'Double' (the per-sample temperature). valueToDouble :: Value -> Maybe Double valueToDouble v = case fromJSON v of Success d -> Just d+ Error _ -> Nothing++-- | Read a stamped JSON value back into a decodable Haskell value (the native+-- prompt 'Text' and the demo @[Text]@), returning 'Nothing' on any mismatch.+fromJSONMaybe :: (FromJSON a) => Value -> Maybe a+fromJSONMaybe v = case fromJSON v of+ Success a -> Just a Error _ -> Nothing
src/Shikumi/Schema.hs view
@@ -122,8 +122,16 @@ in ([(nm, sch)], [nm | req]) -- | Per-field schema and whether the field is required. The general--- (overlappable) case is "required, no description"; 'Maybe' is optional/nullable;--- 'Field' attaches the description and preserves the inner required-ness.+-- (overlappable) case is "required, no description"; 'Maybe' is+-- required-but-nullable (see below); 'Field' attaches the description and+-- preserves the inner required-ness.+--+-- A 'Maybe' field is /required/ in the JSON Schema and expresses its optionality+-- as nullability (a nullable schema). OpenAI strict mode (@strict: true@, which+-- the router always requests) requires every property to appear in @required@;+-- omitting a property is rejected. The decode side is unaffected —+-- @FromField (Maybe a)@ accepts a missing key, an explicit @null@, or a value —+-- so a fallback-model reply that omits the field still decodes. class FieldSchema t where fieldSchema :: Proxy t -> (Value, Bool) @@ -131,7 +139,7 @@ fieldSchema _ = (toSchema (Proxy @a), True) instance (ToSchema a) => FieldSchema (Maybe a) where- fieldSchema _ = (nullableSchema (toSchema (Proxy @a)), False)+ fieldSchema _ = (nullableSchema (toSchema (Proxy @a)), True) instance (KnownSymbol d, FieldSchema a) => FieldSchema (Field d a) where fieldSchema _ =@@ -307,15 +315,23 @@ -- Validation hook -- --------------------------------------------------------------------------- --- | A domain rule applied after a successful decode. Defaults to "always valid";--- override per output type to enforce rules (e.g. "bullets has 3-5 elements").+-- | A domain rule applied after a successful decode, enforced by the decode path+-- in every program runner (@runProgram@, @runProgramConc@, @streamProgram@, and+-- the derived modules). Override per output type to enforce rules (e.g.+-- "bullets has 3-5 elements"); a violation surfaces as a+-- 'Shikumi.Error.ValidationFailure'.+--+-- Instances are opt-in: there is no catch-all. Every type used as a @Predict@+-- output (or a tool input) must declare an instance. A type with no rules+-- declares an empty instance — @instance Validatable Foo@ (no body; the default+-- @validate = Right@ applies) — or adds @Validatable@ to a @deriving anyclass@+-- list (@DeriveAnyClass@ is a default extension in every package). Making the+-- no-rules case explicit is deliberate: it prevents a forgotten constraint from+-- silently regressing to "always valid". class Validatable a where validate :: a -> Either Text a validate = Right --- | Default "always valid" for any type without an explicit rule.-instance {-# OVERLAPPABLE #-} Validatable a- -- --------------------------------------------------------------------------- -- Declarative field constraints (EP-26) -- ---------------------------------------------------------------------------@@ -351,16 +367,20 @@ | otherwise = checkConstraints (Proxy @cs) t instance forall s cs a. (KnownSymbol s, ToScientificLeaf a, ReflectConstraints cs a) => ReflectConstraints ('MinVal s ': cs) a where- constraintSchema _ = constraintSchema @cs @a Proxy . withMinimum (parseBound (Proxy @s))- checkConstraints _ x- | toScientificLeaf x < parseBound (Proxy @s) = Left ("minimum " <> T.pack (symbolVal (Proxy @s)) <> " violated")- | otherwise = checkConstraints (Proxy @cs) x+ constraintSchema _ = constraintSchema @cs @a Proxy . maybe id withMinimum (parseBound (Proxy @s))+ checkConstraints _ x = case parseBound (Proxy @s) of+ Nothing -> Left ("invalid numeric bound symbol: " <> T.pack (symbolVal (Proxy @s)))+ Just b+ | toScientificLeaf x < b -> Left ("minimum " <> T.pack (symbolVal (Proxy @s)) <> " violated")+ | otherwise -> checkConstraints (Proxy @cs) x instance forall s cs a. (KnownSymbol s, ToScientificLeaf a, ReflectConstraints cs a) => ReflectConstraints ('MaxVal s ': cs) a where- constraintSchema _ = constraintSchema @cs @a Proxy . withMaximum (parseBound (Proxy @s))- checkConstraints _ x- | toScientificLeaf x > parseBound (Proxy @s) = Left ("maximum " <> T.pack (symbolVal (Proxy @s)) <> " violated")- | otherwise = checkConstraints (Proxy @cs) x+ constraintSchema _ = constraintSchema @cs @a Proxy . maybe id withMaximum (parseBound (Proxy @s))+ checkConstraints _ x = case parseBound (Proxy @s) of+ Nothing -> Left ("invalid numeric bound symbol: " <> T.pack (symbolVal (Proxy @s)))+ Just b+ | toScientificLeaf x > b -> Left ("maximum " <> T.pack (symbolVal (Proxy @s)) <> " violated")+ | otherwise -> checkConstraints (Proxy @cs) x instance (KnownSymbols ss, ReflectConstraints cs Text) => ReflectConstraints ('EnumOneOf ss ': cs) Text where constraintSchema _ = constraintSchema @cs @Text Proxy . withEnum (symbolTexts (Proxy @ss))@@ -388,11 +408,14 @@ instance (KnownSymbol s, KnownSymbols ss) => KnownSymbols (s ': ss) where symbolTexts _ = T.pack (symbolVal (Proxy @s)) : symbolTexts (Proxy @ss) --- | Parse a numeric-bound 'Symbol' (e.g. @"100"@, @"-3.5"@) to a 'Sci.Scientific'.-parseBound :: forall s. (KnownSymbol s) => Proxy s -> Sci.Scientific-parseBound _ = case readMaybe (symbolVal (Proxy @s)) of- Just v -> v- Nothing -> error ("Shikumi.Schema: invalid numeric bound symbol " <> symbolVal (Proxy @s))+-- | Parse a numeric-bound 'Symbol' (e.g. @"100"@, @"-3.5"@) to a 'Sci.Scientific',+-- or 'Nothing' when the symbol is not a number. Total — a malformed bound (e.g.+-- @MinVal "abc"@) no longer crashes the process at schema-derivation time; instead+-- the schema keyword is silently omitted and every decode of the field fails with a+-- located 'ValidationFailure' naming the bad symbol (see the @MinVal@/@MaxVal@+-- 'ReflectConstraints' instances).+parseBound :: forall s. (KnownSymbol s) => Proxy s -> Maybe Sci.Scientific+parseBound _ = readMaybe (symbolVal (Proxy @s)) tshow :: (Show a) => a -> Text tshow = T.pack . show
src/Shikumi/Schema/Types.hs view
@@ -151,9 +151,11 @@ arraySchema :: Value -> Value arraySchema items = object ["type" .= ("array" :: Text), "items" .= items] --- | @{"enum":[...]}@ for an enum-like sum of nullary constructors.+-- | @{"type":"string","enum":[...]}@ for an enum-like sum of nullary+-- constructors. OpenAI strict mode requires every schema node to carry an explicit+-- type; the enum values are the constructor names, so the type is @"string"@. enumSchema :: [Text] -> Value-enumSchema names = object ["enum" .= names]+enumSchema names = object ["type" .= ("string" :: Text), "enum" .= names] -- | Permit JSON @null@ in addition to the wrapped schema. The @anyOf@ form is -- used (more portable across providers than @"type":["T","null"]@).
src/Shikumi/Stream.hs view
@@ -62,21 +62,21 @@ import Effectful (Eff, (:>)) import Effectful.Error.Static (Error, throwError) import GHC.Generics (Generic)-import Shikumi.Adapter (Adapter (..), ToPrompt, adapterFor)+import Shikumi.Adapter (Adapter (..), ToPrompt, adapterFor, attachNativeRender, attachSchema, nativeRenderPieces) import Shikumi.Error (ShikumiError) import Shikumi.LLM (LLM, stream) import Shikumi.Program- ( Demo (..),- Params (..),+ ( Params, Program (Compose, Embed, FMap, MajorityVote, Map, Parallel, Predict, Retry, RetryWhen, Validate), acceptOrReject,+ effectiveSignature,+ parseResponse, retryWith, runProgram, )-import Shikumi.Schema (FromModel, ToSchema, fromModel)+import Shikumi.Schema (FromModel, ToSchema, Validatable, deriveSchema) import Shikumi.Schema.Types qualified as ST-import Shikumi.Signature (Signature, getInstruction, outputFields, setDemos, setInstruction)-import Shikumi.Signature qualified as Sig+import Shikumi.Signature (Signature, outputFields) -- --------------------------------------------------------------------------- -- Event types@@ -173,10 +173,14 @@ firstTextEnd evs = listToMaybe [c | TextEnd (BlockEndPayload _ c) <- evs] -- | Reassemble a 'Response' from the stream's terminal event (its payload's--- fully-assembled assistant message). 'EventError' surfaces the assembled--- (possibly-partial) response just like the blocking path, so the caller's 'parse'--- fails on a bad response identically. Falls back to a response synthesized from+-- fully-assembled assistant message). Falls back to a response synthesized from -- the @TextEnd@ content if no terminal assistant message is present.+--+-- The 'EventError' branch is retained for robustness against third-party @LLM@+-- interpreters, but is /unreachable through shikumi's own interpreters/: they now+-- convert a terminal 'EventError' to an out-of-band 'ShikumiError' before the event+-- list ever reaches here (see 'Shikumi.LLM' — @raiseStreamError@), so a streamed+-- 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@@ -227,17 +231,27 @@ -- chunks where per-field streaming is ambiguous or the body is opaque). Map _ _ -> blockingNode prog i cb Parallel _ _ -> blockingNode prog i cb- MajorityVote _ _ _ -> blockingNode prog i cb+ MajorityVote _ _ _ _ -> blockingNode prog i cb Embed _ -> blockingNode prog i cb _ -> blockingNode prog i cb --- | Stream a single 'Predict': overlay its 'Params', render via the (fallback)--- adapter, stream the first output field's chunks bracketed by @LmStart@/@LmEnd@,--- then run the identical 'parse' on the reassembled response so the typed result--- equals 'runProgram'\'s.+-- | Stream a single 'Predict', mirroring 'Shikumi.Program.runPredict' exactly so+-- the streamed and blocking paths share one wire + decode definition. It overlays+-- 'Params' via the exported 'effectiveSignature', renders model-agnostically, stamps+-- the derived schema and the native render alternative onto the metadata channel+-- (so the router can attach a native @responseFormat@ and swap the native prompt for+-- native-capable models), streams the first output field's chunks bracketed by+-- @LmStart@/@LmEnd@, and decodes the reassembled response through the shared+-- 'Shikumi.Program.parseResponse' (dual-format: JSON body → native parser keeping+-- its located error, marker body → fallback parser).+--+-- Chunk-attribution caveat (unchanged): field chunks are honest only for the+-- marker/raw-text wire shape; a routed native (JSON) stream still delivers chunks of+-- the raw JSON text, though the /final typed value/ now decodes correctly via+-- 'parseResponse'. streamPredict :: forall i o es.- (FromModel i, FromModel o, ToSchema o, ToPrompt i, ToPrompt o) =>+ (FromModel i, FromModel o, ToSchema o, Validatable o, ToPrompt i, ToPrompt o) => (LLM :> es, Error ShikumiError :> es) => Signature i o -> Params ->@@ -245,16 +259,18 @@ (StreamEvent -> Eff es ()) -> Eff es o streamPredict sig ps i cb = do- sig' <- effectiveSig sig ps+ sig' <- effectiveSignature sig ps let adapter = adapterFor _Model- (ctx, opts) = render adapter sig' i+ (ctx, opts0) = render adapter sig' i+ (nativeSys, nativeDemos) = nativeRenderPieces @i @o sig'+ opts = attachNativeRender nativeSys nativeDemos (attachSchema (deriveSchema @o) opts0) fieldNm = case map ST.fieldName (outputFields sig') of (x : _) -> x [] -> "" cb (StreamStatus (Status LmStart "LM call started")) resp <- streamComplete fieldNm _Model ctx opts cb cb (StreamStatus (Status LmEnd "LM call finished"))- either throwError pure (parse adapter sig' resp)+ either throwError pure (parseResponse sig' resp) -- | Bracket an action with @NodeStart@/@NodeEnd@ status messages. bracketNode :: (StreamEvent -> Eff es ()) -> Eff es a -> Eff es a@@ -272,17 +288,3 @@ (StreamEvent -> Eff es ()) -> Eff es o blockingNode prog i cb = bracketNode cb (runProgram prog i)---- | Overlay a node's 'Params' onto its signature (effective instruction + decoded--- demos), replicating 'Shikumi.Program.runProgram'\'s internal @effectiveSignature@--- so a streamed 'Predict' renders byte-for-byte as the blocking one would.-effectiveSig ::- (FromModel i, FromModel o, Error ShikumiError :> es) =>- Signature i o ->- Params ->- Eff es (Signature i o)-effectiveSig sig (Params {instructionOverride = ovr, demos = ds}) = do- typed <- either throwError pure (traverse decodeDemo ds)- pure (setDemos typed (setInstruction (fromMaybe (getInstruction sig) ovr) sig))- where- decodeDemo (Demo inJ outJ) = Sig.Demo <$> fromModel inJ <*> fromModel outJ
test/CombinatorSpec.hs view
@@ -10,6 +10,7 @@ import Control.Lens ((&), (.~)) import Data.Generics.Labels () import Data.IORef (newIORef, readIORef)+import Data.List.NonEmpty (NonEmpty (..)) import Data.Text (Text) import Data.Text qualified as T import Effectful (runEff)@@ -171,7 +172,7 @@ r <- runSeq pipe [outlineResponse, draftResponse] (Topic "haskell") r @?= Right (Draft "A fine essay about the outline."), testCase "chain composes n same-type stages, returning the last stage's output" $ do- let pipe = chain [cellP, cellP, cellP]+ let pipe = chain (cellP :| [cellP, cellP]) r <- runSeq pipe [cellResp "a", cellResp "b", cellResp "c"] (Cell "in") r @?= Right (Cell "c") ]@@ -268,7 +269,11 @@ testCase "majorityVoteBy applies the custom reducer" $ do let prog = majorityVoteBy 3 sched1 concatCells cellP r <- runSeq prog [cellResp "x", cellResp "y", cellResp "z"] (Cell "in")- r @?= Right (Cell "xyz")+ r @?= Right (Cell "xyz"),+ testCase "majorityVoteBy exposes the sub-program's params once, not K times" $+ -- EP-35: it is a single node sampled K times (reducer carried on+ -- MajorityVote), not K distinct Ensemble members.+ length (foldParams (majorityVoteBy 3 sched1 concatCells cellP)) @?= 1 ] ensembleTests :: TestTree@@ -289,9 +294,9 @@ deepProg :: Program Cell Cell deepProg = chain- [ retry 2 (majorityVote 3 sched1 cellP),- validate (const True) "always ok" cellP- ]+ ( retry 2 (majorityVote 3 sched1 cellP)+ :| [validate (const True) "always ok" cellP]+ ) crossCuttingTests :: TestTree crossCuttingTests =
test/ConstraintSpec.hs view
@@ -11,6 +11,7 @@ import Data.Aeson.Key qualified as Key import Data.Aeson.KeyMap qualified as KM import Data.Text (Text)+import Data.Text qualified as T import GHC.Generics (Generic) import Shikumi.Error (ShikumiError (..)) import Shikumi.Schema (FromModel, ToSchema, Validatable, deriveSchema, fromModel)@@ -45,6 +46,18 @@ instance Validatable BioUnchecked +-- A record with a /malformed/ numeric bound symbol (EP-35): @"abc"@ is not a+-- number. Deriving its schema must not crash, and decoding must fail cleanly.+newtype BadBound = BadBound+ {n :: Constrained '[ 'MinVal "abc"] Int}+ deriving stock (Generic, Show, Eq)++instance ToSchema BadBound++instance FromModel BadBound++instance Validatable BadBound+ -- | Drill into @properties.<field>@ of a record schema 'Value'. propOf :: Text -> Value -> Maybe Value propOf name (Object o) = do@@ -78,7 +91,13 @@ @?= Left (ValidationFailure "score: maximum 100 violated"), testCase "contrast: the unconstrained record accepts the short value" $ fromModel @BioUnchecked (obj "short" 50)- @?= Right (BioUnchecked {tagline = "short", score = 50})+ @?= Right (BioUnchecked {tagline = "short", score = 50}),+ testCase "EP-35: a malformed numeric bound omits the schema keyword (no crash)" $+ (propOf "n" (deriveSchema @BadBound) >>= keyword "minimum") @?= Nothing,+ testCase "EP-35: a malformed numeric bound fails decode with a ValidationFailure naming it" $+ case fromModel @BadBound (Object (KM.fromList [("n", Number 5)])) of+ Left (ValidationFailure m) | "abc" `T.isInfixOf` m -> pure ()+ other -> assertFailure ("expected ValidationFailure mentioning abc, got " <> show other) ] where obj t s =
test/ErrorSpec.hs view
@@ -43,4 +43,5 @@ isTransient (InvalidJSON "") @?= False isTransient (MissingField "") @?= False isTransient (ValidationFailure "") @?= False+ isTransient (CodeExecFailed "") @?= False ]
test/LiveSpec.hs view
@@ -6,7 +6,7 @@ -- default test run remains hermetic. module LiveSpec (tests) where -import Baikai hiding (complete)+import Baikai hiding (complete, flattenAssistantText) import Baikai.Models.Generated (openai_gpt_4o_mini) import Baikai.Prelude import Baikai.Provider.OpenAI.Api qualified as OpenAI
test/ModuleSpec.hs view
@@ -16,8 +16,9 @@ mkResponse, runScriptedLLM, topicToOutline,+ topicToVerdict, )-import Shikumi.Error (ShikumiError)+import Shikumi.Error (ShikumiError (..)) import Shikumi.Module (WithReasoning (..), chainOfThought, chainOfThoughtRaw, predict) import Shikumi.Program (emptyParams, foldParams, mapParamsAt, runProgram) import Test.Tasty (TestTree, testGroup)@@ -59,6 +60,20 @@ runEff . runErrorNoCallStack @ShikumiError . runScriptedLLM ref $ runProgram (chainOfThought topicToOutline) (Topic "haskell") out @?= Right (Outline {points = ["x", "y"]}),+ testCase "EP-32: a failing Validatable rule surfaces through chainOfThought" $ do+ ref <-+ newIORef+ [ mkResponse+ ( markerBody+ [ ("reasoning", "thinking"),+ ("value", "{\"score\": 99}")+ ]+ )+ ]+ out <-+ runEff . runErrorNoCallStack @ShikumiError . runScriptedLLM ref $+ runProgram (chainOfThought topicToVerdict) (Topic "haskell")+ out @?= Left (ValidationFailure "score: must be at most 10"), testCase "the chain-of-thought node's params are reachable via mapParamsAt 0" $ foldParams (mapParamsAt 0 (\p -> p & #instructionOverride .~ Just "cot") (chainOfThought topicToOutline)) @?= [emptyParams & #instructionOverride .~ Just "cot"]
test/ProgramFixtures.hs view
@@ -10,17 +10,20 @@ Outline (..), Draft (..), Cell (..),+ Verdict (..), -- * Signatures topicToOutline, outlineToDraft, cellSig,+ topicToVerdict, -- * Canned responses mkResponse, outlineResponse, draftResponse, cellResponse,+ badVerdictResponse, markerBody, -- * Fake LLM interpreters@@ -48,7 +51,7 @@ import GHC.Generics (Generic) import Shikumi.Adapter (ToPrompt) import Shikumi.LLM (LLM (..))-import Shikumi.Schema (FromModel, ToSchema, Validatable)+import Shikumi.Schema (FromModel, ToSchema, Validatable (..)) import Shikumi.Signature (Signature, mkSignature) -- ---------------------------------------------------------------------------@@ -101,6 +104,22 @@ instance Validatable Cell +-- | A record with a real validation rule, for the EP-32 dispatch tests.+newtype Verdict = Verdict {score :: Int}+ deriving stock (Generic, Show, Eq)++instance ToSchema Verdict++instance FromModel Verdict++instance ToPrompt Verdict++-- | Domain rule: a score is at most 10.+instance Validatable Verdict where+ validate v+ | score v > 10 = Left "score: must be at most 10"+ | otherwise = Right v+ -- --------------------------------------------------------------------------- -- Signatures -- ---------------------------------------------------------------------------@@ -114,6 +133,9 @@ cellSig :: Signature Cell Cell cellSig = mkSignature "Echo the cell" +topicToVerdict :: Signature Topic Verdict+topicToVerdict = mkSignature "Score the topic"+ -- --------------------------------------------------------------------------- -- Canned responses (rendered as the fallback adapter's [[ ## field ## ]] sections) -- ---------------------------------------------------------------------------@@ -139,6 +161,10 @@ -- | Echo a fixed cell value (used by the @Cell -> Cell@ pipelines). cellResponse :: Response cellResponse = mkResponse (markerBody [("cell", "echoed")])++-- | A reply whose score violates the 'Verdict' rule.+badVerdictResponse :: Response+badVerdictResponse = mkResponse (markerBody [("score", "99")]) -- --------------------------------------------------------------------------- -- Fake LLM interpreters
test/ProgramSpec.hs view
@@ -6,25 +6,31 @@ import Data.Generics.Labels () import Data.IORef (newIORef) import Data.List (foldl1')+import Data.List.NonEmpty qualified as NE import Data.Text (Text) import Data.Text qualified as T import Effectful (runEff)+import Effectful.Concurrent (runConcurrent) import Effectful.Error.Static (runErrorNoCallStack) import ProgramFixtures ( Cell (..), Draft, Outline (..), Topic (..),+ badVerdictResponse, cellSig,+ mkResponse, outlineResponse, outlineToDraft, runScriptedLLM, topicToOutline,+ topicToVerdict, )-import Shikumi.Error (ShikumiError)+import Shikumi.Error (ShikumiError (..)) import Shikumi.Program ( Params, Program (Compose, Predict),+ TempSchedule (..), emptyParams, foldParams, mapParams,@@ -32,9 +38,11 @@ nodeInstructionsIndexed, pipeline, runProgram,+ runProgramConc,+ sampleTemps, ) import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (testCase, (@?=))+import Test.Tasty.HUnit (assertBool, testCase, (@?=)) import Test.Tasty.QuickCheck (NonNegative (..), Positive (..), testProperty, (===)) -- A two-stage program reused across the param tests.@@ -63,6 +71,33 @@ runEff . runErrorNoCallStack @ShikumiError . runScriptedLLM ref $ runProgram (Predict topicToOutline emptyParams) (Topic "haskell") out @?= Right (Outline {points = ["intro", "body", "end"]}),+ testCase "EP-32: a failing Validatable rule surfaces as ValidationFailure through runProgram" $ do+ ref <- newIORef [badVerdictResponse]+ out <-+ runEff . runErrorNoCallStack @ShikumiError . runScriptedLLM ref $+ runProgram (Predict topicToVerdict emptyParams) (Topic "haskell")+ out @?= Left (ValidationFailure "score: must be at most 10"),+ testCase "EP-32: a failing Validatable rule surfaces through runProgramConc" $ do+ ref <- newIORef [badVerdictResponse]+ out <-+ runEff . runErrorNoCallStack @ShikumiError . runConcurrent . runScriptedLLM ref $+ runProgramConc (Predict topicToVerdict emptyParams) (Topic "haskell")+ out @?= Left (ValidationFailure "score: must be at most 10"),+ testCase "EP-33: a native JSON body of the wrong shape keeps the located native error" $ do+ -- {"points": 42} parses as JSON, so it is the native wire shape; the+ -- native decode reports the precise SchemaMismatch instead of the marker+ -- parser's misleading MissingField.+ ref <- newIORef [mkResponse "{\"points\": 42}"]+ out <-+ runEff . runErrorNoCallStack @ShikumiError . runScriptedLLM ref $+ runProgram (Predict topicToOutline emptyParams) (Topic "haskell")+ out @?= Left (SchemaMismatch "points: expected array, got number"),+ testCase "EP-35: TempSpread temperatures are clamped to [0, 2]" $ do+ -- Before the clamp, TempSpread 0.1 0.5 fans to [-0.4, 0.1, 0.6]; the -0.4+ -- would be sent to a provider that rejects it.+ let ts = [t | Just t <- NE.toList (sampleTemps 3 (TempSpread 0.1 0.5))]+ length ts @?= 3+ assertBool ("all temperatures in [0, 2], got " <> show ts) (all (\t -> t >= 0 && t <= 2) ts), testCase "M2: foldParams returns nodes in stage order" $ foldParams twoStage @?= [emptyParams, emptyParams], testCase "M5: nodeInstructionsIndexed returns signature instructions in node order" $
test/RefineSpec.hs view
@@ -21,6 +21,7 @@ ( Answer (..), Sentence (..), classifyProg,+ decideAdviceFailure, decideMCC, decideRefine, decideTemp,@@ -58,6 +59,7 @@ bestOfNShortCircuits, bestOfNExhaustsFailCount, refineClimbsViaAdvice,+ refineSurvivesAdviceFailure, multiChainSynthesizes, moduleComposes, moduleIsTransparent,@@ -186,6 +188,16 @@ assertBool "feedback strictly improves the reward" (rewardOf goodReward wrapped > rewardOf goodReward single)++refineSurvivesAdviceFailure :: TestTree+refineSurvivesAdviceFailure =+ testCase "refine returns best-so-far when the advice call fails (EP-35)" $ do+ -- Every classify answers "bad" (sub-threshold); the advice call between+ -- attempts fails to decode. Before EP-35 that error aborted the whole refine;+ -- now it is non-fatal and the best-so-far output is returned.+ let reward = mkReward goodReward+ (wrapped, _) <- runCounted decideAdviceFailure (refine 2 1.0 reward classifyProg) (Sentence "x")+ wrapped @?= Right (Answer "bad") -- --------------------------------------------------------------------------- -- M3 — multiChainComparison
test/RefineStub.hs view
@@ -39,6 +39,7 @@ decideTemp, decideRefine, decideMCC,+ decideAdviceFailure, -- * Stub interpreters runStub,@@ -56,6 +57,7 @@ import Control.Lens ((^.)) import Data.Generics.Labels () import Data.IORef (IORef, atomicModifyIORef', modifyIORef')+import Data.List.NonEmpty qualified as NE import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Text qualified as T@@ -173,6 +175,15 @@ | hasField "Hint from a previous attempt" ctx = markerBody [("answer", "good")] | otherwise = markerBody [("answer", "bad")] +-- | EP-35 rule: the advice call replies with a body that has no @advice@ field, so+-- @generateAdvice@'s decode fails; every classify call answers @bad@ (always+-- sub-threshold). Exercises 'Shikumi.Refine.refine' surviving an advice-call+-- failure and returning its best-so-far instead of aborting.+decideAdviceFailure :: Context -> Options -> Text+decideAdviceFailure ctx _+ | hasField "advice" ctx = markerBody [("notadvice", "unusable")]+ | otherwise = markerBody [("answer", "bad")]+ -- | M3 multi-chain rule: a reasoning call answers a temperature-chosen candidate; a -- synthesis call returns the modal candidate it was shown. decideMCC :: Context -> Options -> Text@@ -197,7 +208,7 @@ modalCandidate :: Text -> Text modalCandidate t = case extractAnswers t of [] -> ""- xs -> modal xs+ xs -> modal (NE.fromList xs) -- | Pull each attempt's answer out of the rendered 'MultiChainInput' prompt. extractAnswers :: Text -> [Text]
test/ResilienceSpec.hs view
@@ -4,7 +4,7 @@ -- rate limit caps in-flight calls. module ResilienceSpec (tests) where -import Baikai (flattenAssistantBlocks)+import Baikai (AssistantMessageEvent (..), flattenAssistantBlocks) import Control.Concurrent (forkIO) import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) import Control.Concurrent.STM (newTVarIO, readTVarIO)@@ -12,6 +12,7 @@ import Data.Ratio ((%)) import Effectful (runEff) import Effectful.Concurrent (runConcurrent)+import Effectful.Concurrent.Async (mapConcurrently) import Effectful.Error.Static (runErrorNoCallStack) import Shikumi.Error (ShikumiError (..)) import Shikumi.LLM@@ -21,11 +22,15 @@ defaultLLMConfig, newRateLimiter, runLLMResilient,+ stream, )-import Shikumi.LLM.Budget (newBudget)+import Shikumi.LLM.Budget (newBudget, spentUSD) import StubProvider- ( concurrencyStubRegistry,+ ( budgetBarrierStubRegistry,+ concurrencyStubRegistry, costStubRegistry,+ failingStreamCostStubRegistry,+ failingStreamStubRegistry, failingStubRegistry, flattenAssistantText, invalidStubRegistry,@@ -78,6 +83,27 @@ case res2 of Left (BudgetExceeded _) -> pure () other -> assertFailure ("expected Left (BudgetExceeded ...), got " <> show other),+ testCase "EP-35: budget admission is optimistic — N concurrent calls overshoot the ceiling" $ do+ -- The barrier stub keeps all four calls in flight (each already past+ -- admitCall) until none has recorded its cost, pinning the documented+ -- overshoot: admission is not reservation.+ arrived <- newTVarIO 0+ reg <- budgetBarrierStubRegistry arrived 4 (1 % 100) "ok"+ b <- newBudget (Just (1 % 100)) -- ceiling = a single call's cost+ let cfg = (defaultLLMConfig reg) {budget = Just b}+ results <-+ runEff . runConcurrent . runErrorNoCallStack @ShikumiError . runLLMResilient cfg $+ mapConcurrently (const (complete stubModel stubContext stubOptions)) [1 .. 4 :: Int]+ case results of+ Right rs -> length rs @?= 4 -- all four admitted together (overshoot)+ other -> assertFailure ("expected all four concurrent calls to succeed, got " <> show other)+ spent <- spentUSD b+ assertBool "total overshot the ceiling" (spent > (1 % 100))+ -- the ceiling is now consumed; a subsequent call is refused+ res5 <- runText cfg+ case res5 of+ Left (BudgetExceeded _) -> pure ()+ other -> assertFailure ("expected Left (BudgetExceeded ...) once the ceiling is consumed, got " <> show other), testCase "rate limit caps concurrency at 1" $ do cur <- newTVarIO 0 mx <- newTVarIO 0@@ -93,10 +119,51 @@ r1 @?= Right "ok" r2 @?= Right "ok" observedMax <- readTVarIO mx- assertBool ("observed max concurrency " <> show observedMax <> " should be <= 1") (observedMax <= 1)+ assertBool ("observed max concurrency " <> show observedMax <> " should be <= 1") (observedMax <= 1),+ testCase "EP-34: stream retry recovers after 2 failures" $ do+ -- A stream that fails twice (terminal EventError) then succeeds. The+ -- interpreter now raises the in-band error out-of-band, so retrying fires.+ ref <- newIORef 0+ reg <- failingStreamStubRegistry ref 2 "ok"+ let cfg = (defaultLLMConfig reg) {retryPolicy = RetryPolicy 3 1 5}+ res <- runStream cfg+ case res of+ Right evs -> assertBool "successful stream ends with EventDone" (any isEventDone evs)+ other -> assertFailure ("expected Right events, got " <> show other)+ n <- readIORef ref+ n @?= 3,+ testCase "EP-34: a permanently failing stream surfaces a transient ProviderFailure" $ do+ ref <- newIORef 0+ reg <- failingStreamStubRegistry ref 5 "ok" -- more failures than attempts+ let cfg = (defaultLLMConfig reg) {retryPolicy = RetryPolicy 3 1 5}+ res <- runStream cfg+ case res of+ Left (ProviderFailure _) -> pure ()+ other -> assertFailure ("expected Left (ProviderFailure ...), got " <> show other)+ n <- readIORef ref+ n @?= 3, -- retried up to maxAttempts+ testCase "EP-34: a failed stream still charges the budget (charge precedes the throw)" $ do+ -- First call: budget gate passes, stream fails after charging its cost, so+ -- the failure surfaces AND the cost is recorded. Second call: the gate now+ -- refuses because the first (failed) call already consumed the ceiling.+ reg <- failingStreamCostStubRegistry (1 % 100)+ b <- newBudget (Just (1 % 100))+ let cfg = (defaultLLMConfig reg) {budget = Just b, retryPolicy = RetryPolicy 1 1 5}+ res1 <- runStream cfg+ case res1 of+ Left (ProviderFailure _) -> pure ()+ other -> assertFailure ("expected Left (ProviderFailure ...), got " <> show other)+ res2 <- runStream cfg+ case res2 of+ Left (BudgetExceeded _) -> pure ()+ other -> assertFailure ("expected Left (BudgetExceeded ...) after the failed call charged, got " <> show other) ] where runText cfg = runEff . runConcurrent . runErrorNoCallStack @ShikumiError . runLLMResilient cfg $ do r <- complete stubModel stubContext stubOptions pure (flattenAssistantText (flattenAssistantBlocks r))+ runStream cfg =+ runEff . runConcurrent . runErrorNoCallStack @ShikumiError . runLLMResilient cfg $+ stream stubModel stubContext stubOptions+ isEventDone = \case EventDone _ -> True; _ -> False
test/RoutingSpec.hs view
@@ -9,27 +9,54 @@ -- identical temperatures). module RoutingSpec (tests) where -import Baikai (Model, Options, ResponseFormat (..), _Model)+import Baikai+ ( AssistantContent (..),+ AssistantMessageEvent (..),+ Context,+ Message (..),+ Model,+ Options,+ ResponseFormat (..),+ StopReason (..),+ TextContent (..),+ doneTerminal,+ _Model,+ ) import Baikai.Models.Generated (openai_gpt_4o_mini) import Control.Lens ((^.))+import Data.Aeson (Value (..), eitherDecodeStrict, object, (.=))+import Data.Aeson.KeyMap qualified as KM import Data.Generics.Labels ()-import Data.IORef (IORef, modifyIORef', newIORef, readIORef)+import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef) import Data.List (nub, sort)+import Data.List.NonEmpty qualified as NE import Data.Map.Strict qualified as Map import Data.Maybe (mapMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding (encodeUtf8)+import Data.Vector qualified as V import Effectful (Eff, IOE, liftIO, runEff, type (:>)) import Effectful.Concurrent (runConcurrent) import Effectful.Dispatch.Dynamic (interpret) import Effectful.Error.Static (runErrorNoCallStack) import ProgramFixtures (Outline, Topic (..), outlineResponse, topicToOutline)-import Shikumi.Adapter (metaResponseSchemaKey, metaTemperatureKey)-import Shikumi.Combinator (majorityVote)+import Shikumi.Adapter (metaNativeDemosKey, metaNativePromptKey, metaResponseSchemaKey, metaTemperatureKey)+import Shikumi.Combinator (majorityVote, majorityVoteBy) import Shikumi.Error (ShikumiError) import Shikumi.LLM (LLM (..), Response) import Shikumi.Module (predict)-import Shikumi.Program (Program, TempSchedule (..), runProgram, runProgramConc)+import Shikumi.Program+ ( Demo (..),+ Params (..),+ Program (Predict),+ TempSchedule (..),+ runProgram,+ runProgramConc,+ ) import Shikumi.Routing (routeLLM, runRouting) import Shikumi.Schema (deriveSchema)+import Shikumi.Stream (streamProgram) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertBool, testCase, (@?=)) @@ -40,7 +67,12 @@ [ routesModelId, nativeAttachesSchema, fallbackLeavesSchemaUnset,+ nativeReceivesNativeGuide,+ nativeReceivesJsonDemos,+ fallbackPromptUnchangedAndStampsStripped,+ routesStreamModelAndStripsMetadata, spreadSetsDistinctTemps,+ majorityVoteBySetsDistinctTemps, fixedSetsExactTemps, concurrentAgreesOnTemps ]@@ -49,23 +81,28 @@ -- Capturing stub + run helpers -- --------------------------------------------------------------------------- --- | A base @LLM@ interpreter that records every request's @(Model, Options)@ and--- returns a fixed response.+-- | A base @LLM@ interpreter that records every request's @(Model, Context,+-- Options)@ (the 'Context' so a test can assert the prompt and demo turns that+-- reached the wire) and returns a fixed response. runCapturingLLM :: (IOE :> es) =>- IORef [(Model, Options)] ->+ IORef [(Model, Context, Options)] -> Response -> Eff (LLM : es) a -> Eff es a runCapturingLLM ref resp = interpret $ \_ -> \case- Complete m _ o -> do- liftIO (modifyIORef' ref (++ [(m, o)]))+ Complete m ctx o -> do+ liftIO (atomicModifyIORef' ref (\xs -> (xs ++ [(m, ctx, o)], ()))) pure resp- Stream _ _ _ -> pure []+ Stream m ctx o -> do+ liftIO (atomicModifyIORef' ref (\xs -> (xs ++ [(m, ctx, o)], ())))+ -- A minimal successful stream whose terminal reassembles to @resp@, so a+ -- routed 'streamProgram' decodes exactly as the blocking path would.+ pure [EventDone (doneTerminal Nothing Stop (AssistantMessage (resp ^. #message)))] -- | Run a program sequentially under @routeLLM . runRouting model@ over a capturing -- stub and return the captured requests.-captureRouted :: Model -> Program Topic Outline -> Topic -> IO [(Model, Options)]+captureRouted :: Model -> Program Topic Outline -> Topic -> IO [(Model, Context, Options)] captureRouted model prog input = do ref <- newIORef [] res <-@@ -79,7 +116,7 @@ readIORef ref -- | As 'captureRouted' but under the concurrent executor.-captureRoutedConc :: Model -> Program Topic Outline -> Topic -> IO [(Model, Options)]+captureRoutedConc :: Model -> Program Topic Outline -> Topic -> IO [(Model, Context, Options)] captureRoutedConc model prog input = do ref <- newIORef [] res <-@@ -96,6 +133,14 @@ isRight :: Either a b -> Bool isRight = either (const False) (const True) +-- | The assistant-turn texts of a captured 'Context', in order.+assistantTexts :: Context -> [Text]+assistantTexts ctx =+ [ t+ | AssistantMessage p <- V.toList (ctx ^. #messages),+ AssistantText (TextContent t) <- V.toList (p ^. #content)+ ]+ -- --------------------------------------------------------------------------- -- M1 — the ambient model id reaches the wire -- ---------------------------------------------------------------------------@@ -104,7 +149,7 @@ routesModelId = testCase "routes the ambient model id onto the wire" $ do captured <- captureRouted openai_gpt_4o_mini (predict topicToOutline) (Topic "cats")- map (^. #modelId) (map fst captured) @?= [openai_gpt_4o_mini ^. #modelId]+ map (\(m, _, _) -> m ^. #modelId) captured @?= [openai_gpt_4o_mini ^. #modelId] -- --------------------------------------------------------------------------- -- M2 — native responseFormat on the wire; fallback leaves it unset@@ -115,7 +160,7 @@ testCase "native model attaches responseFormat with the derived schema" $ do captured <- captureRouted openai_gpt_4o_mini (predict topicToOutline) (Topic "cats") case captured of- [(_, o)] -> do+ [(_, _, o)] -> do o ^. #responseFormat @?= Just (JsonSchema {name = "output", schema = deriveSchema @Outline, strict = True}) assertBool@@ -128,7 +173,7 @@ testCase "fallback model leaves responseFormat unset" $ do captured <- captureRouted _Model (predict topicToOutline) (Topic "cats") case captured of- [(_, o)] -> do+ [(_, _, o)] -> do o ^. #responseFormat @?= Nothing assertBool "private schema key stripped before transport"@@ -136,11 +181,102 @@ other -> assertBool ("expected exactly one request, got " <> show (length other)) False -- ---------------------------------------------------------------------------+-- EP-33 — native render channel: the native prompt and JSON demos reach the wire+-- for native-capable models; fallback models keep the marker prompt; stamps stripped+-- ---------------------------------------------------------------------------++nativeReceivesNativeGuide :: TestTree+nativeReceivesNativeGuide =+ testCase "native model receives the native output guide, not the marker guide" $ do+ captured <- captureRouted openai_gpt_4o_mini (predict topicToOutline) (Topic "cats")+ case captured of+ [(_, ctx, _)] -> do+ let sys = maybe "" id (ctx ^. #systemPrompt)+ assertBool+ "system prompt contains the native JSON guide"+ ("Reply with a JSON object containing these fields:" `T.isInfixOf` sys)+ assertBool+ "system prompt carries no marker sections"+ (not ("[[ ##" `T.isInfixOf` sys))+ other -> assertBool ("expected exactly one request, got " <> show (length other)) False++nativeReceivesJsonDemos :: TestTree+nativeReceivesJsonDemos =+ testCase "native model receives demo assistant turns as JSON objects" $ do+ -- Demos must be supplied through the node's Params channel — 'effectiveSignature'+ -- overwrites any signature-level demos with the Params ones. Stored as JSON and+ -- decoded back into typed Topic/Outline demos before rendering.+ let demo =+ Demo+ (object ["subject" .= ("dogs" :: Text)])+ (object ["points" .= (["one", "two"] :: [Text])])+ node = Predict topicToOutline (Params Nothing [demo])+ captured <- captureRouted openai_gpt_4o_mini node (Topic "cats")+ case captured of+ [(_, ctx, _)] -> case assistantTexts ctx of+ (demoText : _) -> do+ assertBool+ "demo turn carries no marker sections"+ (not ("[[ ##" `T.isInfixOf` demoText))+ case eitherDecodeStrict (encodeUtf8 demoText) of+ Right (Object o) ->+ assertBool "demo JSON object carries the points field" (KM.member "points" o)+ other -> assertBool ("demo turn is not a JSON object: " <> show other) False+ [] -> assertBool "expected a demo assistant turn on the wire" False+ other -> assertBool ("expected exactly one request, got " <> show (length other)) False++fallbackPromptUnchangedAndStampsStripped :: TestTree+fallbackPromptUnchangedAndStampsStripped =+ testCase "fallback model keeps the marker prompt and native stamps are stripped" $ do+ captured <- captureRouted _Model (predict topicToOutline) (Topic "cats")+ case captured of+ [(_, ctx, o)] -> do+ let sys = maybe "" id (ctx ^. #systemPrompt)+ assertBool+ "system prompt keeps the marker guide"+ ("Reply using these sections" `T.isInfixOf` sys)+ o ^. #responseFormat @?= Nothing+ assertBool+ "native prompt key stripped before transport"+ (Map.notMember metaNativePromptKey (o ^. #metadata))+ assertBool+ "native demos key stripped before transport"+ (Map.notMember metaNativeDemosKey (o ^. #metadata))+ other -> assertBool ("expected exactly one request, got " <> show (length other)) False++-- ---------------------------------------------------------------------------+-- EP-34 — the Stream operation is routed exactly like Complete+-- ---------------------------------------------------------------------------++routesStreamModelAndStripsMetadata :: TestTree+routesStreamModelAndStripsMetadata =+ testCase "routes the ambient model and strips metadata on Stream" $ do+ ref <- newIORef []+ res <-+ runEff+ . runErrorNoCallStack @ShikumiError+ . runRouting openai_gpt_4o_mini+ . runCapturingLLM ref outlineResponse+ . routeLLM+ $ streamProgram (predict topicToOutline) (Topic "cats") (\_ -> pure ())+ assertBool "routed streaming program decodes without error" (isRight res)+ captured <- readIORef ref+ case captured of+ [(m, _, o)] -> do+ m ^. #modelId @?= openai_gpt_4o_mini ^. #modelId+ o ^. #responseFormat+ @?= Just (JsonSchema {name = "output", schema = deriveSchema @Outline, strict = True})+ assertBool+ "private schema key stripped before transport"+ (Map.notMember metaResponseSchemaKey (o ^. #metadata))+ other -> assertBool ("expected exactly one Stream request, got " <> show (length other)) False++-- --------------------------------------------------------------------------- -- M3 — per-sample temperature from MajorityVote's TempSchedule -- --------------------------------------------------------------------------- -capturedTemps :: [(Model, Options)] -> [Double]-capturedTemps = mapMaybe (\(_, o) -> o ^. #temperature)+capturedTemps :: [(Model, Context, Options)] -> [Double]+capturedTemps = mapMaybe (\(_, _, o) -> o ^. #temperature) spreadSetsDistinctTemps :: TestTree spreadSetsDistinctTemps =@@ -153,7 +289,23 @@ map round3 (sort temps) @?= [0.1, 0.5, 0.9] assertBool "private temperature key stripped before transport"- (all (\(_, o) -> Map.notMember metaTemperatureKey (o ^. #metadata)) captured)+ (all (\(_, _, o) -> Map.notMember metaTemperatureKey (o ^. #metadata)) captured)++majorityVoteBySetsDistinctTemps :: TestTree+majorityVoteBySetsDistinctTemps =+ testCase "majorityVoteBy applies its TempSchedule per sample (EP-35)" $ do+ -- Before EP-35 majorityVoteBy ignored its schedule (defined via Ensemble), so+ -- zero temperatures reached the wire. The reducer is irrelevant here (we assert+ -- on captured temperatures); pickFirst is any total [o] -> o.+ let pickFirst = NE.head . NE.fromList+ captured <-+ captureRouted+ openai_gpt_4o_mini+ (majorityVoteBy 3 (TempSpread 0.5 0.4) pickFirst (predict topicToOutline))+ (Topic "cats")+ let temps = capturedTemps captured+ length temps @?= 3+ map round3 (sort temps) @?= [0.1, 0.5, 0.9] fixedSetsExactTemps :: TestTree fixedSetsExactTemps =
test/SchemaSpec.hs view
@@ -15,6 +15,12 @@ import Test.Tasty.HUnit (assertFailure, testCase, (@?=)) -- | The schema we expect @deriveSchema \@Summary@ to produce.+--+-- Pinned to the OpenAI strict-mode shape (EP-33): the @sentiment@ enum carries an+-- explicit @"type": "string"@, and the nullable @note@ appears in @required@+-- (strict mode expresses optionality as required-but-nullable, not by omission).+-- The pre-EP-33 golden pinned the strict-mode-violating shape; this update is+-- deliberate, not a regression. expectedSummarySchema :: Value expectedSummarySchema = object@@ -37,10 +43,10 @@ "required" .= ["name" :: Text], "additionalProperties" .= False ],- "sentiment" .= object ["enum" .= (["Positive", "Neutral", "Negative"] :: [Text])],+ "sentiment" .= object ["type" .= s "string", "enum" .= (["Positive", "Neutral", "Negative"] :: [Text])], "note" .= object ["anyOf" .= [object ["type" .= s "string"], object ["type" .= s "null"]]] ],- "required" .= (["headline", "bullets", "author", "sentiment"] :: [Text]),+ "required" .= (["headline", "bullets", "author", "sentiment", "note"] :: [Text]), "additionalProperties" .= False ] where
test/StreamSpec.hs view
@@ -36,10 +36,10 @@ import Effectful.Dispatch.Dynamic (interpret) import Effectful.Error.Static (runErrorNoCallStack) import GHC.Generics (Generic)-import ProgramFixtures (Draft (..), Topic (..), markerBody, outlineToDraft, topicToOutline)+import ProgramFixtures (Draft (..), Topic (..), markerBody, outlineToDraft, topicToOutline, topicToVerdict) import Shikumi.Adapter (ToPrompt, responseText) import Shikumi.Combinator ((>>>))-import Shikumi.Error (ShikumiError)+import Shikumi.Error (ShikumiError (..)) import Shikumi.LLM (LLM (..)) import Shikumi.Module (predict) import Shikumi.Program (Program, runProgram)@@ -117,12 +117,12 @@ -- the value streaming incrementally, the terminal carries the whole structured reply. streamEventsFor :: [Text] -> Text -> [AssistantMessageEvent] streamEventsFor deltas terminalText =- [ EventStart (StartPayload (AssistantMessage (_Response ^. #message))),+ [ EventStart (StartPayload (AssistantMessage (_Response ^. #message)) Nothing), TextStart (IndexPayload 0) ] ++ [TextDelta (DeltaPayload 0 d) | d <- deltas] ++ [ TextEnd (BlockEndPayload 0 (T.concat deltas)),- EventDone (doneTerminal Stop (AssistantMessage (payloadWith terminalText)))+ EventDone (doneTerminal Nothing Stop (AssistantMessage (payloadWith terminalText))) ] where payloadWith t = (_Response ^. #message) & #content .~ V.singleton (AssistantText (_TextContent & #text .~ t))@@ -167,6 +167,32 @@ out @?= Right (Answer "Hello"), testCase "M2: streamProgram returns the same value as runProgram" $ do let script = [streamEventsFor ["Hel", "lo"] (markerBody [("answer", "Hello")])]+ ref1 <- newIORef script+ streamed <-+ runEff . runErrorNoCallStack @ShikumiError . runStreamingLLM ref1 $+ streamProgram (predict qToAnswer) (Question "q?") (\_ -> pure ())+ ref2 <- newIORef script+ blocking <-+ runEff . runErrorNoCallStack @ShikumiError . runStreamingLLM ref2 $+ runProgram (predict qToAnswer) (Question "q?")+ streamed @?= blocking,+ testCase "EP-32: a failing Validatable rule surfaces through streamProgram" $ do+ ref <- newIORef [streamEventsFor ["99"] (markerBody [("score", "99")])]+ out <-+ runEff . runErrorNoCallStack @ShikumiError . runStreamingLLM ref $+ streamProgram (predict topicToVerdict) (Topic "haskell") (\_ -> pure ())+ out @?= Left (ValidationFailure "score: must be at most 10"),+ testCase "EP-34: streamPredict decodes a native-shaped (JSON) terminal via parseResponse" $ do+ -- The terminal body is a JSON object (the native wire shape). Before the+ -- shared parseResponse, the fallback-only parser found no markers and+ -- reported MissingField; now the JSON body decodes correctly.+ ref <- newIORef [streamEventsFor ["{\"ans"] "{\"answer\": \"Hello\"}"]+ out <-+ runEff . runErrorNoCallStack @ShikumiError . runStreamingLLM ref $+ streamProgram (predict qToAnswer) (Question "q?") (\_ -> pure ())+ out @?= Right (Answer "Hello"),+ testCase "EP-34: streamProgram equals runProgram on a JSON-shaped script" $ do+ let script = [streamEventsFor ["{\"ans"] "{\"answer\": \"Hello\"}"] ref1 <- newIORef script streamed <- runEff . runErrorNoCallStack @ShikumiError . runStreamingLLM ref1 $
test/StubProvider.hs view
@@ -13,13 +13,16 @@ flattenAssistantText, stubRegistry, costStubRegistry,+ budgetBarrierStubRegistry, failingStubRegistry,+ failingStreamStubRegistry,+ failingStreamCostStubRegistry, invalidStubRegistry, concurrencyStubRegistry, ) where -import Baikai+import Baikai hiding (flattenAssistantText) import Baikai.Prelude import Control.Concurrent (threadDelay) import Control.Concurrent.STM@@ -27,6 +30,7 @@ atomically, modifyTVar', readTVar,+ retry, ) import Control.Exception (bracket_, throwIO) import Data.Generics.Labels ()@@ -36,8 +40,9 @@ import Streamly.Data.Stream qualified as Stream -- | Concatenate the text of every 'AssistantText' block, ignoring thinking and--- tool-call blocks. baikai has no library equivalent (its own smoke tests define--- this same helper locally).+-- tool-call blocks. baikai 0.3 exports its own 'flattenAssistantText'; this stub+-- keeps a local copy (hidden from the @Baikai@ import) so the fixture's behavior+-- is pinned regardless of the library's. flattenAssistantText :: V.Vector AssistantContent -> Text flattenAssistantText = T.concat . V.toList . V.mapMaybe textOf where@@ -92,11 +97,11 @@ -- | A deterministic, valid event sequence for the given text. stubEvents :: Text -> [AssistantMessageEvent] stubEvents t =- [ EventStart StartPayload {partial = AssistantMessage (_Response ^. #message)},+ [ EventStart StartPayload {partial = AssistantMessage (_Response ^. #message), responseId = Nothing}, TextStart IndexPayload {contentIndex = 0}, TextDelta DeltaPayload {contentIndex = 0, delta = t}, TextEnd BlockEndPayload {contentIndex = 0, content = t},- EventDone (doneTerminal Stop (AssistantMessage (stubPayloadWith t)))+ EventDone (doneTerminal Nothing Stop (AssistantMessage (stubPayloadWith t))) ] -- | Build an isolated registry from a @complete@ implementation, reusing the@@ -123,6 +128,20 @@ costStubRegistry c t = mkRegistry t (\_ _ _ -> pure (stubResponse t & #message . #usage . #cost . #usd .~ c)) +-- | A registry whose @complete@ blocks until @n@ calls have all arrived (a shared+-- 'TVar' barrier), then returns a cost-carrying response. Guarantees that @n@+-- concurrent calls are all in flight — each already past the budget's optimistic+-- @admitCall@ gate — before any of them records its cost, so a test can pin the+-- documented budget overshoot under concurrency.+budgetBarrierStubRegistry :: TVar Int -> Int -> Rational -> Text -> IO ProviderRegistry+budgetBarrierStubRegistry arrived n cost t =+ mkRegistry t $ \_ _ _ -> do+ atomically (modifyTVar' arrived (+ 1))+ atomically $ do+ a <- readTVar arrived+ if a >= n then pure () else retry+ pure (stubResponse t & #message . #usage . #cost . #usd .~ cost)+ -- | A registry whose @complete@ throws 'providerError' (a transient failure) the -- first @failTimes@ calls, then returns the given text. The 'IORef' records the -- total number of attempts (used by the retry tests).@@ -133,6 +152,61 @@ if n <= failTimes then throwIO (providerError ("stub transient failure #" <> T.pack (show n))) else pure (stubResponse t)++-- | A terminal-failing event sequence: an 'EventError' whose assembled message+-- carries @errorMessage@ (and optionally a dollar cost). Shikumi's @LLM@+-- interpreters map this to a transient 'Shikumi.Error.ProviderFailure'.+streamErrorEvents :: Rational -> Text -> [AssistantMessageEvent]+streamErrorEvents cost msg =+ [ EventStart StartPayload {partial = AssistantMessage (_Response ^. #message), responseId = Nothing},+ EventError (doneTerminal Nothing ErrorReason (AssistantMessage errPayload))+ ]+ where+ errPayload =+ (_Response ^. #message)+ & #errorMessage+ .~ Just msg+ & #usage+ . #cost+ . #usd+ .~ cost++-- | A registry whose /stream/ fails (a terminal 'EventError') the first+-- @failTimes@ calls, then streams success. @complete@ is irrelevant (stream-only+-- tests). The 'IORef' records the total number of stream attempts, so a retry test+-- can assert the loop fired.+failingStreamStubRegistry :: IORef Int -> Int -> Text -> IO ProviderRegistry+failingStreamStubRegistry ref failTimes t = do+ 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+ }+ pure reg++-- | A registry whose /stream/ always fails with a terminal 'EventError' carrying+-- the given dollar cost, so a test can assert the budget is charged even though the+-- stream failed.+failingStreamCostStubRegistry :: Rational -> IO ProviderRegistry+failingStreamCostStubRegistry cost = do+ reg <- newProviderRegistry+ registerApiProviderWith+ reg+ ApiProvider+ { apiTag = stubApi,+ complete = \_ _ _ -> pure (stubResponse ""),+ stream = \_ _ _ -> Stream.fromList (streamErrorEvents cost "stub stream failure")+ }+ pure reg -- | A registry whose @complete@ always throws 'invalidRequest' (a non-transient -- failure that maps to 'Shikumi.Error.SchemaMismatch'). The 'IORef' records the