packages feed

shikumi 0.1.0.1 → 0.2.0.0

raw patch · 21 files changed

+243/−56 lines, 21 filesdep ~shikumiPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: shikumi

API changes (from Hackage documentation)

- Shikumi.Multimodal: [imageBytes] :: Image -> !ByteString
- Shikumi.Multimodal: [imageMime] :: Image -> !Text
+ Shikumi.Compaction: CompactionConfig :: !Natural -> !Int -> !Bool -> CompactionConfig
+ Shikumi.Compaction: [enabled] :: CompactionConfig -> !Bool
+ Shikumi.Compaction: [keepRecent] :: CompactionConfig -> !Int
+ Shikumi.Compaction: [reserveTokens] :: CompactionConfig -> !Natural
+ Shikumi.Compaction: compactTail :: forall (es :: [Effect]) a. (LLM :> es, Error ShikumiError :> es) => CompactionConfig -> Model -> (a -> Text) -> (Text -> a) -> [a] -> Eff es [a]
+ Shikumi.Compaction: data CompactionConfig
+ Shikumi.Compaction: defaultCompactionConfig :: CompactionConfig
+ Shikumi.Compaction: instance GHC.Classes.Eq Shikumi.Compaction.CompactionConfig
+ Shikumi.Compaction: instance GHC.Internal.Show.Show Shikumi.Compaction.CompactionConfig
+ Shikumi.Compaction: overflowThreshold :: CompactionConfig -> Model -> Natural
+ Shikumi.Compaction: usageExceedsWindow :: CompactionConfig -> Model -> Usage -> Bool
+ Shikumi.Error: ContextWindowExceeded :: !Text -> ShikumiError
+ Shikumi.Multimodal: [bytes] :: Image -> !ByteString
+ Shikumi.Multimodal: [mime] :: Image -> !Text
+ Shikumi.Program: nodeInstructionsIndexed :: Program i o -> [Text]
- Shikumi.Adapter: Adapter :: (Signature i o -> i -> (Context, Options)) -> (Signature i o -> Response -> Either ShikumiError o) -> Adapter i o
+ Shikumi.Adapter: Adapter :: !Signature i o -> i -> (Context, Options) -> !Signature i o -> Response -> Either ShikumiError o -> Adapter i o
- Shikumi.Adapter: [parse] :: Adapter i o -> Signature i o -> Response -> Either ShikumiError o
+ Shikumi.Adapter: [parse] :: Adapter i o -> !Signature i o -> Response -> Either ShikumiError o
- Shikumi.Adapter: [render] :: Adapter i o -> Signature i o -> i -> (Context, Options)
+ Shikumi.Adapter: [render] :: Adapter i o -> !Signature i o -> i -> (Context, Options)
- Shikumi.Refine: MultiChainInput :: i -> [WithReasoning o] -> MultiChainInput i o
+ Shikumi.Refine: MultiChainInput :: !i -> ![WithReasoning o] -> MultiChainInput i o
- Shikumi.Refine: [attempts] :: MultiChainInput i o -> [WithReasoning o]
+ Shikumi.Refine: [attempts] :: MultiChainInput i o -> ![WithReasoning o]
- Shikumi.Refine: [original] :: MultiChainInput i o -> i
+ Shikumi.Refine: [original] :: MultiChainInput i o -> !i
- Shikumi.Signature: Demo :: i -> o -> Demo i o
+ Shikumi.Signature: Demo :: !i -> !o -> Demo i o
- Shikumi.Signature: Signature :: Text -> [Demo i o] -> [FieldMeta] -> [FieldMeta] -> Signature i o
+ Shikumi.Signature: Signature :: !Text -> ![Demo i o] -> ![FieldMeta] -> ![FieldMeta] -> Signature i o
- Shikumi.Signature: [demos] :: Signature i o -> [Demo i o]
+ Shikumi.Signature: [demos] :: Signature i o -> ![Demo i o]
- Shikumi.Signature: [inputFields] :: Signature i o -> [FieldMeta]
+ Shikumi.Signature: [inputFields] :: Signature i o -> ![FieldMeta]
- Shikumi.Signature: [input] :: Demo i o -> i
+ Shikumi.Signature: [input] :: Demo i o -> !i
- Shikumi.Signature: [instruction] :: Signature i o -> Text
+ Shikumi.Signature: [instruction] :: Signature i o -> !Text
- Shikumi.Signature: [outputFields] :: Signature i o -> [FieldMeta]
+ Shikumi.Signature: [outputFields] :: Signature i o -> ![FieldMeta]
- Shikumi.Signature: [output] :: Demo i o -> o
+ Shikumi.Signature: [output] :: Demo i o -> !o

