shikumi 0.4.0.0 → 0.4.1.0
raw patch · 7 files changed
+496/−73 lines, 7 filesdep ~baikaidep ~baikai-claudedep ~baikai-openaiPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: baikai, baikai-claude, baikai-openai, effectful, shikumi
API changes (from Hackage documentation)
Files
- CHANGELOG.md +9/−1
- shikumi.cabal +72/−61
- src/Shikumi/Adapter.hs +111/−11
- test/AdapterSpec.hs +10/−0
- test/CliSchemaSpec.hs +193/−0
- test/FallbackGuideSpec.hs +97/−0
- test/Main.hs +4/−0
CHANGELOG.md view
@@ -1,6 +1,14 @@ # Changelog -## Unreleased+## 0.4.1.0 — 2026-09-30++- Route subscription-CLI models through the native schema adapter. `capabilityFor` now starts from Baikai's `declaredStructuredOutput` for the model's `api`: `AnthropicMessagesCli` (`claude -p --json-schema`) and `OpenAICompletionsCli` (`codex exec --output-schema`) are `NativeSchema`, so their requests carry the strict derived schema and a list-of-records output decodes. First-party HTTP routing is unchanged; third-party hosts over a first-party wire format (`deepseek`, `openrouter` over Chat Completions) and `Custom` hosts stay `PromptFallback`. Previously cached CLI responses miss once, because the request now carries a `responseFormat` and the native prompt. Implements `mori://shinzui/shikumi/okf/improvement-requests/concepts/IR-4`.++- Show the JSON shape of every object or array output field in the fallback guide: a `JSON shape:` line under the field's marker lists nested keys (in `required` order) and closed enum values. Scalar-only fallback prompts are byte-for-byte unchanged.++- Raise the dependencies on `mori://shinzui/baikai/packages/baikai` to `>=0.7.2.0 && <0.8`, and on `mori://shinzui/baikai/packages/baikai-claude` and `mori://shinzui/baikai/packages/baikai-openai` to `>=0.7.1.0 && <0.8`. Older provider packages ignore `responseFormat` on the CLI transports, which would drop the marker fallback without gaining enforcement.++- Move the dependency on `mori://shinzui/baikai/packages/baikai` to `>=0.7.1.0 && <0.8` and on `mori://shinzui/baikai/packages/baikai-effectful` to `>=0.4.0.1 && <0.5`, and widen the `effectful` bound to `>=2.6 && <2.8`. Both effectful 2.6 and 2.7 are supported: `baikai-effectful` 0.4.0.1 requires `effectful-core` 2.6 and 0.4.0.2 requires 2.7, so the solver pairs them. Bounds only; no source changed. ## 0.4.0.0 — 2026-09-08
shikumi.cabal view
@@ -1,27 +1,33 @@-cabal-version: 3.4-name: shikumi-version: 0.4.0.0-synopsis: Typed, structured, evaluable LM programs over baikai-category: AI+cabal-version: 3.4+name: shikumi+version: 0.4.1.0+synopsis: Typed, structured, evaluable LM programs over baikai+category: AI description: Shikumi is a Haskell-native framework for building typed language-model programs. This package provides the runtime substrate: the LLM effect over baikai, the shikumi error type, and resilience (retries, rate limiting, budget control). -license: BSD-3-Clause-author: Nadeem Bitar-maintainer: nadeem@gmail.com-build-type: Simple+license: BSD-3-Clause+author: Nadeem Bitar+maintainer: nadeem@gmail.com+build-type: Simple extra-doc-files: CHANGELOG.md common common-options ghc-options:- -Wall -Wcompat -Widentities -Wincomplete-uni-patterns- -Wincomplete-record-updates -Wredundant-constraints- -fhide-source-paths -Wmissing-export-lists -Wpartial-fields+ -Wall+ -Wcompat+ -Widentities+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -Wredundant-constraints+ -fhide-source-paths+ -Wmissing-export-lists+ -Wpartial-fields -Wmissing-deriving-strategies - default-language: GHC2024+ default-language: GHC2024 default-extensions: DeriveAnyClass DuplicateRecordFields@@ -29,8 +35,8 @@ OverloadedStrings library- import: common-options- hs-source-dirs: src+ import: common-options+ hs-source-dirs: src exposed-modules: Shikumi.Adapter Shikumi.Combinator@@ -54,43 +60,48 @@ Shikumi.Signature Shikumi.Stream - other-modules: Shikumi.Adapter.Xml+ other-modules: Shikumi.Adapter.Xml build-depends:- , aeson >=2.2 && <2.3- , baikai >=0.7.0.0 && <0.8- , baikai-claude >=0.7.0.0 && <0.8- , baikai-effectful >=0.4.0.1 && <0.5- , baikai-openai >=0.7.0.0 && <0.8- , base >=4.20 && <5- , base64-bytestring >=1.2 && <1.3- , bytestring >=0.11 && <0.13- , containers >=0.6 && <0.9- , effectful >=2.5 && <2.7- , filepath >=1.4 && <1.6- , generic-lens >=2.2 && <2.4- , lens ^>=5.3- , scientific >=0.3 && <0.4- , stm >=2.5 && <2.6- , text ^>=2.1- , time >=1.12 && <1.17- , vector >=0.13 && <0.14+ aeson >=2.2 && <2.3,+ baikai >=0.7.2.0 && <0.8,+ baikai-claude >=0.7.1.0 && <0.8,+ baikai-effectful >=0.4.0.1 && <0.5,+ baikai-openai >=0.7.1.0 && <0.8,+ base >=4.20 && <5,+ base64-bytestring >=1.2 && <1.3,+ bytestring >=0.11 && <0.13,+ containers >=0.6 && <0.9,+ effectful >=2.6 && <2.8,+ filepath >=1.4 && <1.6,+ generic-lens >=2.2 && <2.4,+ lens ^>=5.3,+ scientific >=0.3 && <0.4,+ stm >=2.5 && <2.6,+ text ^>=2.1,+ time >=1.12 && <1.17,+ vector >=0.13 && <0.14, test-suite shikumi-test- import: common-options- type: exitcode-stdio-1.0+ import: common-options+ type: exitcode-stdio-1.0 hs-source-dirs: test- main-is: Main.hs- ghc-options: -threaded -with-rtsopts=-N+ main-is: Main.hs+ ghc-options:+ -threaded+ -with-rtsopts=-N+ other-modules: AdapterSpec+ CliSchemaSpec CombinatorSpec ConstraintSpec ContinuationSpec EndToEndSpec ErrorSpec+ FallbackGuideSpec Fixtures- LiveSpec LLMSpec+ LiveSpec ModuleSpec MultimodalAdapterSpec MultimodalEndToEndSpec@@ -115,25 +126,25 @@ XmlAdapterSpec build-depends:- , aeson- , baikai >=0.7.0.0 && <0.8- , baikai-claude >=0.7.0.0 && <0.8- , baikai-effectful >=0.4.0.1 && <0.5- , baikai-openai >=0.7.0.0 && <0.8- , base- , base64-bytestring- , bytestring- , containers- , directory- , effectful- , generic-lens- , lens- , QuickCheck- , shikumi ^>=0.4.0.0- , stm- , streamly-core- , tasty- , tasty-hunit- , tasty-quickcheck- , text- , vector+ QuickCheck,+ aeson,+ baikai >=0.7.2.0 && <0.8,+ baikai-claude >=0.7.1.0 && <0.8,+ baikai-effectful >=0.4.0.1 && <0.5,+ baikai-openai >=0.7.1.0 && <0.8,+ base,+ base64-bytestring,+ bytestring,+ containers,+ directory,+ effectful,+ generic-lens,+ lens,+ shikumi ^>=0.4.1.0,+ stm,+ streamly-core,+ tasty,+ tasty-hunit,+ tasty-quickcheck,+ text,+ vector,
src/Shikumi/Adapter.hs view
@@ -10,7 +10,9 @@ -- -- The native-schema adapter uses provider-enforced JSON; the prompt-based fallback -- renders @[[ ## field ## ]]@ sections for models without native structured output.--- 'capabilityFor' selects between them per model. Two opt-in XML adapters share+-- 'capabilityFor' selects between them per model from baikai's declared+-- structured-output support: first-party HTTP hosts and the subscription CLIs+-- (@claude@, @codex@) are native; third-party and @Custom@ hosts fall back. Two opt-in XML adapters share -- bounded nested decoding and offer legacy or structured demonstration rendering. -- -- Native structured output is wired through a private /metadata channel/ (EP-14).@@ -70,8 +72,10 @@ Model, Options, Response,+ StructuredOutputSupport (..), TextContent (..), assistant,+ declaredStructuredOutput, emptyContext, emptyOptions, flattenAssistantBlocks,@@ -86,8 +90,10 @@ import Data.ByteString.Lazy qualified as LBS import Data.Generics.Labels () import Data.Kind (Type)+import Data.List (sortOn) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Text qualified as T import Data.Text.Encoding (decodeUtf8, encodeUtf8)@@ -184,15 +190,43 @@ data ModelCapability = NativeSchema | PromptFallback deriving stock (Eq, Show) --- | A pure capability check over a baikai 'Model'. OpenAI/Anthropic on their--- non-CLI APIs are native-capable; CLI APIs and unknown @Custom@ hosts use the--- fallback. Refine as more models gain native support.+-- | A pure capability check over a baikai 'Model', derived from baikai's+-- per-transport declaration ('declaredStructuredOutput').+--+-- A model is 'NativeSchema' when baikai declares 'NativeJsonSchema' for its+-- @api@ and either:+--+-- * the @api@ is a subscription CLI tag ('AnthropicMessagesCli' for @claude -p+-- --json-schema@, 'OpenAICompletionsCli' for @codex exec --output-schema@) —+-- such a tag is always served by baikai's own CLI provider, so baikai's+-- declaration is authoritative; or+-- * the @(provider, api)@ pair is a first-party HTTP host: @openai@ over Chat+-- Completions or Responses, or @anthropic@ over Messages.+--+-- Third-party hosts speaking a first-party wire format (for example @deepseek@+-- or @openrouter@ over 'OpenAIChatCompletions') stay 'PromptFallback': baikai+-- forwards the schema, but cannot know whether such a host enforces it.+-- @Custom@ transports are 'NoStructuredOutput' in baikai's table and therefore+-- always 'PromptFallback'.+--+-- This answers schema enforcement only. Provider-native /tool calling/ is a+-- separate capability (baikai's CLI providers enforce schemas but drop tools);+-- see "Shikumi.Agent.ReAct". capabilityFor :: Model -> ModelCapability-capabilityFor m = case (m ^. #provider, m ^. #api) of- ("openai", OpenAIChatCompletions) -> NativeSchema- ("openai", OpenAIResponses) -> NativeSchema- ("anthropic", AnthropicMessages) -> NativeSchema- _ -> PromptFallback+capabilityFor m = case declaredStructuredOutput api of+ NoStructuredOutput -> PromptFallback+ NativeJsonSchema+ | cliTransport || firstPartyApi -> NativeSchema+ | otherwise -> PromptFallback+ where+ api = m ^. #api+ cliTransport = api `elem` [AnthropicMessagesCli, OpenAICompletionsCli]+ firstPartyApi =+ (m ^. #provider, api)+ `elem` [ ("openai", OpenAIChatCompletions),+ ("openai", OpenAIResponses),+ ("anthropic", AnthropicMessages)+ ] -- | Select the adapter for a model from its capability. adapterFor ::@@ -393,11 +427,77 @@ -- | A fallback-output guide: ask for one @[[ ## field ## ]]@ section per output -- field, then a final @[[ ## completed ## ]]@ marker (DSPy's convention).-fallbackOutputGuide :: Signature i o -> Text+--+-- A field whose derived schema (ignoring nullability) is an object or an array+-- gets one further @JSON shape: …@ line ('renderShape'), so a model without+-- schema enforcement still sees nested keys and closed enum values. Scalar+-- fields, including top-level enums, render exactly as before.+fallbackOutputGuide :: forall i o. (ToSchema o) => Signature i o -> Text fallbackOutputGuide sig = "Reply using these sections, each marker on its own line:\n"- <> T.unlines [marker (fieldName f) <> describeSuffix f | f <- outputFields sig]+ <> T.unlines (concat [fieldLines f | f <- outputFields sig]) <> marker "completed"+ where+ schema = deriveSchema @o+ fieldLines f =+ (marker (fieldName f) <> describeSuffix f)+ : [ "JSON shape: " <> renderShape s+ | Just s <- [propertySchema (fieldName f) schema],+ isStructured s+ ]+ isStructured s = case KM.lookup "type" =<< objectOf (stripNullable s) of+ Just (String t) -> t == "object" || t == "array"+ _ -> False++-- | The schema of one top-level property of a derived object schema.+propertySchema :: Text -> Value -> Maybe Value+propertySchema name schema =+ KM.lookup (Key.fromText name) =<< objectOf =<< KM.lookup "properties" =<< objectOf schema++objectOf :: Value -> Maybe Object+objectOf (Object o) = Just o+objectOf _ = Nothing++-- | Strip a nullable @anyOf [s, {"type":"null"}]@ wrapper, if present.+stripNullable :: Value -> Value+stripNullable v = fromMaybe v (nullableInner v)++-- | The inner schema of a nullable @anyOf [s, {"type":"null"}]@ wrapper.+nullableInner :: Value -> Maybe Value+nullableInner (Object o)+ | Just (Array alts) <- KM.lookup "anyOf" o,+ [s, Object n] <- V.toList alts,+ KM.lookup "type" n == Just (String "null") =+ Just s+nullableInner _ = Nothing++-- | A compact, JSON-like rendering of a derived schema for the fallback guide:+-- scalars by type name, string enums as their quoted values joined by @|@,+-- arrays as @[<item>, ...]@, objects as @{"k": <shape>, …}@ (keys in @required@+-- order, any others sorted after), and nullable values as @<shape> | null@.+renderShape :: Value -> Text+renderShape v = case nullableInner v of+ Just s -> renderShape s <> " | null"+ Nothing -> case objectOf v of+ Nothing -> anyValue+ Just o -> case KM.lookup "enum" o of+ Just (Array vs) | not (V.null vs) -> T.intercalate " | " (map jsonText (V.toList vs))+ _ -> case KM.lookup "type" o of+ Just (String "array") -> "[" <> maybe anyValue renderShape (KM.lookup "items" o) <> ", ...]"+ Just (String "object") -> renderObject o+ Just (String t) | t `elem` ["string", "integer", "number", "boolean"] -> t+ _ -> anyValue+ where+ anyValue = "any JSON value"+ jsonText x = decodeUtf8 (LBS.toStrict (Aeson.encode x))+ renderObject o =+ let props = fromMaybe KM.empty (objectOf =<< KM.lookup "properties" o)+ required = case KM.lookup "required" o of+ Just (Array rs) -> [k | String r <- V.toList rs, let k = Key.fromText r, KM.member k props]+ _ -> []+ others = sortOn Key.toText [k | k <- KM.keys props, k `notElem` required]+ entry k = jsonText (String (Key.toText k)) <> ": " <> maybe anyValue renderShape (KM.lookup k props)+ in "{" <> T.intercalate ", " (map entry (required <> others)) <> "}" describeField :: FieldMeta -> Text describeField f = "- " <> fieldName f <> maybe "" (": " <>) (fieldDesc f)
test/AdapterSpec.hs view
@@ -102,6 +102,16 @@ capabilityFor (emptyModel & #provider .~ "openai" & #api .~ OpenAIResponses) @?= NativeSchema, testCase "capabilityFor: Custom (ollama) host -> PromptFallback" $ capabilityFor ollamaModel @?= PromptFallback,+ testCase "capabilityFor: claude CLI -> NativeSchema" $+ capabilityFor (emptyModel & #provider .~ "claude-cli" & #api .~ AnthropicMessagesCli) @?= NativeSchema,+ testCase "capabilityFor: codex CLI -> NativeSchema" $+ capabilityFor (emptyModel & #provider .~ "codex-cli" & #api .~ OpenAICompletionsCli) @?= NativeSchema,+ testCase "capabilityFor: deepseek over Chat Completions -> PromptFallback" $+ capabilityFor (emptyModel & #provider .~ "deepseek" & #api .~ OpenAIChatCompletions) @?= PromptFallback,+ testCase "capabilityFor: openrouter over Chat Completions -> PromptFallback" $+ capabilityFor (emptyModel & #provider .~ "openrouter" & #api .~ OpenAIChatCompletions) @?= PromptFallback,+ testCase "capabilityFor: OpenAI Chat Completions -> NativeSchema" $+ capabilityFor (emptyModel & #provider .~ "openai" & #api .~ OpenAIChatCompletions) @?= NativeSchema, testCase "fallback render: system prompt has the instruction and field markers" $ do T.isInfixOf "Summarize the article" (sysOf fallbackAdapter) @?= True T.isInfixOf "[[ ## headline ## ]]" (sysOf fallbackAdapter) @?= True,
+ test/CliSchemaSpec.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE DataKinds #-}++-- | EP-67: a typed program whose output is a list of records decodes through a+-- subscription-CLI provider that enforces the derived schema, and fails the way+-- Mina's @codex-cli@ judges did when the same provider sits under a fallback tag.+--+-- The scripted provider stands in for baikai's CLI providers: it returns+-- schema-conforming JSON only when the request carries a 'B.JsonSchema'+-- @responseFormat@ (what @claude -p --json-schema@ / @codex exec --output-schema@+-- enforce), and otherwise replies like an unconstrained model — marker sections+-- whose list-of-records field holds bare strings. Registering the identical+-- provider under a @Custom@ tag is the control: only the routing decision differs.+module CliSchemaSpec+ ( tests,+ Severity (..),+ Concern (..),+ Assessment (..),+ Proposal (..),+ )+where++import Baikai qualified as B+import Control.Lens ((&), (.~), (^.))+import Data.Aeson (Value)+import Data.Generics.Labels ()+import Data.IORef (IORef, modifyIORef', newIORef, readIORef)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Data.Vector qualified as V+import Effectful (runEff)+import Effectful.Error.Static (runErrorNoCallStack)+import GHC.Generics (Generic)+import Shikumi.Adapter (ToPrompt)+import Shikumi.Error (ShikumiError, renderShikumiError)+import Shikumi.LLM (runLLMWith)+import Shikumi.Program (Program (Predict), emptyParams, runProgram)+import Shikumi.Routing (routeLLM, runRouting)+import Shikumi.Schema (FromModel, ToSchema, Validatable, deriveSchema)+import Shikumi.Schema.Types (Field (..), field)+import Shikumi.Signature (Signature, mkSignature)+import Streamly.Data.Stream qualified as Stream+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertFailure, testCase, (@?=))++data Severity = Blocker | Major | Minor+ deriving stock (Generic, Show, Eq)++instance ToSchema Severity++instance FromModel Severity++data Concern = Concern+ { statement :: !(Field "What is wrong" Text),+ severity :: !Severity+ }+ deriving stock (Generic, Show, Eq)++instance ToSchema Concern++instance FromModel Concern++data Assessment = Assessment+ { concerns :: !(Field "Readiness concerns" [Concern]),+ verdict :: !(Field "Overall verdict" Text)+ }+ deriving stock (Generic, Show, Eq)++instance ToSchema Assessment++instance FromModel Assessment++instance ToPrompt Assessment++instance Validatable Assessment++newtype Proposal = Proposal {plan :: Field "The release plan to assess" Text}+ deriving stock (Generic, Show, Eq)++instance ToSchema Proposal++instance FromModel Proposal++instance ToPrompt Proposal++instance Validatable Proposal++assessSig :: Signature Proposal Assessment+assessSig = mkSignature "Assess whether the release plan is ready."++proposal :: Proposal+proposal = Proposal {plan = field "Ship on Friday."}++expectedAssessment :: Assessment+expectedAssessment =+ Assessment+ { concerns = field [Concern {statement = field "No rollback path", severity = Blocker}],+ verdict = field "not ready"+ }++-- | The reply a schema-enforcing CLI returns.+conformingJson :: Text+conformingJson =+ "{\"concerns\":[{\"statement\":\"No rollback path\",\"severity\":\"Blocker\"}],\"verdict\":\"not ready\"}"++-- | The reply an unconstrained model wrote in Mina: strings where records belong.+unconstrainedMarkers :: Text+unconstrainedMarkers =+ T.intercalate+ "\n"+ [ "[[ ## concerns ## ]]",+ "[\"No rollback path\"]",+ "[[ ## verdict ## ]]",+ "not ready",+ "[[ ## completed ## ]]"+ ]++textResponse :: B.Model -> Text -> B.Response+textResponse m t =+ B.emptyResponse+ & #message+ . #content+ .~ V.singleton (B.AssistantText (B.emptyTextContent & #text .~ t))+ & #model+ .~ m++-- | A registry whose single provider serves @api@ and enforces the schema only+-- when one is requested, recording every 'B.Options' it receives.+cliRegistry :: B.Api -> IO (B.ProviderRegistry, IORef [B.Options])+cliRegistry api = do+ seen <- newIORef []+ reg <- B.newProviderRegistry+ let reply m o = case o ^. #responseFormat of+ Just (B.JsonSchema _) -> textResponse m conformingJson+ _ -> textResponse m unconstrainedMarkers+ B.registerApiProviderWith+ reg+ ( B.apiProviderWith+ api+ (\_ _ _ -> Stream.nil)+ (\m _ o -> modifyIORef' seen (<> [o]) >> pure (reply m o))+ )+ { B.describeThinking = \_ _ -> B.noThinkingRequested+ }+ pure (reg, seen)++runOn :: B.Model -> B.ProviderRegistry -> IO (Either ShikumiError Assessment)+runOn model reg =+ runEff+ . runErrorNoCallStack @ShikumiError+ . runRouting model+ . runLLMWith reg+ . routeLLM+ $ runProgram (Predict assessSig emptyParams) proposal++schemaOf :: B.Options -> Maybe Value+schemaOf o = case o ^. #responseFormat of+ Just (B.JsonSchema fmt) -> Just (fmt ^. #schema)+ _ -> Nothing++tests :: TestTree+tests =+ testGroup+ "CliSchema"+ [ testCase "claude CLI model: routed with the strict derived schema and decodes a list of records" $ do+ let model = B.mkModel B.AnthropicMessagesCli "fixture" "https://example.invalid"+ (reg, seen) <- cliRegistry B.AnthropicMessagesCli+ result <- runOn model reg+ result @?= Right expectedAssessment+ recorded <- readIORef seen+ map (^. #responseFormat) recorded+ @?= [Just (B.JsonSchema (B.jsonSchemaFormat "output" (deriveSchema @Assessment) & #strict .~ True))]+ map schemaOf recorded @?= [Just (deriveSchema @Assessment)]+ -- Private shikumi metadata never reaches the transport.+ map (Map.keys . (^. #metadata)) recorded @?= [[]],+ testCase "codex CLI model: routed with the derived schema" $ do+ let model = B.mkModel B.OpenAICompletionsCli "fixture" "https://example.invalid"+ (reg, seen) <- cliRegistry B.OpenAICompletionsCli+ result <- runOn model reg+ result @?= Right expectedAssessment+ readIORef seen >>= (@?= [Just (deriveSchema @Assessment)]) . map schemaOf,+ testCase "same provider under a fallback tag: no schema, strings where records belong" $ do+ let api = B.Custom "no-schema"+ model = B.mkModel api "fixture" "https://example.invalid"+ (reg, seen) <- cliRegistry api+ result <- runOn model reg+ readIORef seen >>= (@?= [Nothing]) . map schemaOf+ case result of+ Left e+ | "expected object, got string" `T.isInfixOf` renderShikumiError e -> pure ()+ | otherwise -> assertFailure ("unexpected error: " <> T.unpack (renderShikumiError e))+ Right a -> assertFailure ("expected a decode failure, got " <> show a)+ ]
+ test/FallbackGuideSpec.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE DataKinds #-}++-- | EP-67 M3: the fallback adapter's output guide shows the JSON shape of every+-- structured (object or array) output field, while a scalar-only guide stays+-- byte-for-byte what it was before shapes were added. Each case pins the full+-- system prompt 'fallbackAdapter' renders.+module FallbackGuideSpec (tests) where++import Baikai (Context)+import CliSchemaSpec (Assessment, Proposal (..), Severity)+import Control.Lens ((^.))+import Data.Generics.Labels ()+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import Fixtures (Article, Summary, sampleArticle)+import GHC.Generics (Generic)+import Shikumi.Adapter (Adapter (..), ToPrompt, fallbackAdapter)+import Shikumi.Schema (FromModel, ToSchema, Validatable)+import Shikumi.Schema.Types (Field (..), field)+import Shikumi.Signature (Signature, mkSignature)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++-- | A scalar-only output: two text fields (one described) and an enum.+data Triage = Triage+ { label :: !(Field "Short label" Text),+ reason :: !Text,+ level :: !Severity+ }+ deriving stock (Generic, Show, Eq)++instance ToSchema Triage++instance FromModel Triage++instance ToPrompt Triage++instance Validatable Triage++systemOf :: Context -> Text+systemOf ctx = fromMaybe "" (ctx ^. #systemPrompt)++proposal :: Proposal+proposal = Proposal {plan = field "Ship on Friday."}++assessSystem :: Text+assessSystem =+ systemOf . fst $+ render+ fallbackAdapter+ (mkSignature "Assess whether the release plan is ready." :: Signature Proposal Assessment)+ proposal++triageSystem :: Text+triageSystem =+ systemOf . fst $+ render fallbackAdapter (mkSignature "Triage the plan." :: Signature Proposal Triage) proposal++summarySystem :: Text+summarySystem =+ systemOf . fst $+ render fallbackAdapter (mkSignature "Summarize the article" :: Signature Article Summary) sampleArticle++-- | Written by hand from the pre-EP-67 'fallbackOutputGuide' before it changed.+expectedTriage :: Text+expectedTriage =+ "Triage the plan.\n\n\+ \Reply using these sections, each marker on its own line:\n\+ \[[ ## label ## ]] -- Short label\n\+ \[[ ## reason ## ]]\n\+ \[[ ## level ## ]]\n\+ \[[ ## completed ## ]]"++expectedAssessment :: Text+expectedAssessment =+ "Assess whether the release plan is ready.\n\n\+ \Reply using these sections, each marker on its own line:\n\+ \[[ ## concerns ## ]] -- Readiness concerns\n\+ \JSON shape: [{\"statement\": string, \"severity\": \"Blocker\" | \"Major\" | \"Minor\"}, ...]\n\+ \[[ ## verdict ## ]] -- Overall verdict\n\+ \[[ ## completed ## ]]"++tests :: TestTree+tests =+ testGroup+ "FallbackGuide"+ [ testCase "scalar-only guide is unchanged" $+ triageSystem @?= expectedTriage,+ testCase "a list of records shows its nested keys and enum values" $+ assessSystem @?= expectedAssessment,+ testCase "Summary gains shape lines for bullets and author only" $+ filter ("JSON shape:" `T.isPrefixOf`) (T.lines summarySystem)+ @?= [ "JSON shape: [string, ...]",+ "JSON shape: {\"name\": string}"+ ]+ ]
test/Main.hs view
@@ -3,11 +3,13 @@ module Main (main) where import AdapterSpec qualified+import CliSchemaSpec qualified import CombinatorSpec qualified import ConstraintSpec qualified import ContinuationSpec qualified import EndToEndSpec qualified import ErrorSpec qualified+import FallbackGuideSpec qualified import LLMSpec qualified import LiveSpec qualified import ModuleSpec qualified@@ -42,6 +44,8 @@ SchemaSpec.tests, SignatureSpec.tests, AdapterSpec.tests,+ CliSchemaSpec.tests,+ FallbackGuideSpec.tests, EndToEndSpec.tests, LLMSpec.tests, ResilienceSpec.tests,