packages feed

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 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