Files

CHANGELOG.md view
@@ -2,6 +2,21 @@  ## Unreleased +## 0.2.0.0 - 2026-06-28++### Added++- `Shikumi.Compaction`, with helpers for compacting older working context when a+  model approaches its context window.+- `Shikumi.Program.nodeInstructionsIndexed :: Program i o -> [Text]`: the signature+  instruction of each `Predict` node, in `foldParams`/`nodeFieldsIndexed` order. Used+  by `shikumi-okf` to document model calls (EP-31, Milestone 5).++### Changed++- `ShikumiError` now distinguishes provider context-window failures with the new+  `ContextWindowExceeded` constructor.+ ## 0.1.0.1 - 2026-06-21  ### Fixed
shikumi.cabal view
@@ -1,6 +1,6 @@ cabal-version:   3.4 name:            shikumi-version:         0.1.0.1+version:         0.2.0.0 synopsis:        Typed, structured, evaluable LM programs over baikai category:        AI description:@@ -34,6 +34,7 @@   exposed-modules:     Shikumi.Adapter     Shikumi.Combinator+    Shikumi.Compaction     Shikumi.Effect.Time     Shikumi.Error     Shikumi.LLM@@ -121,7 +122,7 @@     , generic-lens     , lens     , QuickCheck-    , shikumi            ^>=0.1.0.1+    , shikumi            ^>=0.2.0.0     , stm     , streamly-core     , tasty
src/Shikumi/Adapter.hs view
@@ -61,7 +61,7 @@     _Context,     _Options,   )-import Control.Lens ((&), (.~), (^.))+import Control.Lens (at, (&), (.~), (?~), (^.)) import Data.Aeson (Object, Value (..), eitherDecodeStrict, toJSON) import Data.Aeson.Key qualified as Key import Data.Aeson.KeyMap qualified as KM@@ -156,8 +156,8 @@  -- | A record of two functions: format a request, parse a response. data Adapter i o = Adapter-  { render :: Signature i o -> i -> (Context, Options),-    parse :: Signature i o -> Response -> Either ShikumiError o+  { render :: !(Signature i o -> i -> (Context, Options)),+    parse :: !(Signature i o -> Response -> Either ShikumiError o)   }  -- | Whether a model supports provider-native structured output.@@ -204,7 +204,7 @@ -- simply stripped.) attachSchema :: Value -> Options -> Options attachSchema schema opts =-  opts & #metadata .~ Map.insert metaResponseSchemaKey schema (opts ^. #metadata)+  opts & #metadata . at metaResponseSchemaKey ?~ schema  -- | Stamp a per-sample temperature onto a request's private metadata channel under -- 'metaTemperatureKey'. Used by 'Shikumi.Program.runProgram' to thread a@@ -212,7 +212,7 @@ -- the router turns it into @Options.temperature@. stampTemperature :: Double -> Options -> Options stampTemperature t opts =-  opts & #metadata .~ Map.insert metaTemperatureKey (toJSON t) (opts ^. #metadata)+  opts & #metadata . at metaTemperatureKey ?~ toJSON t  -- | The native-schema adapter. @render@ stamps the derived schema onto the request -- metadata channel (see 'attachSchema'); @parse@ reads the structured JSON from the
+ src/Shikumi/Compaction.hs view
@@ -0,0 +1,116 @@+-- | Helpers for shrinking an in-flight working context before it exceeds the+-- selected model's context window.+module Shikumi.Compaction+  ( CompactionConfig (..),+    defaultCompactionConfig,+    overflowThreshold,+    usageExceedsWindow,+    compactTail,+  )+where++import Baikai+  ( AssistantContent (..),+    Context,+    Model,+    Options,+    Response,+    TextContent (..),+    Usage,+    flattenAssistantBlocks,+    user,+    _Context,+    _Options,+  )+import Control.Lens ((&), (.~), (^.))+import Data.Generics.Labels ()+import Data.Text (Text)+import Data.Text qualified as T+import Data.Vector qualified as V+import Effectful (Eff, (:>))+import Effectful.Error.Static (Error, throwError)+import Numeric.Natural (Natural)+import Shikumi.Error (ShikumiError)+import Shikumi.LLM (LLM, complete)++data CompactionConfig = CompactionConfig+  { reserveTokens :: !Natural,+    keepRecent :: !Int,+    enabled :: !Bool+  }+  deriving stock (Eq, Show)++defaultCompactionConfig :: CompactionConfig+defaultCompactionConfig =+  CompactionConfig+    { reserveTokens = 16384,+      keepRecent = 4,+      enabled = True+    }++-- | The token count at or above which a caller should compact. The subtraction+-- saturates so tiny fixture windows never underflow.+overflowThreshold :: CompactionConfig -> Model -> Natural+overflowThreshold cfg model =+  let window = model ^. #contextWindow+   in if window <= reserveTokens cfg then 0 else window - reserveTokens cfg++-- | Whether the provider-reported prompt usage has reached the compaction+-- threshold for this model.+usageExceedsWindow :: CompactionConfig -> Model -> Usage -> Bool+usageExceedsWindow cfg model usage =+  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.+compactTail ::+  (LLM :> es, Error ShikumiError :> es) =>+  CompactionConfig ->+  Model ->+  (a -> Text) ->+  (Text -> a) ->+  [a] ->+  Eff es [a]+compactTail cfg model render inject xs+  | olderCount <= 0 = pure xs+  | otherwise = do+      requireErrorRow Nothing+      let (older, recent) = splitAt olderCount xs+          (ctx, opts) = summaryRequest (renderItems render older)+      resp <- complete model ctx opts+      pure (inject (responseText resp) : recent)+  where+    keep = max 0 (keepRecent cfg)+    olderCount = length xs - keep++-- The exported compaction primitive intentionally shares the ReAct loop's+-- @(LLM, Error ShikumiError)@ row even though the current summarize path only+-- throws through the @LLM@ interpreter. Keep the constraint visible and checked.+requireErrorRow :: (Error ShikumiError :> es) => Maybe ShikumiError -> Eff es ()+requireErrorRow Nothing = pure ()+requireErrorRow (Just e) = throwError e++summaryRequest :: Text -> (Context, Options)+summaryRequest rendered =+  ( _Context+      & #systemPrompt+        .~ Just+          ( T.unlines+              [ "Compact the earlier working context into a short, faithful summary.",+                "Preserve decisions, tool results, constraints, unresolved questions, and facts needed to continue.",+                "Do not invent new facts."+              ]+          )+      & #messages .~ V.singleton (user rendered),+    _Options+  )++renderItems :: (a -> Text) -> [a] -> Text+renderItems render xs =+  T.intercalate "\n\n" (zipWith one [1 :: Int ..] xs)+  where+    one n x = "Item " <> T.pack (show n) <> ":\n" <> render x++responseText :: Response -> Text+responseText resp =+  T.concat [t | AssistantText (TextContent t) <- V.toList (flattenAssistantBlocks resp)]
src/Shikumi/Error.hs view
@@ -30,6 +30,8 @@     ValidationFailure !Text   | -- | the provider/transport failed (mapped from baikai)     ProviderFailure !Text+  | -- | the prompt exceeded the model's context window+    ContextWindowExceeded !Text   | -- | the call exceeded its time budget     Timeout !Text   | -- | the running cost ceiling was reached; the call was refused@@ -45,6 +47,7 @@ fromBaikaiError e = case category e of   DecodeFailure -> InvalidJSON (message e)   InvalidRequest -> SchemaMismatch ("invalid request: " <> message e)+  ContextOverflow -> ContextWindowExceeded (message e)   ProcessFailure ->     ProviderFailure $       case exitCode e of
src/Shikumi/Multimodal.hs view
@@ -58,15 +58,15 @@ -- | A typed image usable as a /signature input/ field. Stores decoded bytes and a -- MIME type; base64 is a wire detail handled by baikai when the image is sent. data Image = Image-  { imageBytes :: !ByteString,-    imageMime :: !Text+  { bytes :: !ByteString,+    mime :: !Text   }   deriving stock (Eq, Show, Generic)  -- | Build an image from already-decoded bytes and an explicit MIME type. The -- primitive constructor; the others normalise into it. imageFromBytes :: Text -> ByteString -> Image-imageFromBytes mime bs = Image {imageBytes = bs, imageMime = mime}+imageFromBytes mime bs = Image {bytes = bs, mime = mime}  -- | Read an image file from disk, inferring the MIME type from the extension. -- Returns 'Left' a 'SchemaMismatch' if the extension is unrecognised (checked@@ -89,7 +89,7 @@ -- | Lower an 'Image' into baikai's wire image block. Bytes pass through decoded; -- baikai base64-encodes them only when serialising to the wire. imageToContent :: Image -> ImageContent-imageToContent img = ImageContent {imageData = imageBytes img, mimeType = imageMime img}+imageToContent img = ImageContent {imageData = bytes img, mimeType = mime img}  -- | A tiny fixed extension-to-MIME table (case-insensitive). Deliberately not a -- MIME database: the supported image media types are few and stable.
src/Shikumi/Program.hs view
@@ -56,6 +56,7 @@     -- * Per-node field metadata (EP-16)     NodeFields (..),     nodeFieldsIndexed,+    nodeInstructionsIndexed,      -- * Execution internals (reused by alternative executors, e.g. @runProgramTraced@)     retryWith,@@ -470,6 +471,29 @@     go :: forall x y. Program x y -> [NodeFields]     go (Predict sig _) =       [NodeFields (map fieldName (inputFields sig)) (map fieldName (outputFields sig))]+    go (Compose a b) = go a ++ go b+    go (FMap _ p) = go p+    go (Map _ p) = go p+    go (Parallel a b) = go a ++ go b+    go (Retry _ p) = go p+    go (RetryWhen _ _ p) = go p+    go (Validate _ p) = go p+    go (MajorityVote _ _ p) = go p+    go (Ensemble ps _) = concatMap go ps+    go (Embed _) = []++-- | For every 'Predict' node, in 'foldParams' order, its signature instruction.+-- Index-aligned with 'nodeFieldsIndexed' and 'foldParams': entry @n@ describes the+-- same node those functions address, so the two lists can be zipped. Composite+-- nodes carry no instruction and 'Embed' is opaque, so neither contributes an+-- entry. This reads the /signature's/ base instruction (not any per-node 'Params'+-- instruction override), which is the stable task description suitable for+-- documentation (consumed by @shikumi-okf@'s program-doc renderer).+nodeInstructionsIndexed :: Program i o -> [Text]+nodeInstructionsIndexed = go+  where+    go :: forall x y. Program x y -> [Text]+    go (Predict sig _) = [getInstruction sig]     go (Compose a b) = go a ++ go b     go (FMap _ p) = go p     go (Map _ p) = go p
src/Shikumi/Refine.hs view
@@ -166,8 +166,8 @@ -- wrapper). Mirrors DSPy's @OfferFeedback@ predictor, scoped to the whole inner -- program. data AdviceIn = AdviceIn-  { achievedReward :: Text,-    targetThreshold :: Text+  { achievedReward :: !Text,+    targetThreshold :: !Text   }   deriving stock (Generic, Show, Eq) @@ -293,9 +293,9 @@ -- @Generic@-derived) because @attempts@ is polymorphic in @o@ — the same reason -- 'WithReasoning'\'s instances are hand-written. data MultiChainInput i o = MultiChainInput-  { original :: i,+  { original :: !i,     -- | length @M@; each rendered as "Student Attempt #k"-    attempts :: [WithReasoning o]+    attempts :: ![WithReasoning o]   }  -- | Render the original input, then each attempt as a "Student Attempt #k" line:
src/Shikumi/Signature.hs view
@@ -19,6 +19,8 @@   ) where +import Control.Lens ((&), (.~))+import Data.Generics.Labels () import Data.Text (Text) import GHC.Generics (Generic, Rep) import Shikumi.Schema (GFieldMetas, fieldMetasOf)@@ -27,8 +29,8 @@ -- | A worked input -> output example shown to the model. Optimizers select and -- rewrite these. data Demo i o = Demo-  { input :: i,-    output :: o+  { input :: !i,+    output :: !o   }   deriving stock (Generic, Show, Eq) @@ -37,13 +39,13 @@ -- the compiler enforces the input/output types. data Signature i o = Signature   { -- | optimizable: the task description-    instruction :: Text,+    instruction :: !Text,     -- | optimizable: worked examples-    demos :: [Demo i o],+    demos :: ![Demo i o],     -- | derived metadata: the input record's fields-    inputFields :: [FieldMeta],+    inputFields :: ![FieldMeta],     -- | derived metadata: the output record's fields-    outputFields :: [FieldMeta]+    outputFields :: ![FieldMeta]   }   deriving stock (Generic, Show) @@ -68,7 +70,7 @@  -- | Replace the (optimizable) instruction. setInstruction :: Text -> Signature i o -> Signature i o-setInstruction t sig = sig {instruction = t}+setInstruction t sig = sig & #instruction .~ t  -- | Read the (optimizable) demonstrations. getDemos :: Signature i o -> [Demo i o]@@ -76,4 +78,4 @@  -- | Replace the (optimizable) demonstrations. setDemos :: [Demo i o] -> Signature i o -> Signature i o-setDemos ds sig = sig {demos = ds}+setDemos ds sig = sig & #demos .~ ds
test/CombinatorSpec.hs view
@@ -7,6 +7,8 @@ -- shape and parameter vector round-trip). module CombinatorSpec (tests) where +import Control.Lens ((&), (.~))+import Data.Generics.Labels () import Data.IORef (newIORef, readIORef) import Data.Text (Text) import Data.Text qualified as T@@ -48,8 +50,7 @@ import Shikumi.LLM.Mock (MockReply (..), runMockLLM, runMockLLMCounting) import Shikumi.Module (predict) import Shikumi.Program-  ( Params (..),-    Program,+  ( Program,     ProgramShape (..),     ProgramShapeError (..),     emptyParams,@@ -300,7 +301,7 @@         length (foldParams deepProg) @?= 2,       testCase "an instruction written through the traversal reaches the deepest leaf at run time" $ do         let sentinel = "SENTINEL-INSTRUCTION"-            rewritten = mapParams (\p -> p {instructionOverride = Just sentinel}) deepProg+            rewritten = mapParams (\p -> p & #instructionOverride .~ Just sentinel) deepProg         -- stage 1 samples the MajorityVote leaf 3×, stage 2 the Validate leaf 1×.         prompts <-           runRec@@ -311,8 +312,8 @@           ("expected the sentinel in every captured prompt; got: " <> show prompts)           (length prompts == 4 && all (T.isInfixOf sentinel) prompts),       testCase "the structural shape is parameter-independent and round-trips the parameter vector" $ do-        let p1 = emptyParams {instructionOverride = Just "one"}-            p2 = emptyParams {instructionOverride = Just "two"}+        let p1 = emptyParams & #instructionOverride .~ Just "one"+            p2 = emptyParams & #instructionOverride .~ Just "two"         programParams deepProg @?= [emptyParams, emptyParams]         case setProgramParams [p1, p2] deepProg of           Left e -> assertBool ("unexpected setProgramParams failure: " <> show e) False
test/ConstraintSpec.hs view
@@ -21,8 +21,8 @@ -- A small constrained record: a tagline of at least 10 characters and a score in -- the inclusive range [0, 100]. data Bio = Bio-  { tagline :: Constrained '[ 'MinLen 10] Text,-    score :: Constrained '[ 'MinVal "0", 'MaxVal "100"] Int+  { tagline :: !(Constrained '[ 'MinLen 10] Text),+    score :: !(Constrained '[ 'MinVal "0", 'MaxVal "100"] Int)   }   deriving stock (Generic, Show, Eq) @@ -34,8 +34,8 @@  -- The same shape with no constraints, to prove the constraint does the rejecting. data BioUnchecked = BioUnchecked-  { tagline :: Text,-    score :: Int+  { tagline :: !Text,+    score :: !Int   }   deriving stock (Generic, Show, Eq) 
test/ErrorSpec.hs view
@@ -3,7 +3,7 @@ -- to 'ProviderFailure') makes this group fail. module ErrorSpec (tests) where -import Baikai.Error (decodeError, invalidRequest, processError, providerError)+import Baikai.Error (BaikaiError (..), ErrorCategory (..), decodeError, invalidRequest, processError, providerError) import Shikumi.Error   ( ShikumiError (..),     fromBaikaiError,@@ -24,9 +24,20 @@         fromBaikaiError (invalidRequest "z") @?= SchemaMismatch "invalid request: z",       testCase "maps processError -> ProviderFailure" $         fromBaikaiError (processError 2 "boom") @?= ProviderFailure "process exited 2: boom",+      testCase "maps ContextOverflow -> ContextWindowExceeded" $+        fromBaikaiError+          BaikaiError+            { category = ContextOverflow,+              message = "context length exceeded",+              httpStatus = Just 400,+              retryAfterSeconds = Nothing,+              exitCode = Nothing+            }+          @?= ContextWindowExceeded "context length exceeded",       testCase "isTransient classification" $ do         isTransient (ProviderFailure "") @?= True         isTransient (Timeout "") @?= True+        isTransient (ContextWindowExceeded "") @?= False         isTransient (BudgetExceeded "") @?= False         isTransient (SchemaMismatch "") @?= False         isTransient (InvalidJSON "") @?= False
test/Fixtures.hs view
@@ -36,8 +36,8 @@ instance FromModel Author  data Article = Article-  { title :: Field "The article's headline" Text,-    body :: Field "The full article text" Text+  { title :: !(Field "The article's headline" Text),+    body :: !(Field "The full article text" Text)   }   deriving stock (Generic, Show, Eq) @@ -48,11 +48,11 @@ instance ToPrompt Article  data Summary = Summary-  { headline :: Field "A one-line summary" Text,-    bullets :: Field "Three to five key points" [Text],-    author :: Author,-    sentiment :: Sentiment,-    note :: Maybe Text+  { headline :: !(Field "A one-line summary" Text),+    bullets :: !(Field "Three to five key points" [Text]),+    author :: !Author,+    sentiment :: !Sentiment,+    note :: !(Maybe Text)   }   deriving stock (Generic, Show, Eq) 
test/LiveSpec.hs view
@@ -10,6 +10,7 @@ import Baikai.Models.Generated (openai_gpt_4o_mini) import Baikai.Prelude import Baikai.Provider.OpenAI.Api qualified as OpenAI+import Data.Generics.Labels () import Data.Text qualified as T import Data.Vector qualified as V import Effectful (runEff)
test/ModuleSpec.hs view
@@ -4,6 +4,8 @@ -- underlying node's parameters stay reachable via @mapParamsAt@. module ModuleSpec (tests) where +import Control.Lens ((&), (.~))+import Data.Generics.Labels () import Data.IORef (newIORef) import Effectful (runEff) import Effectful.Error.Static (runErrorNoCallStack)@@ -17,7 +19,7 @@   ) import Shikumi.Error (ShikumiError) import Shikumi.Module (WithReasoning (..), chainOfThought, chainOfThoughtRaw, predict)-import Shikumi.Program (Params (..), emptyParams, foldParams, mapParamsAt, runProgram)+import Shikumi.Program (emptyParams, foldParams, mapParamsAt, runProgram) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase, (@?=)) @@ -58,6 +60,6 @@             runProgram (chainOfThought topicToOutline) (Topic "haskell")         out @?= Right (Outline {points = ["x", "y"]}),       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"}]+        foldParams (mapParamsAt 0 (\p -> p & #instructionOverride .~ Just "cot") (chainOfThought topicToOutline))+          @?= [emptyParams & #instructionOverride .~ Just "cot"]     ]
test/MultimodalAdapterSpec.hs view
@@ -30,8 +30,8 @@ import Test.Tasty.HUnit (testCase, (@?=))  data Describe = Describe-  { image :: Image,-    question :: Field "What to ask about the image" Text+  { image :: !Image,+    question :: !(Field "What to ask about the image" Text)   }   deriving stock (Generic, Show)   deriving anyclass (ToPrompt)
test/MultimodalEndToEndSpec.hs view
@@ -43,8 +43,8 @@ import Test.Tasty.HUnit (testCase, (@?=))  data Describe = Describe-  { image :: Image,-    question :: Field "What to ask about the image" Text+  { image :: !Image,+    question :: !(Field "What to ask about the image" Text)   }   deriving stock (Generic, Show)   deriving anyclass (ToPrompt)
test/MultimodalSpec.hs view
@@ -9,11 +9,11 @@ import Data.ByteString.Base64 qualified as Base64 import Data.Text.Encoding (decodeUtf8) import Shikumi.Multimodal-  ( imageBytes,+  ( bytes,     imageFromBase64,     imageFromFile,-    imageMime,     imageToContent,+    mime,   ) import System.Directory (getTemporaryDirectory, removeFile) import System.IO (hClose, openTempFile)@@ -28,7 +28,7 @@         let raw = BS.pack [0x89, 0x50, 0x4e, 0x47, 0x0d, 0x0a, 0x1a, 0x0a] -- PNG magic             b64 = decodeUtf8 (Base64.encode raw)         img <- either (assertFailure . show) pure (imageFromBase64 "image/png" b64)-        imageBytes img @?= raw+        bytes img @?= raw         let ic = imageToContent img         imageData ic @?= raw         mimeType ic @?= "image/png",@@ -40,7 +40,7 @@         hClose h         res <- imageFromFile fp         img <- either (assertFailure . show) pure res-        imageBytes img @?= raw-        imageMime img @?= "image/png"+        bytes img @?= raw+        mime img @?= "image/png"         removeFile fp     ]
test/ProgramAcceptanceSpec.hs view
@@ -8,7 +8,9 @@ --     wire), while node 1 is untouched. module ProgramAcceptanceSpec (tests) where +import Control.Lens ((&), (.~)) import Data.Aeson (Value, object, (.=))+import Data.Generics.Labels () import Data.IORef (newIORef, readIORef) import Data.Text (Text) import Data.Text qualified as T@@ -71,7 +73,7 @@         let rewritten =               mapParamsAt                 0-                (\p -> p {instructionOverride = Just "NEW INSTRUCTION", demos = [sampleDemo]})+                (\p -> p & #instructionOverride .~ Just "NEW INSTRUCTION" & #demos .~ [sampleDemo])                 essay             params = foldParams rewritten         length params @?= 2@@ -84,7 +86,7 @@         let rewritten =               mapParamsAt                 0-                (\p -> p {instructionOverride = Just "NEW INSTRUCTION", demos = [sampleDemo]})+                (\p -> p & #instructionOverride .~ Just "NEW INSTRUCTION" & #demos .~ [sampleDemo])                 essay         out <-           runEff . runErrorNoCallStack @ShikumiError . runRecordingLLM capture ref $
test/ProgramSpec.hs view
@@ -2,6 +2,8 @@ -- @foldParams@ / @mapParams@ / @mapParamsAt@ and the ordering law). module ProgramSpec (tests) where +import Control.Lens ((&), (.~))+import Data.Generics.Labels () import Data.IORef (newIORef) import Data.List (foldl1') import Data.Text (Text)@@ -21,12 +23,13 @@   ) import Shikumi.Error (ShikumiError) import Shikumi.Program-  ( Params (..),+  ( Params,     Program (Compose, Predict),     emptyParams,     foldParams,     mapParams,     mapParamsAt,+    nodeInstructionsIndexed,     pipeline,     runProgram,   )@@ -39,7 +42,7 @@ twoStage = pipeline (Predict topicToOutline emptyParams) (Predict outlineToDraft emptyParams)  setInstr :: Text -> Params -> Params-setInstr t p = p {instructionOverride = Just t}+setInstr t p = p & #instructionOverride .~ Just t  -- | A list update mirroring @mapParamsAt@'s contract, used to state the ordering -- law executably.@@ -62,6 +65,11 @@         out @?= Right (Outline {points = ["intro", "body", "end"]}),       testCase "M2: foldParams returns nodes in stage order" $         foldParams twoStage @?= [emptyParams, emptyParams],+      testCase "M5: nodeInstructionsIndexed returns signature instructions in node order" $+        nodeInstructionsIndexed twoStage+          @?= ["Outline the topic into points", "Draft prose from the outline"],+      testCase "M5: nodeInstructionsIndexed aligns one-to-one with foldParams" $+        length (nodeInstructionsIndexed twoStage) @?= length (foldParams twoStage),       testCase "M2: mapParams touches every node" $         foldParams (mapParams (setInstr "X") twoStage)           @?= [setInstr "X" emptyParams, setInstr "X" emptyParams],
test/StubProvider.hs view
@@ -29,6 +29,7 @@     readTVar,   ) import Control.Exception (bracket_, throwIO)+import Data.Generics.Labels () import Data.IORef (IORef, atomicModifyIORef') import Data.Text qualified as T import Data.Vector qualified as V