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 +15/−0
- shikumi.cabal +3/−2
- src/Shikumi/Adapter.hs +5/−5
- src/Shikumi/Compaction.hs +116/−0
- src/Shikumi/Error.hs +3/−0
- src/Shikumi/Multimodal.hs +4/−4
- src/Shikumi/Program.hs +24/−0
- src/Shikumi/Refine.hs +4/−4
- src/Shikumi/Signature.hs +10/−8
- test/CombinatorSpec.hs +6/−5
- test/ConstraintSpec.hs +4/−4
- test/ErrorSpec.hs +12/−1
- test/Fixtures.hs +7/−7
- test/LiveSpec.hs +1/−0
- test/ModuleSpec.hs +5/−3
- test/MultimodalAdapterSpec.hs +2/−2
- test/MultimodalEndToEndSpec.hs +2/−2
- test/MultimodalSpec.hs +5/−5
- test/ProgramAcceptanceSpec.hs +4/−2
- test/ProgramSpec.hs +10/−2
- test/StubProvider.hs +1/−0
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