diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,16 @@ ## Unreleased +## 0.3.0.0 — 2026-09-08 + +- Raise the internal `shikumi` bound to `^>=0.4.0.0` and `shikumi-cache` to `^>=0.2.0.0`. + +- Persist optional billing detail and logical span quality in format 3 while reading formats 1 and 2. Streaming terminals now populate usage; observed model identity comes only from evidence. Billing attachment does not add replay entries. Public record additions require PVP major review. + +- Upgrade the dependency on `mori://shinzui/baikai/packages/baikai` to `>=0.7.0.0 && <0.8`. + +- Add isolated `runProgramObserved` and `NodeObservation`, sharing traced control flow and retaining failed-attempt evidence with rejection lineage. Embed remains opaque; concurrent outer executions use separate storage. + ## 0.2.0.3 — 2026-08-29 ### Changed diff --git a/shikumi-trace.cabal b/shikumi-trace.cabal --- a/shikumi-trace.cabal +++ b/shikumi-trace.cabal @@ -1,6 +1,6 @@ cabal-version: 3.4 name: shikumi-trace -version: 0.2.0.3 +version: 0.3.0.0 synopsis: Hierarchical tracing, observability, and deterministic replay for shikumi (EP-7) @@ -44,6 +44,7 @@ Shikumi.Trace.Feedback Shikumi.Trace.Internal.Spike Shikumi.Trace.Node + Shikumi.Trace.Observation Shikumi.Trace.Program Shikumi.Trace.Replay Shikumi.Trace.ResponseJSON @@ -51,7 +52,7 @@ build-depends: , aeson >=2.2 && <2.3 - , baikai >=0.6 && <0.7 + , baikai >=0.7.0.0 && <0.8 , base >=4.20 && <5 , bytestring >=0.11 && <0.13 , containers >=0.6 && <0.9 @@ -60,8 +61,8 @@ , generic-lens >=2.2 && <2.4 , lens ^>=5.3 , scientific >=0.3 && <0.4 - , shikumi ^>=0.3.0.0 - , shikumi-cache ^>=0.1.2.0 + , shikumi ^>=0.4.0.0 + , shikumi-cache ^>=0.2.0.0 , text ^>=2.1 , time >=1.12 && <1.17 , vector >=0.13 && <0.14 @@ -73,7 +74,7 @@ ghc-options: -threaded -with-rtsopts=-N build-depends: , base - , shikumi-trace ^>=0.2.0.0 + , shikumi-trace ^>=0.3.0.0 test-suite shikumi-trace-test import: common-options @@ -81,10 +82,13 @@ hs-source-dirs: test main-is: Main.hs ghc-options: -threaded -with-rtsopts=-N - other-modules: TraceFixtures + other-modules: + ObservationSpec + TraceFixtures + build-depends: , aeson - , baikai >=0.6 && <0.7 + , baikai >=0.7.0.0 && <0.8 , base , bytestring , containers @@ -92,9 +96,9 @@ , generic-lens , lens ^>=5.3 , QuickCheck - , shikumi ^>=0.3.0.0 - , shikumi-cache ^>=0.1.2.0 - , shikumi-trace ^>=0.2.0.0 + , shikumi ^>=0.4.0.0 + , shikumi-cache ^>=0.2.0.0 + , shikumi-trace ^>=0.3.0.0 , tasty , tasty-hunit , tasty-quickcheck diff --git a/src/Shikumi/Trace.hs b/src/Shikumi/Trace.hs --- a/src/Shikumi/Trace.hs +++ b/src/Shikumi/Trace.hs @@ -29,6 +29,7 @@ Span (..), TraceTree (..), childrenOf, + attachBillingSummary, -- * Node identity (re-exported from "Shikumi.Trace.Node") NodePath (..), @@ -54,7 +55,9 @@ import Baikai ( AssistantContent (..), + AssistantMessageEvent (..), Context, + Message (..), Model, Options, Response, @@ -88,6 +91,7 @@ import Shikumi.Cache.Key qualified as Key import Shikumi.Effect.Time (Time, getCurrentTime) import Shikumi.LLM (LLM (..), complete, stream) +import Shikumi.LLM.Observation (BillingSummary, UsageRecord (..), observedModelOf) import Shikumi.Trace.Node (NodePath (..)) import Shikumi.Trace.ResponseJSON () import Text.Read (readMaybe) @@ -138,7 +142,9 @@ -- | the structural path of the @Program@ node that issued this span's LM call -- (EP-16). Present only on model-call spans produced by @runProgramTraced@; -- 'Nothing' for spans opened by bare 'withSpan' or a non-node-correlated run. - nodePath :: !(Maybe NodePath) + nodePath :: !(Maybe NodePath), + billingQuality :: !(Maybe UsageRecord), + observedModel :: !(Maybe Text) } deriving stock (Eq, Show, Generic) deriving anyclass (ToJSON, FromJSON) @@ -158,7 +164,9 @@ retries = 0, toolCalls = [], cacheKey = Nothing, - nodePath = Nothing + nodePath = Nothing, + billingQuality = Nothing, + observedModel = Nothing } -- | One node of the trace tree. @@ -178,11 +186,16 @@ -- reconstructed from each span's 'parent' pointer ('childrenOf'). data TraceTree = TraceTree { root :: !SpanId, - spans :: !(Map SpanId Span) + spans :: !(Map SpanId Span), + transportBilling :: !(Maybe BillingSummary) } deriving stock (Eq, Show, Generic) deriving anyclass (ToJSON, FromJSON) +-- | Attach a run-local bounded transport view, without structural attribution. +attachBillingSummary :: BillingSummary -> TraceTree -> TraceTree +attachBillingSummary b t = t {transportBilling = Just b} + -- | The children of a span, in creation order (sorted by start time, ties broken -- by numeric @span-N@ id when possible). childrenOf :: TraceTree -> SpanId -> [SpanId] @@ -331,7 +344,7 @@ freezeTree st = do sp <- readIORef (st ^. #spans) r <- readIORef (st ^. #root) - pure (TraceTree (fromMaybe (SpanId "") r) sp) + pure (TraceTree (fromMaybe (SpanId "") r) sp Nothing) safeHead :: [a] -> Maybe a safeHead [] = Nothing @@ -343,9 +356,8 @@ -- | Capture every LM call as a leaf 'LlmCallSpan' under the active span. Interpose -- on EP-1's @LLM@ effect: open a span, delegate to the underlying handler, then --- fill the span's attributes from the returned 'Response' (and the request). The --- streaming op is wrapped in a span but its attributes are left empty (streams --- carry the same data incrementally; the demo/replay path uses 'complete'). +-- fill the span's attributes from the returned 'Response' (and the request). Streaming terminals contribute usage and observed identity; only successful +-- blocking responses produce replay records. -- -- This capture uses 'runTrace'\'s sequential span stack. Compose it with -- 'Shikumi.Program.runProgram'; concurrent program execution is intentionally @@ -356,7 +368,22 @@ resp <- complete m c o annotateSpan (const (llmAttrs m c o resp)) pure resp - Stream m c o -> withSpan LlmCallSpan (llmLabel m) (stream m c o) + Stream m c o -> withSpan LlmCallSpan (llmLabel m) $ do + evs <- stream m c o + case [t | EventDone t <- evs] of + t : _ -> case t ^. #message of + AssistantMessage p -> annotateSpan $ \a -> + a + & #model ?~ (m ^. #modelId) + & #provider ?~ (m ^. #provider) + & #inputTokens ?~ (p ^. #usage . #inputTokens) + & #outputTokens ?~ (p ^. #usage . #outputTokens) + & #costUsd ?~ realToFrac (p ^. #usage . #cost . #usd :: Rational) + & #billingQuality ?~ UsageRecord (p ^. #usage) + & #observedModel .~ observedModelOf (t ^. #evidence) + _ -> pure () + [] -> pure () + pure evs -- | The label for an LM-call span: @provider/model-id@. llmLabel :: Model -> Text @@ -374,6 +401,8 @@ & #inputTokens ?~ (resp ^. #message . #usage . #inputTokens) & #outputTokens ?~ (resp ^. #message . #usage . #outputTokens) & #costUsd ?~ realToFrac (resp ^. #message . #usage . #cost . #usd :: Rational) + & #billingQuality ?~ UsageRecord (resp ^. #message . #usage) + & #observedModel .~ observedModelOf (resp ^. #evidence) & #toolCalls .~ toolCallsOf resp & #cacheKey ?~ unCacheKey (Key.cacheKey m c o) diff --git a/src/Shikumi/Trace/Node.hs b/src/Shikumi/Trace/Node.hs --- a/src/Shikumi/Trace/Node.hs +++ b/src/Shikumi/Trace/Node.hs @@ -34,6 +34,7 @@ Map, Parallel, Predict, + PredictCaptured, Retry, RetryWhen, Validate @@ -86,6 +87,7 @@ where -- @prefix@ is the reversed list of steps taken so far; we reverse on emit. go :: forall x y. [NodeStep] -> Program x y -> [NodePath] + go prefix (PredictCaptured _ _ _) = [NodePath (reverse prefix)] go prefix (Predict _ _) = [NodePath (reverse prefix)] go prefix (Compose a b) = go (StepComposeL : prefix) a ++ go (StepComposeR : prefix) b go prefix (FMap _ p) = go (StepFMap : prefix) p diff --git a/src/Shikumi/Trace/Observation.hs b/src/Shikumi/Trace/Observation.hs new file mode 100644 --- /dev/null +++ b/src/Shikumi/Trace/Observation.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Structured evidence from one sequential execution, isolated from other runs. +module Shikumi.Trace.Observation (NodeObservation (..), runProgramObserved) where + +import Data.Aeson (Value) +import Data.Either (isRight) +import Data.Text (Text) +import Effectful (Eff, (:>)) +import Effectful.Error.Static (Error, catchError, throwError) +import Effectful.Prim (Prim) +import Effectful.Prim.IORef (modifyIORef', newIORef, readIORef) +import Shikumi.Adapter (ToPrompt (..)) +import Shikumi.Error (ShikumiError) +import Shikumi.LLM (LLM) +import Shikumi.Program (CaptureCodec (..), Program (..), runProgram) +import Shikumi.Trace (SpanKind) +import Shikumi.Trace.Node (NodePath) +import Shikumi.Trace.Program (walkProgramWith) + +-- | Invocation numbers start at zero per example, across all leaves. Rejection +-- lineage records the enclosing scope label and its first invocation number. +-- Opaque Embed observations never claim to identify internal predictors. +data NodeObservation = NodeObservation + { observationPath :: !NodePath, + observationInvocation :: !Int, + observationInput :: !(Maybe Value), + observationInputFields :: ![(Text, Text)], + observationOutputFields :: ![(Text, Text)], + observationOutput :: !(Maybe Value), + observationStatus :: !(Either ShikumiError ()), + observationEligible :: !Bool, + observationRejectedBy :: ![(Text, Int)], + observationOpaque :: !Bool + } + deriving stock (Eq, Show) + +-- | Typed failures retain observations. Host exceptions and cancellation escape. +-- Uses private Prim cells, so concurrent callers never exchange evidence. +runProgramObserved :: + forall i o es. + (LLM :> es, Error ShikumiError :> es, Prim :> es) => + Program i o -> i -> Eff es (Either ShikumiError o, [NodeObservation]) +runProgramObserved program input = do + observations <- newIORef [] + next <- newIORef 0 + let scope :: forall a. SpanKind -> Text -> Eff es a -> Eff es a + scope _ label action = do + start <- readIORef next + action `catchError` \_ (err :: ShikumiError) -> do + modifyIORef' + observations + ( map + ( \obs -> + if observationInvocation obs >= start + then obs {observationEligible = False, observationRejectedBy = (label, start) : observationRejectedBy obs} + else obs + ) + ) + throwError err + record :: + forall x y. + NodePath -> + Bool -> + (x -> Maybe Value) -> + (y -> Maybe Value) -> + (x -> [(Text, Text)]) -> + (y -> [(Text, Text)]) -> + Program x y -> + x -> + Eff es y + record path opaque encodeIn encodeOut fieldsIn fieldsOut node x = do + ordinal <- readIORef next + modifyIORef' next (+ 1) + result <- (Right <$> runProgram node x) `catchError` \_ err -> pure (Left err) + let obs = + NodeObservation + path + ordinal + (encodeIn x) + (fieldsIn x) + (either (const []) fieldsOut result) + (either (const Nothing) encodeOut result) + (() <$ result) + (isRight result && not opaque) + [] + opaque + modifyIORef' observations (obs :) + either throwError pure result + leaf :: forall x y. NodePath -> Program x y -> x -> Eff es y + leaf path node@(PredictCaptured codec _ _) = + record + path + False + (Just . encodeCaptureInput codec) + (Just . encodeCaptureOutput codec) + toPromptFields + toPromptFields + node + leaf path node@(Predict _ _) = record path False (const Nothing) (const Nothing) toPromptFields toPromptFields node + leaf path node = record path True (const Nothing) (const Nothing) (const []) (const []) node + result <- (Right <$> walkProgramWith scope leaf (pure ()) program input) `catchError` \_ err -> pure (Left err) + obs <- reverse <$> readIORef observations + pure (result, obs) diff --git a/src/Shikumi/Trace/Program.hs b/src/Shikumi/Trace/Program.hs --- a/src/Shikumi/Trace/Program.hs +++ b/src/Shikumi/Trace/Program.hs @@ -39,11 +39,13 @@ -- * Node-aware capture and execution tracedNodeLLM, runProgramTraced, + walkProgramWith, ) where import Control.Lens ((&), (.~)) import Data.Generics.Labels () +import Data.Text (Text) import Effectful (Dispatch (Dynamic), DispatchOf, Eff, Effect, (:>)) import Effectful.Dispatch.Dynamic (interpose, interpret, localSeqUnlift, send) import Effectful.Error.Static (Error, catchError, throwError) @@ -62,6 +64,7 @@ Map, Parallel, Predict, + PredictCaptured, Retry, RetryWhen, Validate @@ -161,46 +164,65 @@ Program i o -> i -> Eff es o -runProgramTraced = go [] +runProgramTraced = walkProgramWith withSpan leaf bumpRetry where + leaf _ node@(Embed _) i = runProgram node i + leaf path node i = localNode path (runProgram node i) + +-- | Shared sequential control flow. A scope callback may retain failure lineage; +-- the leaf callback handles predictions and opaque Embed executions. +walkProgramWith :: + forall i o es. + (LLM :> es, Error ShikumiError :> es) => + (forall a. SpanKind -> Text -> Eff es a -> Eff es a) -> + (forall x y. NodePath -> Program x y -> x -> Eff es y) -> + Eff es () -> + Program i o -> + i -> + Eff es o +walkProgramWith scope leaf onRetry = go [] + where go :: forall x y. [NodeStep] -> Program x y -> x -> Eff es y + go prefix node@(PredictCaptured _ _ _) i = + scope ModuleSpan "Predict" (leaf (NodePath (reverse prefix)) node i) go prefix node@(Predict _ _) i = - withSpan ModuleSpan "Predict" (localNode (NodePath (reverse prefix)) (runProgram node i)) + scope ModuleSpan "Predict" (leaf (NodePath (reverse prefix)) node i) go prefix (Compose f g) i = - withSpan CombinatorSpan "Compose" (go (StepComposeL : prefix) f i >>= go (StepComposeR : prefix) g) + scope CombinatorSpan "Compose" (go (StepComposeL : prefix) f i >>= go (StepComposeR : prefix) g) go prefix (FMap k p) i = - withSpan CombinatorSpan "FMap" (k <$> go (StepFMap : prefix) p i) + scope CombinatorSpan "FMap" (k <$> go (StepFMap : prefix) p i) go prefix (Map _ p) xs = - withSpan CombinatorSpan "Map" (traverse (go (StepMap : prefix) p) xs) + scope CombinatorSpan "Map" (traverse (go (StepMap : prefix) p) xs) go prefix (Parallel a b) i = - withSpan CombinatorSpan "Parallel" ((,) <$> go (StepParallelL : prefix) a i <*> go (StepParallelR : prefix) b i) + scope CombinatorSpan "Parallel" ((,) <$> go (StepParallelL : prefix) a i <*> go (StepParallelR : prefix) b i) go prefix (Retry n p) i = - withSpan CombinatorSpan "Retry" (tracedRetry (go (StepRetry : prefix)) (const True) n p i) + scope CombinatorSpan "Retry" (tracedRetry onRetry (go (StepRetry : prefix)) (const True) n p i) go prefix (RetryWhen ok n p) i = - withSpan CombinatorSpan "RetryWhen" (tracedRetry (go (StepRetryWhen : prefix)) ok n p i) + scope CombinatorSpan "RetryWhen" (tracedRetry onRetry (go (StepRetryWhen : prefix)) ok n p i) go prefix (Validate v p) i = - withSpan CombinatorSpan "Validate" (go (StepValidate : prefix) p i >>= acceptOrReject v) + scope CombinatorSpan "Validate" (go (StepValidate : prefix) p i >>= acceptOrReject v) go prefix (MajorityVote k sched reduce p) i = - withSpan CombinatorSpan "MajorityVote" $ + scope CombinatorSpan "MajorityVote" $ reduce <$> traverse (\mt -> withSampleTemp mt (go (StepMajorityVote : prefix) p i)) (sampleTemps k sched) go prefix (Ensemble ps reduce) i = - withSpan CombinatorSpan "Ensemble" $ + scope CombinatorSpan "Ensemble" $ reduce <$> sequence [go (StepEnsemble idx : prefix) p i | (idx, p) <- zip [0 ..] ps] - go _ (Embed f) i = - withSpan CombinatorSpan "Embed" (f i) + go prefix node@(Embed _) i = + scope CombinatorSpan "Embed" (leaf (NodePath (reverse prefix)) node i) tracedRetry :: - (Trace :> es, Error ShikumiError :> es) => + (Error ShikumiError :> es) => + Eff es () -> (Program x y -> x -> Eff es y) -> (ShikumiError -> Bool) -> Int -> Program x y -> x -> Eff es y -tracedRetry run ok n p i = attempt (max 1 n) +tracedRetry onRetry run ok n p i = attempt (max 1 n) where attempt left = run p i `catchError` \_cs e -> if ok e && left > 1 - then bumpRetry >> attempt (left - 1) + then onRetry >> attempt (left - 1) else throwError e diff --git a/src/Shikumi/Trace/Store.hs b/src/Shikumi/Trace/Store.hs --- a/src/Shikumi/Trace/Store.hs +++ b/src/Shikumi/Trace/Store.hs @@ -49,9 +49,9 @@ deriving anyclass (ToJSON, FromJSON) -- | The trace-file schema version this build reads and writes. Bumped 1→2 in --- EP-16 for the additive optional @SpanAttrs.nodePath@ field. +-- EP-16 for optional node paths; 2→3 adds optional billing quality and run attempts. currentFormatVersion :: Int -currentFormatVersion = 2 +currentFormatVersion = 3 -- | The oldest trace format this build still reads. v1→v2 was additive (the -- optional @SpanAttrs.nodePath@ field), so v1 files decode without migration. diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -19,6 +19,7 @@ import Effectful.Error.Static (runErrorNoCallStack) import Effectful.Prim (runPrim) import GHC.Generics (Generic) +import ObservationSpec qualified import Shikumi.Adapter (ToPrompt) import Shikumi.Cache.Key (CacheKey (..)) import Shikumi.Cache.Key qualified as Key @@ -100,7 +101,7 @@ defaultMain $ testGroup "shikumi-trace" - [spikeTests, treeTests, storeTests, replayTests, e2eTests, nodeTests, correlateTests, feedbackTests] + [ObservationSpec.tests, spikeTests, treeTests, storeTests, replayTests, e2eTests, nodeTests, correlateTests, feedbackTests] -- --------------------------------------------------------------------------- -- M0 @@ -197,6 +198,16 @@ BL.writeFile p (encode (TraceFile 1 tree)) res <- readTraceFile p res @?= Right tree, + testCase "formatVersion 2 without billing fields remains readable" $ + withSystemTempDirectory "shikumi-trace" $ \dir -> do + let p = dir <> "/v2.json" + BL.writeFile p "{\"formatVersion\":2,\"tree\":{\"root\":\"span-0\",\"spans\":{\"span-0\":{\"spanId\":\"span-0\",\"parent\":null,\"kind\":\"ProgramSpan\",\"label\":\"legacy\",\"startedAt\":\"2026-09-08T00:00:00Z\",\"endedAt\":null,\"attrs\":{\"model\":null,\"provider\":null,\"prompt\":null,\"response\":null,\"latencyMs\":null,\"inputTokens\":null,\"outputTokens\":null,\"costUsd\":null,\"retries\":0,\"toolCalls\":[],\"cacheKey\":null,\"nodePath\":null}}}}}" + res <- readTraceFile p + case res of + Left err -> assertFailure (T.unpack err) + Right tree -> do + transportBilling tree @?= Nothing + map attrs (Map.elems (spans tree)) @?= [emptyAttrs], testCase "replayIndex maps each llm-call cacheKey to its response" $ do tree <- buildTree idx <- replayIndexOrFail tree @@ -408,7 +419,7 @@ } } ss = [rootSpan, child 1 firstResp, child 2 secondResp] - in TraceTree (SpanId "span-0") (Map.fromList [(spanId s, s) | s <- ss]) + in TraceTree (SpanId "span-0") (Map.fromList [(spanId s, s) | s <- ss]) Nothing numericSiblingTree :: TraceTree numericSiblingTree = @@ -433,7 +444,7 @@ attrs = emptyAttrs } ss = rootSpan : map child ([2 .. 12] :: [Int]) - in TraceTree (SpanId "span-1") (Map.fromList [(spanId s, s) | s <- ss]) + in TraceTree (SpanId "span-1") (Map.fromList [(spanId s, s) | s <- ss]) Nothing -- --------------------------------------------------------------------------- -- A small generator of random trees for the round-trip property @@ -465,7 +476,7 @@ let (ss, _) = flattenShape Nothing 0 shape m = Map.fromList [(spanId s, s) | s <- ss] rootId = spanId (firstSpan ss) - pure (TraceTree rootId m) + pure (TraceTree rootId m Nothing) where firstSpan (s : _) = s firstSpan [] = error "genTree: empty" diff --git a/test/ObservationSpec.hs b/test/ObservationSpec.hs new file mode 100644 --- /dev/null +++ b/test/ObservationSpec.hs @@ -0,0 +1,79 @@ +module ObservationSpec (tests) where + +import Data.Aeson (ToJSON, toJSON) +import Data.IORef (newIORef) +import Data.Text (Text) +import Effectful (liftIO, runEff) +import Effectful.Concurrent (runConcurrent) +import Effectful.Concurrent.Async (mapConcurrently) +import Effectful.Error.Static (runErrorNoCallStack) +import Effectful.Prim (runPrim) +import GHC.Generics (Generic) +import Shikumi.Adapter (ToPrompt) +import Shikumi.Error (ShikumiError) +import Shikumi.Module (predict, predictCaptured) +import Shikumi.Program (Program (..)) +import Shikumi.Schema (FromModel, ToSchema, Validatable) +import Shikumi.Signature (mkSignature) +import Shikumi.Trace.Observation +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (assertFailure, testCase, (@?=)) +import TraceFixtures (mkResponse, runSequencedLLM) + +newtype Cell = Cell {cell :: Text} deriving stock (Eq, Show, Generic) + +instance ToJSON Cell + +instance ToSchema Cell + +instance FromModel Cell + +instance ToPrompt Cell + +instance Validatable Cell + +leaf :: Program Cell Cell +leaf = predictCaptured (mkSignature "Echo") + +run :: Program i o -> i -> [Text] -> IO (Either ShikumiError (Either ShikumiError o, [NodeObservation])) +run p i replies = do + ref <- newIORef (map mkResponse replies) + runEff . runPrim . runErrorNoCallStack @ShikumiError . runSequencedLLM ref $ runProgramObserved p i + +tests :: TestTree +tests = + testGroup + "observations" + [ testCase "concurrent outer examples retain independent inputs and ordinals" $ do + results <- + runEff . runConcurrent $ + mapConcurrently + (\value -> liftIO (run leaf (Cell value) ["{\"cell\":\"ok\"}"])) + ["one", "two"] + let observations = [obs | Right (_, [obs]) <- results] + map observationInput observations @?= map (Just . toJSON . Cell) ["one", "two"] + map observationInvocation observations @?= [0, 0], + testCase "retry keeps evidence but rejects successful leaves in failed validation" $ do + result <- run (Retry 2 (Validate (\x -> if x == Cell "bad" then Left "reject" else Right x) leaf)) (Cell "input") ["{\"cell\":\"bad\"}", "{\"cell\":\"good\"}"] + case result of + Right (out, obs) -> do + out @?= Right (Cell "good") + map observationInvocation obs @?= [0, 1] + map observationEligible obs @?= [False, True] + map observationOutput obs @?= map (Just . toJSON . Cell) ["bad", "good"] + Left e -> assertFailure (show e), + testCase "map repeats a structural path with distinct invocations" $ do + result <- run (Map 2 leaf) [Cell "a", Cell "b"] ["{\"cell\":\"a\"}", "{\"cell\":\"b\"}"] + case result of + Right (_, [a, b]) -> do + observationPath a @?= observationPath b + map observationInvocation [a, b] @?= [0, 1] + other -> assertFailure (show other), + testCase "root failure returns evidence; missing codec is distinct from failure" $ do + result <- run (predict (mkSignature "Echo") :: Program Cell Cell) (Cell "a") ["broken"] + case result of + Right (Left _, [obs]) -> do + observationInput obs @?= Nothing + observationEligible obs @?= False + other -> assertFailure (show other) + ]