keiki-codec-json (empty) → 0.1.0.0

raw patch · 16 files changed

+2470/−0 lines, 16 filesdep +QuickCheckdep +aesondep +base

Dependencies added: QuickCheck, aeson, base, bytestring, containers, deepseq, hspec, keiki, keiki-codec-json, quickcheck-instances, tasty-bench, template-haskell, text, time

Files

• CHANGELOG.md +50/−0
• CONTRIBUTING.md +76/−0
• README.md +228/−0
• bench/Bench.hs +198/−0
• bench/baseline.csv +17/−0
• keiki-codec-json.cabal +121/−0
• src/Keiki/Codec/JSON.hs +169/−0
• src/Keiki/Codec/JSON/Event.hs +512/−0
• src/Keiki/Codec/JSON/TH.hs +259/−0
• test/Keiki/Codec/JSON/Fixtures.hs +188/−0
• test/Keiki/Codec/JSON/GoldenSpec.hs +24/−0
• test/Keiki/Codec/JSON/PropSpec.hs +80/−0
• test/Keiki/Codec/JSON/SensitivitySpec.hs +55/−0
• test/Keiki/Codec/JSON/THEventSpec.hs +174/−0
• test/Keiki/Codec/JSON/THSpec.hs +123/−0
• test/Spec.hs +196/−0

@@ -0,0 +1,50 @@+# Changelog++All notable changes to this package are documented in this file.+The format follows [Keep a Changelog](https://keepachangelog.com/),+and this project adheres to the+[Haskell PVP](https://pvp.haskell.org).+++## [Unreleased]+++## [0.1.0.0] — 2026-06-07++Initial Hackage release. Co-released with `keiki-0.1.0.0`; this+package depends on `keiki ^>= 0.1`.++### Added++- `Keiki.Codec.JSON` — three-method codec class `RegFileToJSON+  (rs :: [Slot])`:+  - `regFileToJSON :: RegFile rs -> Aeson.Value` (strict Value-path encoder).+  - `regFileFromJSON :: Aeson.Value -> Either String (RegFile rs)`+    (strict decoder; rejects missing / extra / type-mismatched+    fields with per-slot error messages).+  - `regFileToEncoding :: RegFile rs -> Aeson.Encoding` (streaming+    encoder over `Aeson.Series` that avoids the O(output-size)+    intermediate `Aeson.Value` allocation).+  - A single auto-derived instance for every slot list whose slot+    types have `Aeson.ToJSON` + `Aeson.FromJSON`; users do not+    write instances by hand.+- `Keiki.Codec.JSON.TH` — Template Haskell helpers+  `deriveRegFileCodec` and `deriveRegFileCodecAs` that emit+  three top-level codec functions (`<prefix>ToJSON`,+  `<prefix>ToEncoding`, `<prefix>FromJSON`) for a record type+  with `deriving (Generic)`.++### Validated against++- GHC 9.12.2 locally on macOS aarch64 and in CI on Ubuntu Linux+  x86_64 (see `.github/workflows/ci.yml`).+- 40 hspec assertions, including 4 QuickCheck properties (100+  samples each), 9 schema-evolution sensitivity assertions+  (EP-36 §4 cases #1–9), a pinned golden shape hash, and 10+  `Keiki.Codec.JSON.TH` derivation tests.+- A `tasty-bench` baseline (`bench/baseline.csv`) for four+  representative `RegFile` size scenarios (multi-party signing,+  batch reconciliation, ticket aggregate, auction); the+  Encoding-path is ~1.5× faster than the Value-path on the+  streaming-motivating case (5,000-entry list) with 33 % less+  allocation.

@@ -0,0 +1,76 @@+# Contributing to keiki-codec-json++## GHC upgrade procedure (release-blocking)++The shape hash that powers snapshot discrimination+(`Keiki.Shape.regFileShapeHash`) uses `tyConModule + tyConName ++splitApps` from `Type.Reflection`. These accessors are stable across+GHC patch and minor versions historically, but the contract is not+covenanted forever. When bumping `tested-with` in `keiki.cabal`:++1. Add the new GHC to CI (`.github/workflows/ci.yml`'s `ghc` matrix+   entry).+2. Run the cross-GHC golden hash test:++       cabal test keiki-codec-json:keiki-codec-json-test \+         --test-options="--match 'M3 golden hash'"++   This asserts `regFileShapeHash (Proxy @ExemplarSlots)` matches the+   pinned value+   `a37b2b77042a635f394a082765f3410ea23a0b89745b0c77242b925a03aa172b`.++3. **If the test fails: stop. Block the release.** The cause is one of:+   - The new GHC changed `tyConModule` / `tyConName` semantics for one+     of the slot types (`Int` / `UTCTime` / `Text`). File an upstream+     GHC bug AND ship a `CanonicalTypeName` migration path for affected+     users (override the canonical name to the old value via+     `instance CanonicalTypeName Int where canonicalTypeName _ = "GHC.Types.Int"`,+     and bump the package's major version because the hash that+     in-flight snapshots carry is no longer derivable).+   - `renderStableTypeRep` has acquired an unintentional dependency on+     a non-stable accessor. Fix the keiki-side code; the hash for any+     stably-named type must continue to match the pinned golden.++4. Update `tested-with` in `keiki.cabal` (and `keiki-codec-json.cabal`+   for symmetry).++5. Add a release note explicitly flagging GHC X.Y.Z as validated+   against the golden hash.++The cross-GHC golden hash test is a **release-blocking gate**, not a+guideline. The whole point of the design is that drift cannot occur+silently; treating the test as advisory defeats the design (see EP-36+§8 in `docs/plans/36-regfile-json-codec-and-shape-hash-for-snapshot-persistence.md`).++## Performance bench drift++`bench/baseline.csv` is committed alongside the source. CI runs the+bench on every PR but does NOT block merges on drift. Reviewers should+look at the bench job output for unexpected slowdowns; > 20 % drift on+any single fixture × path pair is worth a comment. The GHC-9.12 golden+hash gate is the release blocker, not the bench, because (a) bench+numbers are noisier than hash determinism, and (b) the meaningful unit+of latency budget belongs to the consumer (keiro), not to keiki itself.++## Releasing++The full release procedure lives at+[`../docs/research/release-procedure.md`](../docs/research/release-procedure.md).+That document covers the coordinated push of `keiki`,+`keiki-codec-json`, and `keiki-codec-json-test`, the pre-publish+checklist, and the candidate-upload runbook. The EP-37 ExecPlan at+[`../docs/plans/37-coordinated-hackage-release-of-keiki-and-keiki-codec-json-v0-1.md`](../docs/plans/37-coordinated-hackage-release-of-keiki-and-keiki-codec-json-v0-1.md)+is the per-milestone narrative for the v0.1 first release.++## Adding a slot type to the test fixtures++If you add a new slot type to `Keiki.Codec.JSON.Fixtures.ExemplarSlots`,+the golden hash will change. Steps:++1. Update the fixture in `keiki-codec-json/test/Keiki/Codec/JSON/Fixtures.hs`.+2. Run `cabal test keiki-codec-json:keiki-codec-json-test`; capture the+   reported new hash from `GoldenSpec.hs`.+3. Update `keiki-codec-json/test/Keiki/Codec/JSON/GoldenSpec.hs` with the+   new pinned value.+4. Note the fixture change in the commit message; the cross-GHC gate's+   new baseline is implicitly established.

@@ -0,0 +1,228 @@+# keiki-codec-json++Optional JSON codec support for+[`keiki`](https://hackage.haskell.org/package/keiki)'s type-level+register file, `RegFile rs`.++This package is separate by design: the `keiki` core remains+`aeson`-free, while applications that persist snapshots as JSON can opt+in here. The structural shape hash+(`Keiki.Shape.regFileShapeHash`) stays in `keiki` so consumers can+discriminate snapshot shapes without pulling in a JSON dependency.++This package ships:++- `Keiki.Codec.JSON.RegFileToJSON` — three-method class providing+  - `regFileToJSON :: RegFile rs -> Aeson.Value` (strict object encoder)+  - `regFileFromJSON :: Aeson.Value -> Either String (RegFile rs)`+    (strict decoder; missing / extra / type-mismatched fields are+    rejected with a per-slot error message)+  - `regFileToEncoding :: RegFile rs -> Aeson.Encoding` — streaming+    encoder over `Aeson.Series`, avoiding the O(output-size)+    intermediate `Aeson.Value` allocation for users with multi-MB slot+    values+- `Keiki.Codec.JSON.TH` — Template Haskell helpers for deriving record+  codecs through the same `RegFileToJSON` path+- `Keiki.Codec.JSON.Event` — Template Haskell helpers for generating a+  `kind`-discriminated event codec skeleton from event sum types++## Using++```haskell+import Data.Proxy (Proxy (..))+import Keiki.Codec.JSON (regFileFromJSON, regFileToEncoding, regFileToJSON)+import Keiki.Shape (regFileShapeHash)++type Snapshot = '[ '("retryCount", Int), '("note", Text) ]++-- Snapshot persister:+let bytes = encodingToLazyByteString (regFileToEncoding rf)+    hash = regFileShapeHash (Proxy @Snapshot)+writeRow (snapshotTable hash bytes)++-- Hydration:+case Aeson.decode bytes of+  Nothing -> Left "snapshot bytes not JSON"+  Just v  -> regFileFromJSON @Snapshot v+```++## Deriving the codec for a record type++If you have a plain Haskell record and want the three codec functions+without writing them by hand, use the TH splice from+`Keiki.Codec.JSON.TH`:++```haskell+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell #-}++import qualified Data.Aeson as Aeson+import Data.Text (Text)+import GHC.Generics (Generic)+import Keiki.Codec.JSON.TH (deriveRegFileCodec)++data Snapshot = Snapshot+  { retryCount :: Int+  , note       :: Text+  }+  deriving stock (Eq, Show, Generic)++$(deriveRegFileCodec ''Snapshot)+-- emits:+--   snapshotToJSON     :: Snapshot -> Aeson.Value+--   snapshotToEncoding :: Snapshot -> Aeson.Encoding+--   snapshotFromJSON   :: Aeson.Value -> Either String Snapshot+```++The emitted functions route through the same `RegFileToJSON` class as+the hand-written path: the record's field names become the JSON object's+keys, missing/extra/type-mismatched fields are rejected with the same+per-slot error messages, and the encoding path streams without+allocating an intermediate `Aeson.Value`.++Every field type must carry `Aeson.ToJSON` + `Aeson.FromJSON`. If a+field type lacks either instance, compilation fails at the use site of+the emitted function with a precise per-field error pointing at the+missing instance.++The record must have `deriving (Generic)` — the splice does not emit+a `Generic` instance for you. Multi-constructor sum types, positional+(non-record-syntax) constructors, and type synonyms are rejected at+splice time with a precise error message.++## Deriving an event codec skeleton++A service that stores its events as JSON usually hand-writes a+`kind`-discriminated encoder/decoder per event *sum* type — a large+`case` with one branch per constructor and one `.=` per payload field,+plus a matching parser. `deriveEventCodecSkeleton` (from+`Keiki.Codec.JSON.Event`) removes that boilerplate. Given a sum type whose+constructors each wrap a single record payload, or are no-argument+singletons:++```haskell+{-# LANGUAGE TemplateHaskell #-}++import qualified Data.Aeson as Aeson+import qualified Data.Map.Strict as Map+import qualified Data.Set as Set+import Data.Text (Text)+import Keiki.Codec.JSON.Event+  ( EventCodecOptions (..)+  , FieldCodec (..)+  , defaultEventCodecOptions+  , deriveEventCodecSkeleton+  )++newtype OrderId = OrderId Int deriving stock (Eq, Show)+orderIdToJSON   :: OrderId -> Aeson.Value+orderIdFromJSON :: Aeson.Value -> Either String OrderId++data PlacedData = PlacedData+  { orderId :: OrderId+  , qty     :: Int+  }+  deriving stock (Eq, Show)++data ShippedData = ShippedData+  { trackingNo :: Text+  }+  deriving stock (Eq, Show)++data OrderEvent+  = Placed PlacedData+  | Shipped ShippedData+  | Cancelled+  deriving stock (Eq, Show)++$(deriveEventCodecSkeleton+    defaultEventCodecOptions+      { fieldCodecOverrides =+          Map.fromList [("orderId", FieldCodec 'orderIdToJSON 'orderIdFromJSON)]+      , passthroughFields = Set.fromList ["qty", "trackingNo"]+      }+    ''OrderEvent)+-- emits, using the lower-cased type name as prefix:+--   orderEventToJSON     :: OrderEvent -> Aeson.Value+--   orderEventFromJSON   :: Aeson.Value -> Either String OrderEvent+--   orderEventEventTypes :: [Text]+--   orderEventKindMap    :: [(Text, Text)]+```++Each constructor encodes to an object carrying a `"kind"` discriminator+(its constructor name) plus one entry per payload field, so+`orderEventToJSON (Placed (PlacedData (OrderId 7) 3))` is+`{"kind":"Placed","orderId":"ord-7","qty":3}` — note `orderId` is the+override's output, not a generic `Int`. The `orderEventEventTypes` /+`orderEventKindMap` bindings are plain `Text` (no Keiro dependency) so a+downstream can feed them to Keiro's `Codec.eventTypes`.++**No silent generic fallback.** Each payload field is encoded by *name*:+an override (`fieldCodecOverrides`), a passthrough using the field's own+aeson instances (`passthroughFields`), or — for a field in neither —+whatever `onMissingCodec` says. The default `FailAtCompileTime` aborts the+splice listing every unhandled `<Event>.<field> :: <Type>`; the+alternative `EmitTodoBindings` emits a `_todo_<Event>_<field>` placeholder+that compiles but fails when evaluated. Adding a field to a payload+record therefore forces a compile-time decision instead of silently+changing, or dropping, the stored JSON.++Constructors that are multi-argument, use record syntax directly, or are+GADT/infix are rejected at splice time with a precise message; wrap a+single record payload type instead (`Placed PlacedData`).++## When to use the streaming encoder++`regFileToJSON` builds an `Aeson.Value` whose `Object` is an+`Aeson.KeyMap` — internally a `Map Key Value` in aeson 2.2, so its+serialised form orders keys alphabetically. `regFileToEncoding` walks+the slot list directly into `Aeson.Series` (slot-list order) without+materialising the intermediate `Aeson.Value`. Both paths round-trip+through `regFileFromJSON` to the same `RegFile`, but for multi-MB+RegFiles the Encoding path saves a substantial allocation (see+`bench/baseline.csv` — for the 5000-item batch reconciliation fixture+the Encoding path is ~1.5× faster and allocates roughly two-thirds the+bytes).++## Benchmarks++```sh+cabal bench keiki-codec-json:keiki-codec-json-bench+```++Four fixtures cover representative snapshot sizes:++| Fixture                | Scenario                 | Condensed size           |+|------------------------|--------------------------|--------------------------|+| `BenchA_ContractSign`  | Contract signing         | 5 parties, 50 audit rows |+| `BenchB_BatchRecon`    | Batch reconciliation     | 5,000 processedItems     |+| `BenchC_TicketAgg`     | Ticket aggregate         | 100 comments             |+| `BenchD_Auction`       | Auction                  | 1,000 bids               |++Per fixture: `encode-via-Value`, `encode-via-Encoding`, `decode`, `hash`.++`bench/baseline.csv` carries reference numbers from a GHC 9.12.2 run on+macOS aarch64. The benchmark is a tracked metric, not a correctness+gate; the golden shape-hash tests are the release-blocking checks.++## Test toolkit for downstream consumers++If you persist `RegFile rs` to JSON and want to guard against the+schema-evolution case the shape hash cannot catch by design — a+silent change to a slot type's `Aeson.ToJSON` instance — see the+sibling package+[`keiki-codec-json-test`](../keiki-codec-json-test/README.md). It+ships a per-slot-type golden-byte detector (`slotGoldenSpec`) plus+library versions of the round-trip and sensitivity disciplines,+parameterised over your own slot list. Production consumers of+`keiki-codec-json` do not need to depend on it.++## Test suite++```sh+cabal test keiki-codec-json:keiki-codec-json-test+```++Covers unit tests, four QuickCheck properties, schema-evolution+sensitivity assertions, and the golden hash fixture pinned for+GHC 9.12.*.

@@ -0,0 +1,198 @@+{-# OPTIONS_GHC -Wno-orphans #-}++-- | EP-36 M4 — performance baselines for the four §10 reference cases+-- (condensed to keep CI bench duration under ~30 seconds total).+--+-- For each fixture, four measurements:+--+-- * @encode-via-Value@      — @Aeson.encode . regFileToJSON@+-- * @encode-via-Encoding@   — @encodingToLazyByteString . regFileToEncoding@+-- * @decode@                — @regFileFromJSON . fromJust . Aeson.decode@+-- * @hash@                  — @regFileShapeHash (Proxy \@SlotList)@+--+-- Run with @cabal bench keiki-codec-json:keiki-codec-json-bench@. The+-- baseline numbers are checked in at @bench/baseline.csv@; CI compares+-- new runs against the baseline and flags drift, but DOES NOT block+-- merges. The GHC-9.12 golden hash gate (M5) is the release-blocking+-- gate; the bench is a tracked metric.+module Main (main) where++import Control.DeepSeq (NFData (..))+import Data.Aeson qualified as Aeson+import Data.Aeson.Encoding qualified as AesonEnc+import Data.ByteString.Lazy qualified as LBS+import Data.Proxy (Proxy (..))+import Data.Text (Text)+import Data.Text qualified as T+import Keiki.Codec.JSON (regFileFromJSON, regFileToEncoding, regFileToJSON)+import Keiki.Core (RegFile (..), Slot)+import Keiki.Shape (regFileShapeHash)+import Test.Tasty.Bench (bench, bgroup, defaultMain, nf)++-- * NFData for RegFile rs (bench-local orphan) -------------------------------++-- Bench measurements use 'nf', which needs 'NFData'. Inductive walker+-- forces every slot's value to normal form via the slot type's+-- 'NFData' instance.+class NFDataRegFile (rs :: [Slot]) where+  rnfRegFile :: RegFile rs -> ()++instance NFDataRegFile '[] where+  rnfRegFile RNil = ()++instance+  (NFData t, NFDataRegFile rs) =>+  NFDataRegFile ('(s, t) ': rs)+  where+  rnfRegFile (RCons _ x rest) = rnf x `seq` rnfRegFile rest++instance (NFDataRegFile rs) => NFData (RegFile rs) where+  rnf = rnfRegFile++-- * §10 Case A — Multi-party contract signing (condensed) -------------------++--+-- 5 parties, 50 audit entries → ~5 KB encoded.++type SlotsA =+  '[ '("retryCount", Int),+     '("auditLog", [Text]),+     '("currentPhase", Text)+   ]++fixtureA :: RegFile SlotsA+fixtureA =+  RCons (Proxy @"retryCount") 3 $+    RCons (Proxy @"auditLog") (replicate 50 (T.pack "audit:partial-signature-recorded")) $+      RCons (Proxy @"currentPhase") (T.pack "phase-3-awaiting-final-signature") RNil++-- * §10 Case B — Long-running batch reconciliation (condensed) --------------++--+-- 5000 processed items → ~250 KB encoded. This is the streaming-encoder+-- motivating case (R10) — the Value path allocates the intermediate+-- @Aeson.Value@ for the whole list; the Encoding path walks slot-by-+-- slot.++type SlotsB =+  '[ '("processedItems", [(Int, Text)]),+     '("phase", Text)+   ]++fixtureB :: RegFile SlotsB+fixtureB =+  RCons+    (Proxy @"processedItems")+    [(i, T.pack ("item-result-" <> show i)) | i <- [1 .. 5000]]+    $ RCons (Proxy @"phase") (T.pack "reconciling") RNil++-- * §10 Case C — Customer support ticket aggregate (condensed) --------------++--+-- 100 comments + 10 escalation entries → ~25 KB encoded.++type SlotsC =+  '[ '("comments", [Text]),+     '("escalationHistory", [Text]),+     '("priority", Text),+     '("channel", Text)+   ]++fixtureC :: RegFile SlotsC+fixtureC =+  RCons+    (Proxy @"comments")+    [ T.pack ("comment-" <> show i <> ": " <> "lorem-ipsum-dolor-sit-amet")+    | i <- [1 :: Int .. 100]+    ]+    $ RCons+      (Proxy @"escalationHistory")+      [T.pack ("escalation-" <> show i) | i <- [1 :: Int .. 10]]+    $ RCons (Proxy @"priority") (T.pack "high")+    $ RCons (Proxy @"channel") (T.pack "email") RNil++-- * §10 Case D — Real-time auction aggregate (condensed) --------------------++--+-- 1000 bids → ~50 KB encoded. High-write-rate snapshot pressure.++type SlotsD =+  '[ '("bidHistory", [(Int, Int)]),+     '("status", Text),+     '("watchers", [Int])+   ]++fixtureD :: RegFile SlotsD+fixtureD =+  RCons+    (Proxy @"bidHistory")+    [(t, t * 110 + 5000) | t <- [1 :: Int .. 1000]]+    $ RCons (Proxy @"status") (T.pack "active")+    $ RCons (Proxy @"watchers") [10000 .. 10100] RNil++-- * Driver -------------------------------------------------------------------++main :: IO ()+main = do+  let bytesA = Aeson.encode (regFileToJSON fixtureA)+      bytesB = Aeson.encode (regFileToJSON fixtureB)+      bytesC = Aeson.encode (regFileToJSON fixtureC)+      bytesD = Aeson.encode (regFileToJSON fixtureD)+  -- Force the input bytes so the decode benchmark isn't paying for+  -- the encode work as a side effect.+  _ <-+    pure $!+      LBS.length bytesA+        + LBS.length bytesB+        + LBS.length bytesC+        + LBS.length bytesD+  defaultMain+    [ bgroup+        "BenchA_ContractSign"+        [ bench "encode-via-Value" $ nf (Aeson.encode . regFileToJSON) fixtureA,+          bench "encode-via-Encoding" $ nf (AesonEnc.encodingToLazyByteString . regFileToEncoding) fixtureA,+          bench "decode" $ nf (decodeFixtureA) bytesA,+          bench "hash" $ nf (\() -> regFileShapeHash (Proxy @SlotsA)) ()+        ],+      bgroup+        "BenchB_BatchRecon"+        [ bench "encode-via-Value" $ nf (Aeson.encode . regFileToJSON) fixtureB,+          bench "encode-via-Encoding" $ nf (AesonEnc.encodingToLazyByteString . regFileToEncoding) fixtureB,+          bench "decode" $ nf (decodeFixtureB) bytesB,+          bench "hash" $ nf (\() -> regFileShapeHash (Proxy @SlotsB)) ()+        ],+      bgroup+        "BenchC_TicketAgg"+        [ bench "encode-via-Value" $ nf (Aeson.encode . regFileToJSON) fixtureC,+          bench "encode-via-Encoding" $ nf (AesonEnc.encodingToLazyByteString . regFileToEncoding) fixtureC,+          bench "decode" $ nf (decodeFixtureC) bytesC,+          bench "hash" $ nf (\() -> regFileShapeHash (Proxy @SlotsC)) ()+        ],+      bgroup+        "BenchD_Auction"+        [ bench "encode-via-Value" $ nf (Aeson.encode . regFileToJSON) fixtureD,+          bench "encode-via-Encoding" $ nf (AesonEnc.encodingToLazyByteString . regFileToEncoding) fixtureD,+          bench "decode" $ nf (decodeFixtureD) bytesD,+          bench "hash" $ nf (\() -> regFileShapeHash (Proxy @SlotsD)) ()+        ]+    ]++decodeFixtureA :: LBS.ByteString -> Either String (RegFile SlotsA)+decodeFixtureA bs = case Aeson.decode bs of+  Nothing -> Left "Aeson.decode failed"+  Just v -> regFileFromJSON v++decodeFixtureB :: LBS.ByteString -> Either String (RegFile SlotsB)+decodeFixtureB bs = case Aeson.decode bs of+  Nothing -> Left "Aeson.decode failed"+  Just v -> regFileFromJSON v++decodeFixtureC :: LBS.ByteString -> Either String (RegFile SlotsC)+decodeFixtureC bs = case Aeson.decode bs of+  Nothing -> Left "Aeson.decode failed"+  Just v -> regFileFromJSON v++decodeFixtureD :: LBS.ByteString -> Either String (RegFile SlotsD)+decodeFixtureD bs = case Aeson.decode bs of+  Nothing -> Left "Aeson.decode failed"+  Just v -> regFileFromJSON v

@@ -0,0 +1,17 @@+Name,Mean (ps),2*Stdev (ps),Allocated,Copied,Peak Memory+All.BenchA_ContractSign.encode-via-Value,6807769,347816,34269,2,49283072+All.BenchA_ContractSign.encode-via-Encoding,3387927,264216,16065,0,65011712+All.BenchA_ContractSign.decode,12882232,1220802,106640,20,65011712+All.BenchA_ContractSign.hash,1747040,133960,5737,0,65011712+All.BenchB_BatchRecon.encode-via-Value,1311845312,130324330,6544326,89657,65011712+All.BenchB_BatchRecon.encode-via-Encoding,890765625,52914452,4256444,105,65011712+All.BenchB_BatchRecon.decode,2989114062,286069958,16482818,368064,65011712+All.BenchB_BatchRecon.hash,1784275,106480,5737,0,65011712+All.BenchC_TicketAgg.encode-via-Value,15564422,1321522,97357,7,65011712+All.BenchC_TicketAgg.encode-via-Encoding,7660565,566564,57640,0,78643200+All.BenchC_TicketAgg.decode,30095593,2245184,243181,55,78643200+All.BenchC_TicketAgg.hash,1799739,107384,5806,0,78643200+All.BenchD_Auction.encode-via-Value,234994824,16470910,1291776,4027,78643200+All.BenchD_Auction.encode-via-Encoding,153516113,10548170,778679,16,78643200+All.BenchD_Auction.decode,521485937,36636576,3347864,16826,78643200+All.BenchD_Auction.hash,1748992,160464,5772,0,78643200

@@ -0,0 +1,121 @@+cabal-version:      3.0+name:               keiki-codec-json+version:            0.1.0.0+synopsis:           Optional JSON codec for keiki's RegFile.+description:+  Sibling package to keiki providing a JSON encoder, decoder, and+  streaming encoder for @RegFile rs@. The keiki core remains+  aeson-free; this package opts in. See keiki's @Keiki.Shape@+  module for the GHC-upgrade-safe shape hash used to discriminate+  snapshots — the two halves of the snapshot persistence story.+  .+  Three methods on @class RegFileToJSON rs@:+  .+  * @regFileToJSON :: RegFile rs -> Aeson.Value@ — strict+  Value-path encoder.+  .+  * @regFileFromJSON :: Aeson.Value -> Either String (RegFile rs)@+  — strict decoder with per-slot error messages on missing /+  extra / type-mismatched fields.+  .+  * @regFileToEncoding :: RegFile rs -> Aeson.Encoding@ —+  streaming encoder over @Aeson.Series@, avoiding the+  O(output-size) intermediate @Aeson.Value@ allocation. Recommended+  for RegFiles with multi-MB slot values.+  .+  Also ships a Template Haskell helper module+  @Keiki.Codec.JSON.TH@ with @deriveRegFileCodec@ that emits the+  three codec functions for a record type with @deriving Generic@.+  .+  The companion package @keiki-codec-json-test@ ships a property-+  test toolkit for downstream consumers (case-#10 ToJSON-change+  detector plus library-ised round-trip / sensitivity helpers).++license:            BSD-3-Clause+author:             Nadeem Bitar+maintainer:         nadeem@gmail.com+copyright:          2026 Nadeem Bitar+category:           Codec+build-type:         Simple+tested-with:        GHC >=9.12 && <9.13+extra-doc-files:+  CHANGELOG.md+  CONTRIBUTING.md+  README.md++extra-source-files: bench/baseline.csv++common warnings+  ghc-options:+    -Wall -Wcompat -Widentities -Wincomplete-record-updates+    -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints++common shared-extensions+  default-language:   GHC2024+  default-extensions:+    AllowAmbiguousTypes+    DuplicateRecordFields+    FunctionalDependencies+    OverloadedLabels+    OverloadedRecordDot+    OverloadedStrings+    UndecidableInstances++library+  import:          warnings, shared-extensions+  exposed-modules:+    Keiki.Codec.JSON+    Keiki.Codec.JSON.Event+    Keiki.Codec.JSON.TH++  hs-source-dirs:  src+  build-depends:+    , aeson             ^>=2.2+    , base              ^>=4.21+    , containers        ^>=0.7+    , keiki             ^>=0.1+    , template-haskell  ^>=2.23+    , text              ^>=2.1++benchmark keiki-codec-json-bench+  import:         warnings, shared-extensions+  type:           exitcode-stdio-1.0+  hs-source-dirs: bench+  main-is:        Bench.hs+  build-depends:+    , aeson             ^>=2.2+    , base              ^>=4.21+    , bytestring        ^>=0.12+    , deepseq           ^>=1.5+    , keiki             ^>=0.1+    , keiki-codec-json  ^>=0.1+    , tasty-bench       ^>=0.4  || ^>=0.5+    , text              ^>=2.1++  ghc-options:    -fproc-alignment=64 "-with-rtsopts=-A32m -T"++test-suite keiki-codec-json-test+  import:         warnings, shared-extensions+  type:           exitcode-stdio-1.0+  hs-source-dirs: test+  main-is:        Spec.hs+  other-modules:+    Keiki.Codec.JSON.Fixtures+    Keiki.Codec.JSON.GoldenSpec+    Keiki.Codec.JSON.PropSpec+    Keiki.Codec.JSON.SensitivitySpec+    Keiki.Codec.JSON.THEventSpec+    Keiki.Codec.JSON.THSpec++  build-depends:+    , aeson                 ^>=2.2+    , base                  ^>=4.21+    , bytestring            ^>=0.12+    , containers            ^>=0.7+    , hspec                 ^>=2.11+    , keiki                 ^>=0.1+    , keiki-codec-json      ^>=0.1+    , QuickCheck            ^>=2.15+    , quickcheck-instances  ^>=0.3+    , text                  ^>=2.1+    , time                  ^>=1.14

@@ -0,0 +1,169 @@+-- |+-- Module      : Keiki.Codec.JSON+-- Description : JSON encoder, decoder, and streaming encoder for @RegFile rs@.+--+-- This module is the public entry point of the @keiki-codec-json@+-- package. It provides+--+-- * 'regFileToJSON'      — strict 'Aeson.Value' encoder.+-- * 'regFileFromJSON'    — strict decoder (rejects missing, extra, or+--   type-mismatched fields with a per-slot error message).+-- * 'regFileToEncoding'  — streaming encoder that walks the slot list+--   directly into 'Aeson.Series', avoiding the O(output-size)+--   intermediate 'Aeson.Value' allocation. Use this on RegFiles whose+--   slot /values/ are large (multi-MB) — see §10 case B in+--   @docs\/plans\/36-regfile-json-codec-and-shape-hash-for-snapshot-persistence.md@.+--+-- The codec is the keiki-side counterpart of the shape hash in+-- @Keiki.Shape@ ("keiki" package). Together they implement the+-- snapshot persistence story: the hash discriminates eligible+-- snapshots (catches structural drift, EP-36 §4 cases #1–9); the+-- codec serialises the eligible ones.+--+-- == Slot-value size guidance (P11)+--+-- keiki's per-slot dispatch overhead is microseconds at any realistic+-- slot count (< 1000 slots). The actual cost of encoding is dominated+-- by each slot type's 'Aeson.ToJSON'/'Aeson.FromJSON' instance and the+-- size of the value it carries. The §10 reference cases in EP-36+-- exhibit RegFiles of 50 KB to 10 MB encoded; this codec serves all of+-- them, but users carrying multi-megabyte slot values should:+--+-- 1. Call 'regFileToEncoding' (this module) instead of 'regFileToJSON'+--    to avoid the O(output-size) intermediate 'Aeson.Value' allocation.+--    Concretely: use+--    @'Aeson.encodingToLazyByteString' . 'regFileToEncoding'@ instead+--    of @'Aeson.encode' . 'regFileToJSON'@.+-- 2. Consider whether the bulk slot belongs in the RegFile at all —+--    for some workloads, splitting bulk data into a separate event+--    stream and projecting it via subscriptions is structurally+--    cleaner than carrying it in the workflow's RegFile.+module Keiki.Codec.JSON+  ( -- * The codec class+    RegFileToJSON (..),++    -- * Internal helper (exported so its instances are reachable; users++    -- typically program against 'RegFileToJSON' only)+    RegFileWalk,+  )+where++import Data.Aeson ((.=))+import Data.Aeson qualified as Aeson+import Data.Aeson.Key qualified as Key+import Data.Aeson.KeyMap qualified as KeyMap+import Data.Aeson.Types qualified as Aeson (Pair)+import Data.Proxy (Proxy (..))+import GHC.TypeLits (KnownSymbol, symbolVal)+import Keiki.Core (RegFile (..), Slot)++-- * Internal walker -----------------------------------------------------------++-- | Inductive walker over a slot list. Internal helper that powers the+-- three public methods on 'RegFileToJSON'; the auto-derived instances+-- cover any slot list whose components satisfy 'Aeson.ToJSON' and+-- 'Aeson.FromJSON'. Users program against 'RegFileToJSON', not against+-- this class.+class RegFileWalk (rs :: [Slot]) where+  -- | The slot list as a flat list of @(Key, Value)@ pairs, in+  -- slot-list order. Used to build 'Aeson.Value' via 'Aeson.object'.+  regFilePairs :: RegFile rs -> [Aeson.Pair]++  -- | The slot list as an 'Aeson.Series', in slot-list order. Used to+  -- build 'Aeson.Encoding' via 'Aeson.pairs', avoiding the+  -- 'Aeson.Value' intermediate.+  regFileSeries :: RegFile rs -> Aeson.Series++  -- | Consume slots from an 'Aeson.Object', returning the populated+  -- 'RegFile' and the leftover keys. The top-level decoder+  -- ('regFileFromJSON') uses the leftover to reject extra fields.+  regFileReadObject ::+    Aeson.Object ->+    Either String (RegFile rs, Aeson.Object)++instance RegFileWalk '[] where+  regFilePairs _ = []+  regFileSeries _ = mempty+  regFileReadObject km = Right (RNil, km)++instance+  ( KnownSymbol s,+    Aeson.ToJSON t,+    Aeson.FromJSON t,+    RegFileWalk rs+  ) =>+  RegFileWalk ('(s, t) ': rs)+  where+  regFilePairs (RCons _ x rest) =+    let k = Key.fromString (symbolVal (Proxy @s))+     in (k .= x) : regFilePairs rest++  regFileSeries (RCons _ x rest) =+    let k = Key.fromString (symbolVal (Proxy @s))+     in (k .= x) <> regFileSeries rest++  regFileReadObject km =+    let slotName = symbolVal (Proxy @s)+        k = Key.fromString slotName+     in case KeyMap.lookup k km of+          Nothing -> Left (slotName <> ": missing slot")+          Just slotVal -> case Aeson.fromJSON slotVal of+            Aeson.Error msg -> Left (slotName <> ": " <> msg)+            Aeson.Success x -> do+              (rest, km') <- regFileReadObject (KeyMap.delete k km)+              Right (RCons (Proxy @s) x rest, km')++-- * Public class --------------------------------------------------------------++-- | The codec class for 'RegFile' slot lists.+--+-- A slot list @rs@ supports JSON serialisation iff every slot value+-- type carries both 'Aeson.ToJSON' and 'Aeson.FromJSON'. The instance+-- is auto-derived for any such slot list — users do not write+-- 'RegFileToJSON' instances themselves; the structural inductive+-- 'RegFileWalk' instances do the work.+--+-- The three methods correspond to the three columns in EP-36 §3:+--+-- * 'regFileToJSON'     — R1, strict encoder over 'Aeson.Value'.+-- * 'regFileFromJSON'   — R2, strict decoder (missing / extra / type-+--   mismatched fields are 'Left' with a per-slot error message).+-- * 'regFileToEncoding' — R10, streaming encoder over 'Aeson.Encoding'+--   that avoids the 'Aeson.Value' intermediate.+class (RegFileWalk rs) => RegFileToJSON (rs :: [Slot]) where+  -- | Encode a slot list as a JSON object whose keys are the slot+  -- symbols, in slot-list order.+  regFileToJSON :: RegFile rs -> Aeson.Value+  regFileToJSON = Aeson.object . regFilePairs++  -- | Streaming encoder. Walks the slot list directly into an+  -- 'Aeson.Series' via 'Aeson.pairs', avoiding the+  -- 'Aeson.Value' intermediate. Recommended for RegFiles with+  -- multi-MB slot values; see the module header's "Slot-value size+  -- guidance".+  regFileToEncoding :: RegFile rs -> Aeson.Encoding+  regFileToEncoding = Aeson.pairs . regFileSeries++  -- | Strict decoder. Returns @Left "\<slotName\>: \<reason\>"@ on any+  -- of: missing slot, type-mismatched slot, malformed JSON, or+  -- unknown extra field at the top level.+  regFileFromJSON :: Aeson.Value -> Either String (RegFile rs)+  regFileFromJSON v = case v of+    Aeson.Object km -> do+      (rf, leftover) <- regFileReadObject km+      if KeyMap.null leftover+        then Right rf+        else+          Left+            ( "regfile: unknown extra fields: "+                <> show (map Key.toString (KeyMap.keys leftover))+            )+    _ -> Left "regfile: expected JSON Object"++-- | Generic instance: every slot list with the inductive 'RegFileWalk'+-- coverage is a 'RegFileToJSON'. Users do not write instances of this+-- class themselves; the inductive 'RegFileWalk' instances (one for+-- @'[]@, one for @\'(s, t) \': rs@) cover every slot list whose+-- component types carry 'Aeson.ToJSON' and 'Aeson.FromJSON'.+instance (RegFileWalk rs) => RegFileToJSON rs

@@ -0,0 +1,512 @@+{-# LANGUAGE TemplateHaskell #-}++-- |+-- Module      : Keiki.Codec.JSON.Event+-- Description : Template Haskell that derives a @kind@-discriminated JSON+--               encoder/decoder skeleton for an event /sum/ type.+--+-- Where 'Keiki.Codec.JSON.TH.deriveRegFileCodec' handles a single-record+-- snapshot, this module handles an event sum — a @data@ type with several+-- constructors, each wrapping a single record payload (or a no-arg+-- singleton). For+--+-- > data OrderEvent+-- >   = Placed PlacedData+-- >   | Shipped ShippedData+-- >   | Cancelled+-- >   deriving stock (Eq, Show)+--+-- the splice @$(deriveEventCodecSkeleton opts ''OrderEvent)@ emits four+-- top-level bindings (prefix derived by lower-casing the first letter of the+-- type name):+--+-- > orderEventToJSON     :: OrderEvent -> Aeson.Value+-- > orderEventFromJSON   :: Aeson.Value -> Either String OrderEvent+-- > orderEventEventTypes :: [Data.Text.Text]                    -- ctor names, in order+-- > orderEventKindMap    :: [(Data.Text.Text, Data.Text.Text)]  -- (ctor, kind)+--+-- Each constructor encodes to a JSON object carrying a @"kind"@+-- discriminator (the constructor name) plus one entry per payload field.+-- The decoder reads @"kind"@, branches, and reassembles the payload field+-- by field.+--+-- == No silent generic fallback (the anti-drift property)+--+-- A payload field is encoded one of three ways, chosen by /field name/:+--+--   * if its name is a key of 'fieldCodecOverrides', the author-supplied+--     'FieldCodec' functions are spliced in;+--   * else if its name is in 'passthroughFields', the field's own+--     'Aeson.ToJSON' \/ 'Aeson.FromJSON' instances are used;+--   * otherwise the field is /unhandled/, and 'onMissingCodec' decides:+--     'FailAtCompileTime' (the default) aborts the splice listing every+--     unhandled field, while 'EmitTodoBindings' emits a clearly-named+--     @_todo_Event_field@ placeholder that compiles but is+--     @error "TODO: ..."@-bodied.+--+-- There is never a quiet generic guess: adding a field to a payload record+-- forces the author to make a decision at compile time.+--+-- This module lives in @keiki-codec-json@, not @keiki@ core, because the+-- generated code references @aeson@ and @keiki@ core must stay aeson-free+-- (EP-36 §3 R8; MP-11 Decision Log). It consumes no keiki-core symbols at+-- all; the constructor/field reflection mirrors @keiki@'s+-- @Keiki.Generics.TH@ (@conPayload@, @genTermFieldsRecord@) so the two stay+-- aligned.+--+-- == Negative-test procedure (manual)+--+-- See @Keiki.Codec.JSON.THEventSpec@ for the documented procedure that+-- exercises the 'FailAtCompileTime' and 'EmitTodoBindings' behaviours; the+-- two cases cannot live as a passing unit test because one is a compile+-- failure.+module Keiki.Codec.JSON.Event+  ( -- * Options+    FieldCodec (..),+    OnMissingCodec (..),+    EventCodecOptions (..),+    defaultEventCodecOptions,++    -- * Splices+    deriveEventCodecSkeleton,+    deriveEventCodecSkeletonAs,++    -- * Runtime helpers (referenced by generated code; not usually called directly)+    lookupField,+    lookupText,+    aesonResultToEither,+  )+where++import Data.Aeson qualified as Aeson+import Data.Aeson.Key qualified as Key+import Data.Aeson.KeyMap qualified as KeyMap+import Data.Char (toLower)+import Data.List (intercalate)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Set (Set)+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Language.Haskell.TH++-- * Public option types ------------------------------------------------------++-- | A per-field encode/decode hook. Both fields name top-level functions+-- to splice in (so the hook is untyped at the TH boundary):+--+--   * 'fcEncode' names a function @fieldType -> Aeson.Value@ (e.g. @idText@);+--   * 'fcDecode' names a function @Aeson.Value -> Either String fieldType@+--     (e.g. @parseIdText@).+data FieldCodec = FieldCodec+  { fcEncode :: Name,+    fcDecode :: Name+  }++-- | What to do for a payload field whose name appears in neither+-- 'fieldCodecOverrides' nor 'passthroughFields'.+data OnMissingCodec+  = -- | Default: abort the splice with @fail@, listing every unhandled field.+    FailAtCompileTime+  | -- | Emit a named @_todo_\<Event\>_\<field\>@ stub and route the field+    --       through it, so the module compiles but any use throws an+    --       obviously-named @error@.+    EmitTodoBindings++-- | Options controlling 'deriveEventCodecSkeleton'.+data EventCodecOptions = EventCodecOptions+  { -- | keyed by payload field name (e.g. @"reservationId"@, @"divertStatus"@)+    fieldCodecOverrides :: Map String FieldCodec,+    -- | field names whose type already has aeson instances and may use them+    --     directly (e.g. @"sourceMessageId"@, @"lifeCriticalOverride"@)+    passthroughFields :: Set String,+    -- | the discriminator key; default @"kind"@+    kindFieldName :: String,+    -- | behaviour for unhandled fields; default 'FailAtCompileTime'+    onMissingCodec :: OnMissingCodec+  }++-- | Empty overrides, empty passthrough, @kindFieldName = "kind"@,+-- @onMissingCodec = 'FailAtCompileTime'@.+defaultEventCodecOptions :: EventCodecOptions+defaultEventCodecOptions =+  EventCodecOptions+    { fieldCodecOverrides = Map.empty,+      passthroughFields = Set.empty,+      kindFieldName = "kind",+      onMissingCodec = FailAtCompileTime+    }++-- * Runtime helpers (referenced by generated code) ---------------------------++-- | Look a key up in a JSON object, with a per-field error on absence.+lookupField :: Key.Key -> Aeson.Object -> Either String Aeson.Value+lookupField k o = case KeyMap.lookup k o of+  Just v -> Right v+  Nothing -> Left ("missing field: " <> Key.toString k)++-- | Look a key up and require its value to be a JSON string.+lookupText :: Key.Key -> Aeson.Object -> Either String Text+lookupText k o = do+  v <- lookupField k o+  case v of+    Aeson.String t -> Right t+    _ -> Left ("field " <> Key.toString k <> ": expected a string")++-- | Adapt aeson's 'Aeson.Result' to @Either String@.+aesonResultToEither :: Aeson.Result a -> Either String a+aesonResultToEither (Aeson.Success a) = Right a+aesonResultToEither (Aeson.Error e) = Left e++-- * Splices ------------------------------------------------------------------++-- | Derive the @kind@-discriminated codec skeleton for an event sum type,+-- with the function-name prefix derived from the type name by lower-casing+-- its first letter.+deriveEventCodecSkeleton :: EventCodecOptions -> Name -> Q [Dec]+deriveEventCodecSkeleton opts n = deriveEventCodecSkeletonAs (defaultPrefix n) opts n++-- | Variant of 'deriveEventCodecSkeleton' taking the prefix explicitly,+-- mirroring 'Keiki.Codec.JSON.TH.deriveRegFileCodecAs'.+deriveEventCodecSkeletonAs :: String -> EventCodecOptions -> Name -> Q [Dec]+deriveEventCodecSkeletonAs prefix opts tyName = do+  ctors <- reifyEventCtors tyName+  case ctors of+    [] ->+      fail $+        "deriveEventCodecSkeleton: "+          <> show tyName+          <> " has no constructors; pass an event sum type."+    _ -> pure ()++  -- No-silent-fallback safety net: classify each payload field; an+  -- unhandled field is one in neither overrides nor passthrough.+  let unhandled =+        [ (ecCtorName ec, fn, ft)+        | ec <- ctors,+          (_, fields) <- maybe [] (: []) (ecPayload ec),+          (fn, _sel, ft) <- fields,+          isUnhandled opts fn+        ]+  todoBindings <- case onMissingCodec opts of+    FailAtCompileTime+      | not (null unhandled) ->+          fail $+            "deriveEventCodecSkeleton: "+              <> show tyName+              <> " has field(s) with no provided codec and "+              <> "onMissingCodec = FailAtCompileTime:\n"+              <> intercalate+                "\n"+                [ "  - " <> nameBase c <> "." <> fn <> " :: " <> pprint ft+                | (c, fn, ft) <- unhandled+                ]+              <> "\nAdd each field to fieldCodecOverrides or passthroughFields, "+              <> "or set onMissingCodec = EmitTodoBindings."+      | otherwise -> pure []+    EmitTodoBindings -> concat <$> mapM mkTodoBinding unhandled++  let toJSONN = mkName (prefix <> "ToJSON")+      fromJSONN = mkName (prefix <> "FromJSON")+      eventTypesN = mkName (prefix <> "EventTypes")+      kindMapN = mkName (prefix <> "KindMap")+      tyT = conT tyName++  -- Encoder: one clause per constructor.+  toSig <- sigD toJSONN [t|$tyT -> Aeson.Value|]+  toDef <- funD toJSONN (map (encodeClause opts) ctors)++  -- Decoder: a single \v -> case ... clause.+  vVar <- newName "v"+  oVar <- newName "o"+  kVar <- newName "kind"+  fromSig <- sigD fromJSONN [t|Aeson.Value -> Either String $tyT|]+  fromDef <-+    funD+      fromJSONN+      [ clause+          [varP vVar]+          (normalB (decoderBody opts prefix vVar oVar kVar ctors))+          []+      ]++  -- Keiro-feeding surfaces: plain Text, no Keiro import.+  etSig <- sigD eventTypesN [t|[Text]|]+  etDef <-+    funD+      eventTypesN+      [ clause+          []+          ( normalB+              ( listE+                  [ [|T.pack $(stringE (nameBase (ecCtorName ec)))|]+                  | ec <- ctors+                  ]+              )+          )+          []+      ]+  kmSig <- sigD kindMapN [t|[(Text, Text)]|]+  kmDef <-+    funD+      kindMapN+      [ clause+          []+          ( normalB+              ( listE+                  [ [|(T.pack $(stringE nm), T.pack $(stringE nm))|]+                  | ec <- ctors,+                    let nm = nameBase (ecCtorName ec)+                  ]+              )+          )+          []+      ]++  pure $+    todoBindings+      <> [ toSig,+           toDef,+           fromSig,+           fromDef,+           etSig,+           etDef,+           kmSig,+           kmDef+         ]++-- * Encoder generation -------------------------------------------------------++-- | One @toJSON@ clause for a constructor.+encodeClause :: EventCodecOptions -> EvCtor -> Q Clause+encodeClause opts ec = case ecPayload ec of+  Nothing ->+    clause+      [conP (ecCtorName ec) []]+      (normalB [|Aeson.object [$(kindPair)]|])+      []+  Just (_pc, fields) -> do+    pVar <- newName "p"+    let pairs = kindPair : map (fieldPair opts (ecCtorName ec) pVar) fields+    clause+      [conP (ecCtorName ec) [varP pVar]]+      (normalB [|Aeson.object $(listE pairs)|])+      []+  where+    kindPair =+      [|+        $(keyE (kindFieldName opts))+          Aeson..= (T.pack $(stringE (nameBase (ecCtorName ec))) :: Text)+        |]++-- | One @"field" .= <encoded>@ pair.+fieldPair :: EventCodecOptions -> Name -> Name -> (String, Name, Type) -> Q Exp+fieldPair opts ctorName pVar f@(fn, _, _) =+  [|$(keyE fn) Aeson..= $(encodeFieldExpr opts ctorName pVar f)|]++-- | The encoded 'Aeson.Value' for one field of a constructor.+encodeFieldExpr :: EventCodecOptions -> Name -> Name -> (String, Name, Type) -> Q Exp+encodeFieldExpr opts ctorName pVar (fn, sel, _ft) =+  case classify opts fn of+    Override fc -> [|$(varE (fcEncode fc)) ($(varE sel) $(varE pVar))|]+    Passthrough -> [|Aeson.toJSON ($(varE sel) $(varE pVar))|]+    Unhandled ->+      [|($(varE (todoName ctorName fn)) ($(varE sel) $(varE pVar)) :: Aeson.Value)|]++-- * Decoder generation -------------------------------------------------------++-- | The full @fromJSON@ body: @case v of Object o -> ...; _ -> Left ...@.+decoderBody ::+  EventCodecOptions -> String -> Name -> Name -> Name -> [EvCtor] -> Q Exp+decoderBody opts prefix vVar oVar kVar ctors =+  caseE+    (varE vVar)+    [ match+        (conP 'Aeson.Object [varP oVar])+        ( normalB+            ( infixE+                (Just [|lookupText $(keyE (kindFieldName opts)) $(varE oVar)|])+                (varE '(>>=))+                (Just (lamE [varP kVar] (dispatch opts oVar kVar ctors)))+            )+        )+        [],+      match+        wildP+        (normalB [|Left $(stringE (prefix <> ": expected a JSON object"))|])+        []+    ]++-- | Nested @if kind == "C" then <build C> else ...@ ending in an+-- unknown-kind 'Left'.+dispatch :: EventCodecOptions -> Name -> Name -> [EvCtor] -> Q Exp+dispatch opts oVar kVar =+  foldr+    ( \ec elseQ ->+        [|+          if $(varE kVar) == T.pack $(stringE (nameBase (ecCtorName ec)))+            then $(buildCtorDecode opts oVar ec)+            else $elseQ+          |]+    )+    [|Left ("unknown event kind: " <> T.unpack $(varE kVar))|]++-- | Decode one constructor's payload: @C \<$> (PayloadCtor \<$> d1 \<*> ...)@.+buildCtorDecode :: EventCodecOptions -> Name -> EvCtor -> Q Exp+buildCtorDecode opts oVar ec = case ecPayload ec of+  Nothing -> [|Right $(conE (ecCtorName ec))|]+  Just (pc, fields) ->+    let decs = map (decodeFieldExpr opts oVar (ecCtorName ec)) fields+     in [|$(conE (ecCtorName ec)) <$> $(mkApplicative (conE pc) decs)|]++-- | Build @ctor \<$> d1 \<*> d2 \<*> ...@ (or @Right ctor@ for no fields)+-- in the @Either String@ applicative.+mkApplicative :: Q Exp -> [Q Exp] -> Q Exp+mkApplicative ctorQ [] = [|Right $ctorQ|]+mkApplicative ctorQ (d : ds) =+  foldl (\acc x -> [|$acc <*> $x|]) [|$ctorQ <$> $d|] ds++-- | @Either String fieldType@ decoder for one field.+decodeFieldExpr :: EventCodecOptions -> Name -> Name -> (String, Name, Type) -> Q Exp+decodeFieldExpr opts oVar ctorName (fn, _sel, _ft) =+  let getV = [|lookupField $(keyE fn) $(varE oVar)|]+   in case classify opts fn of+        Override fc -> [|$(varE (fcDecode fc)) =<< $getV|]+        Passthrough -> [|(aesonResultToEither . Aeson.fromJSON) =<< $getV|]+        Unhandled -> [|$(varE (todoName ctorName fn)) =<< $getV|]++-- * TODO bindings ------------------------------------------------------------++-- | The placeholder binding name for an unhandled field.+todoName :: Name -> String -> Name+todoName ctorName fn = mkName ("_todo_" <> nameBase ctorName <> "_" <> fn)++-- | Emit @_todo_C_field :: a; _todo_C_field = error "TODO: ..."@.+mkTodoBinding :: (Name, String, Type) -> Q [Dec]+mkTodoBinding (cn, fn, ft) = do+  let nm = todoName cn fn+      msg =+        "TODO: provide a FieldCodec for "+          <> nameBase cn+          <> "."+          <> fn+          <> " :: "+          <> pprint ft+  aV <- newName "a"+  sig <- sigD nm (varT aV)+  def <- funD nm [clause [] (normalB [|error $(stringE msg)|]) []]+  pure [sig, def]++-- * Field classification -----------------------------------------------------++-- | How one field is encoded/decoded.+data FieldClass+  = Override FieldCodec+  | Passthrough+  | Unhandled++classify :: EventCodecOptions -> String -> FieldClass+classify opts fn =+  case Map.lookup fn (fieldCodecOverrides opts) of+    Just fc -> Override fc+    Nothing+      | fn `Set.member` passthroughFields opts -> Passthrough+      | otherwise -> Unhandled++isUnhandled :: EventCodecOptions -> String -> Bool+isUnhandled opts fn =+  not (fn `Map.member` fieldCodecOverrides opts)+    && not (fn `Set.member` passthroughFields opts)++-- * Reflection ---------------------------------------------------------------++-- | A reflected event constructor: its name plus, for a payload+-- constructor, the payload record's data-constructor name and its+-- @(fieldName, selectorName, fieldType)@ list. 'Nothing' for a singleton.+data EvCtor = EvCtor+  { ecCtorName :: Name,+    ecPayload :: Maybe (Name, [(String, Name, Type)])+  }++reifyEventCtors :: Name -> Q [EvCtor]+reifyEventCtors tyName = do+  info <- reify tyName+  case info of+    TyConI (DataD _ _ _ _ ctors _) -> mapM (toEvCtor tyName) ctors+    TyConI (NewtypeD _ _ _ _ ctor _) -> mapM (toEvCtor tyName) [ctor]+    _ ->+      fail $+        "deriveEventCodecSkeleton: expected a data declaration for "+          <> show tyName+          <> ", got "+          <> show info++toEvCtor :: Name -> Con -> Q EvCtor+toEvCtor tyName con = case con of+  NormalC cn [] -> pure (EvCtor cn Nothing)+  NormalC cn [(_, payTy)] -> do+    payload <- reifyPayloadFields tyName cn payTy+    pure (EvCtor cn (Just payload))+  NormalC cn _ ->+    fail $+      "deriveEventCodecSkeleton: constructor "+        <> nameBase cn+        <> " of "+        <> show tyName+        <> " is multi-argument; wrap a single record payload "+        <> "type instead, e.g. `Placed PlacedData`."+  RecC cn _ ->+    fail $+      "deriveEventCodecSkeleton: constructor "+        <> nameBase cn+        <> " of "+        <> show tyName+        <> " uses record syntax directly; wrap a single record "+        <> "payload type instead, e.g. `Placed PlacedData`."+  _ ->+    fail $+      "deriveEventCodecSkeleton: "+        <> show tyName+        <> " has an unsupported constructor shape (infix or GADT)."++reifyPayloadFields :: Name -> Name -> Type -> Q (Name, [(String, Name, Type)])+reifyPayloadFields tyName cn payTy = do+  payName <- typeConName payTy+  info <- reify payName+  case info of+    TyConI (DataD _ _ _ _ [RecC pcn fs] _) -> pure (pcn, map field fs)+    TyConI (NewtypeD _ _ _ _ (RecC pcn fs) _) -> pure (pcn, map field fs)+    _ ->+      fail $+        "deriveEventCodecSkeleton: payload of constructor "+          <> nameBase cn+          <> " in "+          <> show tyName+          <> " must be a single record-syntax "+          <> "constructor type, got "+          <> show info+  where+    field (sel, _, ty) = (nameBase sel, sel, ty)++typeConName :: Type -> Q Name+typeConName (ConT n) = pure n+typeConName (SigT t _) = typeConName t+typeConName other =+  fail $+    "deriveEventCodecSkeleton: payload type must be a type constructor, "+      <> "got "+      <> show other++-- * Small helpers ------------------------------------------------------------++-- | Lower-case the first character of the type name for the conventional+-- function-name prefix.+defaultPrefix :: Name -> String+defaultPrefix n = case nameBase n of+  [] -> error "deriveEventCodecSkeleton: empty type name"+  (c : cs) -> toLower c : cs++-- | An 'Key.fromString'-built JSON key expression.+keyE :: String -> Q Exp+keyE s = [|Key.fromString $(stringE s)|]

@@ -0,0 +1,259 @@+{-# LANGUAGE TemplateHaskell #-}++-- \$('deriveRegFileCodec' \'\'MySnapshot)+-- @+--+-- to emit three top-level functions+--+-- @+-- mySnapshotToJSON     :: MySnapshot -> Aeson.Value+-- mySnapshotToEncoding :: MySnapshot -> Aeson.Encoding+-- mySnapshotFromJSON   :: Aeson.Value -> Either String MySnapshot+-- @+--+-- Each function routes through the existing+-- 'Keiki.Codec.JSON.RegFileToJSON' class against the slot list+-- @'Keiki.Generics.RegFieldsOf' MySnapshot@. The record's field names+-- become the JSON object's keys; the record's field types must each+-- carry 'Aeson.ToJSON' and 'Aeson.FromJSON' or compilation fails with a+-- precise per-field error.+--+-- This splice lives in @keiki-codec-json@ (not in @keiki@'s+-- @Keiki.Generics.TH@). The class @RegFileToJSON@ is defined here, and+-- moving the splice to @keiki@ would force an @aeson@ dependency on+-- @keiki@ core — violating the load-bearing+-- /keiki MUST NOT gain @aeson@/ requirement (EP-36 §3 R8; MP-11+-- Decision Log 2026-05-10). The splice does reuse the structural+-- machinery in @keiki@'s @Keiki.Generics@ ('Keiki.Generics.RegFieldsOf',+-- 'Keiki.Generics.gToRegFile', 'Keiki.Generics.gFromRegFile') so the+-- composition with the existing 'Keiki.Generics.TH' ergonomics+-- (@mkInCtorVia@, @mkWireCtorVia@, @deriveAggregateCtors@, etc.) is+-- preserved.++-- |+-- Module      : Keiki.Codec.JSON.TH+-- Description : Template Haskell helpers that emit @RegFile@-routed JSON+--               codec functions for plain Haskell record types.+--+-- A user with a record type+--+-- @+-- data MySnapshot = MySnapshot+--   { retryCount    :: Int+--   , correlationId :: Text+--   , dispatchedAt  :: UTCTime+--   }+--   deriving stock ('Eq', 'Show', GHC.Generics.'GHC.Generics.Generic')+-- @+--+-- invokes+--+-- @+module Keiki.Codec.JSON.TH+  ( deriveRegFileCodec,+    deriveRegFileCodecAs,+  )+where++import Data.Aeson qualified as Aeson+import Data.Char (toLower)+import GHC.Generics qualified as Generics+import Keiki.Codec.JSON (regFileFromJSON, regFileToEncoding, regFileToJSON)+import Keiki.Generics (RegFieldsOf, gFromRegFile, gToRegFile)+import Language.Haskell.TH+  ( Con (NormalC, RecC),+    Dec (DataD, NewtypeD, TySynD),+    Info (TyConI),+    Name,+    Q,+    clause,+    conT,+    funD,+    mkName,+    nameBase,+    normalB,+    reify,+    sigD,+  )++-- | Emit three top-level JSON-codec functions for the record type+-- @t@, with names derived from the type's name by lower-casing the+-- first character.+--+-- For @t = MySnapshot@ the splice emits+--+-- * @mySnapshotToJSON     :: MySnapshot -> Aeson.Value@+-- * @mySnapshotToEncoding :: MySnapshot -> Aeson.Encoding@+-- * @mySnapshotFromJSON   :: Aeson.Value -> Either String MySnapshot@+--+-- The record must have @deriving (Generic)@ (the splice does not+-- emit a @Generic@ instance). Every field type must have+-- @Aeson.ToJSON@ and @Aeson.FromJSON@ in scope, or compilation fails+-- at the use site of the emitted function with a missing-instance+-- error naming the field's type.+--+-- The splice rejects:+--+-- * Type synonyms, classes, value bindings, primitive types — only+--   @data@ and @newtype@ declarations are accepted.+-- * Multi-constructor types (@data Foo = A | B@) — a single slot list+--   cannot represent a sum.+-- * Positional (non-record-syntax) constructors — there are no field+--   names to use as slot symbols.+--+-- Singleton constructors with no fields (@data Empty = Empty@) are+-- accepted; the slot list is @'[]@ and the emitted functions codec+-- the empty JSON object.+deriveRegFileCodec :: Name -> Q [Dec]+deriveRegFileCodec n = deriveRegFileCodecAs (defaultPrefix n) n++-- | Variant of 'deriveRegFileCodec' that takes the function-name+-- prefix explicitly. The three emitted functions are named+-- @\<prefix\>ToJSON@, @\<prefix\>ToEncoding@, @\<prefix\>FromJSON@.+deriveRegFileCodecAs :: String -> Name -> Q [Dec]+deriveRegFileCodecAs prefix tyName = do+  validateRecord tyName+  let recTy = conT tyName+      toJSONN = mkName (prefix <> "ToJSON")+      toEncN = mkName (prefix <> "ToEncoding")+      fromJSONN = mkName (prefix <> "FromJSON")++  toJSONSig <-+    sigD+      toJSONN+      [t|$recTy -> Aeson.Value|]+  toJSONDef <-+    funD+      toJSONN+      [ clause+          []+          ( normalB+              [|+                regFileToJSON+                  @(RegFieldsOf $recTy)+                  . gToRegFile+                  . Generics.from+                |]+          )+          []+      ]++  toEncSig <-+    sigD+      toEncN+      [t|$recTy -> Aeson.Encoding|]+  toEncDef <-+    funD+      toEncN+      [ clause+          []+          ( normalB+              [|+                regFileToEncoding+                  @(RegFieldsOf $recTy)+                  . gToRegFile+                  . Generics.from+                |]+          )+          []+      ]++  fromJSONSig <-+    sigD+      fromJSONN+      [t|Aeson.Value -> Either String $recTy|]+  fromJSONDef <-+    funD+      fromJSONN+      [ clause+          []+          ( normalB+              [|+                fmap (Generics.to . gFromRegFile)+                  . regFileFromJSON+                    @(RegFieldsOf $recTy)+                |]+          )+          []+      ]++  pure+    [ toJSONSig,+      toJSONDef,+      toEncSig,+      toEncDef,+      fromJSONSig,+      fromJSONDef+    ]++-- * Internal helpers ---------------------------------------------------------++-- | Lower-case the first character of the type name to produce the+-- conventional function-name prefix.+defaultPrefix :: Name -> String+defaultPrefix n = case nameBase n of+  [] -> error "deriveRegFileCodec: empty type name"+  (c : cs) -> toLower c : cs++-- | Validate that @tyName@ refers to a single-constructor record-syntax+-- @data@ or @newtype@ declaration. Reject every other shape with a+-- precise error message.+validateRecord :: Name -> Q ()+validateRecord tyName = do+  info <- reify tyName+  case info of+    TyConI dec -> case dec of+      DataD _ _ _ _ ctors _ ->+        validateCtors tyName ctors+      NewtypeD _ _ _ _ ctor _ ->+        validateCtors tyName [ctor]+      TySynD {} ->+        failure "a type synonym; only `data` and `newtype` are supported"+      _ ->+        failure+          ( "an unsupported declaration shape; only `data` and "+              <> "`newtype` are supported"+          )+    _ ->+      failure+        ( "not a type constructor; pass a record type name like "+            <> "''MyRecord"+        )+  where+    failure :: String -> Q a+    failure detail =+      fail $ "deriveRegFileCodec: " <> show tyName <> " is " <> detail++-- | Inspect the constructor list. Accept iff there is exactly one+-- constructor, and that constructor is either @RecC@ (record syntax+-- with named fields) or @NormalC@ with zero positional arguments+-- (the no-field singleton case).+validateCtors :: Name -> [Con] -> Q ()+validateCtors tyName ctors = case ctors of+  [RecC _ _] -> pure ()+  [NormalC _ []] -> pure ()+  [NormalC _ _] ->+    fail $+      "deriveRegFileCodec: "+        <> show tyName+        <> " has a positional (non-record-syntax) "+        <> "constructor; switch to record syntax so "+        <> "field names are available as slot symbols, "+        <> "e.g. `data Foo = Foo { x :: Int }`."+  [] ->+    fail $+      "deriveRegFileCodec: "+        <> show tyName+        <> " has no constructors; pass a record type."+  (_ : _ : _) ->+    fail $+      "deriveRegFileCodec: "+        <> show tyName+        <> " has multiple constructors; a single slot "+        <> "list cannot represent a sum type."+  _ ->+    fail $+      "deriveRegFileCodec: "+        <> show tyName+        <> " has an unsupported constructor shape "+        <> "(infix or GADT); pass a plain record type."

@@ -0,0 +1,188 @@+{-# LANGUAGE DeriveAnyClass #-}++-- | Shared fixtures for the property, sensitivity, and golden hash+-- specs. Defines an exemplar slot list (used by every spec as the+-- baseline), schema-evolution mutations of it, and an inductive+-- 'Arbitrary' generator for 'RegFile rs'.+module Keiki.Codec.JSON.Fixtures+  ( -- * Baseline slot list+    ExemplarSlots,++    -- * Schema-evolution mutations (EP-36 §4 cases #1–9)+    AddSlots,+    RemoveSlots,+    RenameSlots,+    ReorderSlots,+    TypeChangeSameJsonSlots,+    NewtypeWrapSlots,+    RecordReplaceSlots,+    SplitSlots,+    RenamedTypeSlots,++    -- * Auxiliary types for the mutations+    OrderId (..),+    Address (..),+    RenamedAddress (..),++    -- * Arbitrary generator+    ArbitraryRegFile (..),+  )+where++import Data.Aeson qualified as Aeson+import Data.Proxy (Proxy (..))+import Data.Text (Text)+import Data.Time.Clock (UTCTime)+import Data.Word (Word32)+import GHC.Generics (Generic)+import GHC.TypeLits (KnownSymbol)+-- Arbitrary UTCTime, Text, etc.++import Keiki.Core (RegFile (..), Slot)+import Keiki.Shape (CanonicalTypeName)+import Test.QuickCheck (Arbitrary (..), Gen)+import Test.QuickCheck.Instances ()++-- * Baseline slot list -------------------------------------------------------++-- | Exemplar three-slot list used by every spec as the baseline against+-- which mutations are compared.+type ExemplarSlots =+  '[ '("retryCount", Int),+     '("cooldownUntil", UTCTime),+     '("correlationId", Text)+   ]++-- * Schema-evolution mutations (EP-36 §4) ------------------------------------++-- | §4 case #1 — Add slot. A fourth slot is appended to the baseline.+type AddSlots =+  '[ '("retryCount", Int),+     '("cooldownUntil", UTCTime),+     '("correlationId", Text),+     '("dispatchedAt", UTCTime)+   ]++-- | §4 case #2 — Remove slot. The baseline minus @correlationId@.+type RemoveSlots =+  '[ '("retryCount", Int),+     '("cooldownUntil", UTCTime)+   ]++-- | §4 case #3 — Rename slot. @cooldownUntil@ becomes @retryAfter@.+type RenameSlots =+  '[ '("retryCount", Int),+     '("retryAfter", UTCTime),+     '("correlationId", Text)+   ]++-- | §4 case #4 — Reorder slots. @cooldownUntil@ and @retryCount@ swap.+type ReorderSlots =+  '[ '("cooldownUntil", UTCTime),+     '("retryCount", Int),+     '("correlationId", Text)+   ]++-- | §4 case #5 — Slot type change, same JSON. @retryCount@ moves from+-- 'Int' to 'Word32' (both encode identically on positive integers, but+-- the TypeRep differs).+type TypeChangeSameJsonSlots =+  '[ '("retryCount", Word32),+     '("cooldownUntil", UTCTime),+     '("correlationId", Text)+   ]++-- | §4 case #6 — Newtype wrap. @correlationId :: Text@ becomes+-- @correlationId :: OrderId@ where 'OrderId' is a 'Text' newtype with+-- @deriving newtype@ JSON instances. Wire-compatible, but the type's+-- name differs (@OrderId@ vs @Text@) so the hash changes.+type NewtypeWrapSlots =+  '[ '("retryCount", Int),+     '("cooldownUntil", UTCTime),+     '("correlationId", OrderId)+   ]++-- | §4 case #7 — Replace primitive with record. @correlationId :: Text@+-- becomes @correlationId :: Address@.+type RecordReplaceSlots =+  '[ '("retryCount", Int),+     '("cooldownUntil", UTCTime),+     '("correlationId", Address)+   ]++-- | §4 case #8 — Split slot. @correlationId :: Text@ is split into two+-- slots @correlationStream :: Text@ + @correlationId :: Text@.+type SplitSlots =+  '[ '("retryCount", Int),+     '("cooldownUntil", UTCTime),+     '("correlationStream", Text),+     '("correlationId", Text)+   ]++-- | §4 case #9 — Slot type's internal record changes. To exercise the+-- hash's sensitivity here we use a /distinctly-named/ second type+-- 'RenamedAddress' in place of 'Address'. (Two definitions of @data+-- Address@ with different fields cannot coexist in one Haskell+-- module; for the hash to discriminate them they must differ in+-- @tyConModule + tyConName@. The §4 row notes "Maybe (TypeRep)" — the+-- hash flips when the user actually renames the type to signal the+-- breaking change, which is the disciplined practice.)+type RenamedTypeSlots =+  '[ '("retryCount", Int),+     '("cooldownUntil", UTCTime),+     '("correlationId", RenamedAddress)+   ]++-- * Auxiliary types used by the mutations ------------------------------------++newtype OrderId = OrderId Text+  deriving stock (Eq, Show, Generic)+  deriving newtype (Aeson.ToJSON, Aeson.FromJSON, Arbitrary)+  deriving anyclass (CanonicalTypeName)++data Address = Address+  { line :: Text,+    city :: Text,+    postcode :: Text+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (Aeson.ToJSON, Aeson.FromJSON, CanonicalTypeName)++instance Arbitrary Address where+  arbitrary = Address <$> arbitrary <*> arbitrary <*> arbitrary++-- | A distinctly-named near-copy of 'Address' used by 'RenamedTypeSlots'+-- to demonstrate the §4 case #9 detection path (rename-on-breaking-+-- change). Adds a @country@ field to also illustrate the "Address adds+-- country field" example from §4.+data RenamedAddress = RenamedAddress+  { line :: Text,+    city :: Text,+    postcode :: Text,+    country :: Text+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (Aeson.ToJSON, Aeson.FromJSON, CanonicalTypeName)++instance Arbitrary RenamedAddress where+  arbitrary =+    RenamedAddress <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++-- * Arbitrary generator for 'RegFile rs' -------------------------------------++-- | Inductive generator over the slot list. Each slot value comes from+-- the slot type's 'Arbitrary' instance.+class ArbitraryRegFile (rs :: [Slot]) where+  arbRegFile :: Gen (RegFile rs)++instance ArbitraryRegFile '[] where+  arbRegFile = pure RNil++instance+  ( KnownSymbol s,+    Arbitrary t,+    ArbitraryRegFile rs+  ) =>+  ArbitraryRegFile ('(s, t) ': rs)+  where+  arbRegFile = RCons (Proxy @s) <$> arbitrary <*> arbRegFile

@@ -0,0 +1,24 @@+-- | EP-36 M3 golden hash file.+--+-- Pins the shape hash of 'ExemplarSlots' for the current GHC version.+-- The cross-GHC CI gate (M5) compares this value across every GHC in+-- @tested-with@; a divergence is a release-blocking bug per EP-36 §8.+module Keiki.Codec.JSON.GoldenSpec (spec) where++import Data.Proxy (Proxy (..))+import Data.Text qualified as T+import Keiki.Codec.JSON.Fixtures (ExemplarSlots)+import Keiki.Shape (regFileShapeHash)+import Test.Hspec (Spec, describe, it, shouldBe)++spec :: Spec+spec = describe "Golden hash for ExemplarSlots" $ do+  -- This value is pinned for GHC 9.12.*. Drift here means either+  -- GHC's `tyConModule` / `tyConName` semantics changed for one of+  -- the slot types (Int / UTCTime / Text), or `renderStableTypeRep`+  -- inadvertently picked up a non-stable accessor. Per EP-36 §8 the+  -- release is blocked until the cause is understood; the fix may be a+  -- `CanonicalTypeName` override for the affected slot type.+  it "matches the pinned GHC-9.12.* value" $+    regFileShapeHash (Proxy @ExemplarSlots)+      `shouldBe` T.pack "a37b2b77042a635f394a082765f3410ea23a0b89745b0c77242b925a03aa172b"

@@ -0,0 +1,80 @@+-- | EP-36 M3 property tests: roundtrip on both encoder paths plus+-- within-path encoding determinism (R9).+--+-- The Value path and Encoding path are exercised independently. Cross-+-- path byte equality is /not/ asserted because aeson 2.2's+-- @Aeson.Value@ Object iterates 'Aeson.KeyMap' in (alphabetical)+-- KeyMap order, while the Encoding path emits in slot-list order via+-- @Aeson.Series@. See EP-36 Surprises & Discoveries for the+-- 2026-05-13 M2 entry documenting this.+module Keiki.Codec.JSON.PropSpec (spec) where++import Data.Aeson qualified as Aeson+import Data.Aeson.Encoding qualified as AesonEnc+import Keiki.Codec.JSON (regFileFromJSON, regFileToEncoding, regFileToJSON)+import Keiki.Codec.JSON.Fixtures (ExemplarSlots, arbRegFile)+import Keiki.Core (RegFile)+import Test.Hspec (Spec, describe, it)+import Test.QuickCheck (Property, forAllShow, (===))++-- | RegFile rs has no Show instance (the slot list is heterogeneous);+-- use the JSON encoding as the renderer for QuickCheck counterexamples.+showRegFile :: RegFile ExemplarSlots -> String+showRegFile = show . regFileToJSON++spec :: Spec+spec = do+  describe "Roundtrip" $ do+    it "Value path round-trips" $+      forAllShow arbRegFile showRegFile valueRoundTrip+    it "Encoding path round-trips" $+      forAllShow arbRegFile showRegFile encodingRoundTrip++  describe "Determinism (R9 within-path)" $ do+    it "Value path is deterministic" $+      forAllShow arbRegFile showRegFile valueDeterministic+    it "Encoding path is deterministic" $+      forAllShow arbRegFile showRegFile encodingDeterministic++-- | @regFileFromJSON . regFileToJSON ≡ Right rf@. We use the encoded+-- bytes as the canonical comparison point: re-encoding the parsed+-- RegFile must yield the same bytes (proving structural equality+-- without requiring a 'Eq' or 'Show' instance on 'RegFile').+valueRoundTrip :: RegFile ExemplarSlots -> Property+valueRoundTrip rf =+  let bytes = Aeson.encode (regFileToJSON rf)+   in case Aeson.decode bytes of+        Nothing ->+          False === error "Aeson.decode failed on our own encoder output"+        Just v -> case regFileFromJSON @ExemplarSlots v of+          Left msg ->+            False === error ("regFileFromJSON failed: " <> msg)+          Right rf' ->+            Aeson.encode (regFileToJSON rf') === bytes++-- | Encoding path round-trip via+-- @regFileFromJSON . fromJust . Aeson.decode . AesonEnc.encodingToLazyByteString . regFileToEncoding@.+encodingRoundTrip :: RegFile ExemplarSlots -> Property+encodingRoundTrip rf =+  let bytes = AesonEnc.encodingToLazyByteString (regFileToEncoding rf)+   in case Aeson.decode bytes of+        Nothing ->+          False === error "Aeson.decode failed on streaming-encoder output"+        Just v -> case regFileFromJSON @ExemplarSlots v of+          Left msg ->+            False === error ("regFileFromJSON failed: " <> msg)+          Right rf' ->+            AesonEnc.encodingToLazyByteString (regFileToEncoding rf') === bytes++-- | Re-encoding the same RegFile via the Value path produces byte-+-- equal output.+valueDeterministic :: RegFile ExemplarSlots -> Property+valueDeterministic rf =+  Aeson.encode (regFileToJSON rf)+    === Aeson.encode (regFileToJSON rf)++-- | Re-encoding via the Encoding path produces byte-equal output.+encodingDeterministic :: RegFile ExemplarSlots -> Property+encodingDeterministic rf =+  AesonEnc.encodingToLazyByteString (regFileToEncoding rf)+    === AesonEnc.encodingToLazyByteString (regFileToEncoding rf)

@@ -0,0 +1,55 @@+-- | EP-36 M3 sensitivity tests (P7.4).+--+-- The baseline 'ExemplarSlots' shape hash is computed once, and each+-- mutation from EP-36 §4 (cases #1–9) is asserted to produce a /different/+-- hash. This is the discrimination side of the shape hash contract: any+-- structural change in the slot list must flip the hash.+module Keiki.Codec.JSON.SensitivitySpec (spec) where++import Data.Proxy (Proxy (..))+import Keiki.Codec.JSON.Fixtures+  ( AddSlots,+    ExemplarSlots,+    NewtypeWrapSlots,+    RecordReplaceSlots,+    RemoveSlots,+    RenameSlots,+    RenamedTypeSlots,+    ReorderSlots,+    SplitSlots,+    TypeChangeSameJsonSlots,+  )+import Keiki.Shape (regFileShapeHash)+import Test.Hspec (Spec, describe, it, shouldSatisfy)++spec :: Spec+spec = describe "Sensitivity (EP-36 §4 cases #1–9)" $ do+  let baseline = regFileShapeHash (Proxy @ExemplarSlots)++  it "#1 add slot flips the hash" $+    regFileShapeHash (Proxy @AddSlots) `shouldSatisfy` (/= baseline)++  it "#2 remove slot flips the hash" $+    regFileShapeHash (Proxy @RemoveSlots) `shouldSatisfy` (/= baseline)++  it "#3 rename slot flips the hash" $+    regFileShapeHash (Proxy @RenameSlots) `shouldSatisfy` (/= baseline)++  it "#4 reorder slots flips the hash (P10)" $+    regFileShapeHash (Proxy @ReorderSlots) `shouldSatisfy` (/= baseline)++  it "#5 slot type change (Int → Word32) flips the hash" $+    regFileShapeHash (Proxy @TypeChangeSameJsonSlots)+      `shouldSatisfy` (/= baseline)++  it "#6 newtype wrap (Text → OrderId) flips the hash" $+    regFileShapeHash (Proxy @NewtypeWrapSlots) `shouldSatisfy` (/= baseline)++  it "#7 primitive → record (Text → Address) flips the hash" $+    regFileShapeHash (Proxy @RecordReplaceSlots) `shouldSatisfy` (/= baseline)++  it "#8 split slot flips the hash" $+    regFileShapeHash (Proxy @SplitSlots) `shouldSatisfy` (/= baseline)++  it "#9 type rename (Address → RenamedAddress) flips the hash" $+    regFileShapeHash (Proxy @RenamedTypeSlots) `shouldSatisfy` (/= baseline)

@@ -0,0 +1,174 @@+{-# LANGUAGE TemplateHaskell #-}++-- | EP-59 M3 tests for+-- 'Keiki.Codec.JSON.Event.deriveEventCodecSkeleton'.+--+-- The splice derives a @kind@-discriminated encoder/decoder for an event+-- /sum/ type. This spec exercises round-trip, the @kind@ discriminator,+-- that a per-field override actually runs (rather than a generic instance),+-- and the constructor-name list, against a 3-constructor fixture: one+-- payload event with an overridden newtype field, one all-passthrough+-- payload event, and one singleton.+--+-- == Negative checks (manual)+--+-- The no-silent-fallback contract is that an /unhandled/ field (one in+-- neither 'fieldCodecOverrides' nor 'passthroughFields') is never silently+-- given a generic codec. There are two behaviours, neither expressible as a+-- passing unit test:+--+-- 1. @onMissingCodec = FailAtCompileTime@ (the default). Add a field to a+--    payload record without listing it, e.g. give @PlacedData@ a+--    @discount :: Int@ field and do NOT add @"discount"@ to+--    'passthroughFields'. Run+--    @cabal build keiki-codec-json:keiki-codec-json-test@. The build must+--    fail with a message of the form:+--+--    @+--    deriveEventCodecSkeleton: Keiki.Codec.JSON.THEventSpec.OrderEvent has+--    field(s) with no provided codec and onMissingCodec = FailAtCompileTime:+--      - Placed.discount :: GHC.Types.Int+--    Add each field to fieldCodecOverrides or passthroughFields, or set+--    onMissingCodec = EmitTodoBindings.+--    @+--+--    (The type name and field type print fully qualified — @show@/@pprint@+--    of the reified names.) Revert the field.+--+-- 2. @onMissingCodec = EmitTodoBindings@. With the same unhandled field but+--    @onMissingCodec = EmitTodoBindings@ in the options, the build SUCCEEDS+--    and a top-level binding @_todo_Placed_discount :: a@ is emitted whose+--    body is @error "TODO: provide a FieldCodec for Placed.discount :: Int"@.+--    Any actual encode/decode of that field throws the named error rather+--    than guessing. Verify by adding @discount@, switching to+--    @EmitTodoBindings@, and observing the module compiles; referencing+--    @_todo_Placed_discount@ in @cabal repl@ shows the binding exists.+--    Revert afterwards.+--+-- Both behaviours were verified by hand on 2026-06-06; the observed+-- compile-fail text matched (1) verbatim.+module Keiki.Codec.JSON.THEventSpec (spec) where++import Data.Aeson qualified as Aeson+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Keiki.Codec.JSON.Event+  ( EventCodecOptions (..),+    FieldCodec (..),+    defaultEventCodecOptions,+    deriveEventCodecSkeleton,+  )+import Test.Hspec (Spec, describe, it, shouldBe)+import Text.Read (readMaybe)++-- * Fixtures -----------------------------------------------------------------++-- | A newtype field whose JSON form is overridden (a @"ord-<n>"@ string),+-- proving the override hook runs instead of a generic 'Int' encoding.+newtype OrderId = OrderId Int+  deriving stock (Eq, Show)++orderIdToJSON :: OrderId -> Aeson.Value+orderIdToJSON (OrderId n) = Aeson.toJSON (T.pack ("ord-" <> show n))++orderIdFromJSON :: Aeson.Value -> Either String OrderId+orderIdFromJSON v = case v of+  Aeson.String t+    | Just rest <- T.stripPrefix (T.pack "ord-") t,+      Just n <- readMaybe (T.unpack rest) ->+        Right (OrderId n)+  _ -> Left "orderIdFromJSON: expected an \"ord-<int>\" string"++data PlacedData = PlacedData+  { orderId :: OrderId,+    qty :: Int+  }+  deriving stock (Eq, Show)++data ShippedData = ShippedData+  { trackingNo :: Text+  }+  deriving stock (Eq, Show)++data OrderEvent+  = Placed PlacedData+  | Shipped ShippedData+  | Cancelled+  deriving stock (Eq, Show)++$( deriveEventCodecSkeleton+     defaultEventCodecOptions+       { fieldCodecOverrides =+           Map.fromList [("orderId", FieldCodec 'orderIdToJSON 'orderIdFromJSON)],+         passthroughFields = Set.fromList ["qty", "trackingNo"]+       }+     ''OrderEvent+ )++-- * Spec --------------------------------------------------------------------++spec :: Spec+spec = describe "deriveEventCodecSkeleton" $ do+  let placed = Placed (PlacedData (OrderId 7) 3)+      shipped = Shipped (ShippedData (T.pack "1Z999"))+      cancelled = Cancelled++  describe "round-trip (decode . encode == Right)" $ do+    it "Placed (payload with an overridden field) round-trips" $+      orderEventFromJSON (orderEventToJSON placed) `shouldBe` Right placed++    it "Shipped (all-passthrough payload) round-trips" $+      orderEventFromJSON (orderEventToJSON shipped) `shouldBe` Right shipped++    it "Cancelled (singleton) round-trips" $+      orderEventFromJSON (orderEventToJSON cancelled) `shouldBe` Right cancelled++  describe "kind discriminator + override usage" $ do+    -- orderEventToJSON (Placed (PlacedData (OrderId 7) 3))+    -- == {"kind":"Placed","orderId":"ord-7","qty":3}+    it "Placed carries the kind key, the override output, and the passthrough field" $+      orderEventToJSON placed+        `shouldBe` Aeson.object+          [ "kind" Aeson..= (T.pack "Placed" :: Text),+            "orderId" Aeson..= (T.pack "ord-7" :: Text),+            "qty" Aeson..= (3 :: Int)+          ]++    it "the orderId override ran (string \"ord-7\", not the integer 7)" $+      -- If a generic Int codec had been silently used, this would be 7.+      orderEventFromJSON+        ( Aeson.object+            [ "kind" Aeson..= (T.pack "Placed" :: Text),+              "orderId" Aeson..= (T.pack "ord-7" :: Text),+              "qty" Aeson..= (3 :: Int)+            ]+        )+        `shouldBe` Right placed++    it "Cancelled encodes to just the kind object" $+      orderEventToJSON cancelled+        `shouldBe` Aeson.object ["kind" Aeson..= (T.pack "Cancelled" :: Text)]++  describe "decoder error paths" $ do+    it "an unknown kind is reported" $+      orderEventFromJSON+        (Aeson.object ["kind" Aeson..= (T.pack "Nope" :: Text)])+        `shouldBe` (Left "unknown event kind: Nope" :: Either String OrderEvent)++    it "a non-object is reported" $+      orderEventFromJSON (Aeson.toJSON (5 :: Int))+        `shouldBe` (Left "orderEvent: expected a JSON object" :: Either String OrderEvent)++  describe "Keiro-feeding surfaces" $ do+    it "EventTypes lists the constructors in declaration order" $+      orderEventEventTypes+        `shouldBe` map T.pack ["Placed", "Shipped", "Cancelled"]++    it "KindMap pairs each constructor name with its kind string" $+      orderEventKindMap+        `shouldBe` [ (T.pack "Placed", T.pack "Placed"),+                     (T.pack "Shipped", T.pack "Shipped"),+                     (T.pack "Cancelled", T.pack "Cancelled")+                   ]

@@ -0,0 +1,123 @@+{-# LANGUAGE TemplateHaskell #-}++-- | EP-38 M3 tests for 'Keiki.Codec.JSON.TH.deriveRegFileCodec'.+--+-- The splice emits three top-level functions per record type. This spec+-- exercises the round-trip and strict-decoder properties of the emitted+-- functions against two test records — a non-trivial @TestRec@ and the+-- @Empty@ singleton — and verifies the encoding-path / value-path+-- semantic-round-trip agreement (the same invariant the in-tree M2 and+-- M3 specs exercise for the underlying class).+--+-- == Negative-test procedure (manual)+--+-- The splice's contract is that a record whose field type lacks+-- 'Aeson.ToJSON' or 'Aeson.FromJSON' fails to compile. This is not+-- expressible in a passing unit test, so the procedure is manual:+--+-- 1. Edit @TestRec@ below to add a field @trBad :: Int -> Int@.+-- 2. Run @cabal build keiki-codec-json:keiki-codec-json-test@.+-- 3. The build must fail with @No instance for 'Aeson.ToJSON' (Int -> Int)@+--    pointing at the use site of @testRecToJSON@.+-- 4. Revert. The expected error proves the splice's elaboration trips+--    the missing-instance check; an automated should-not-compile test+--    is out of scope for v0.2.+module Keiki.Codec.JSON.THSpec (spec) where++import Data.Aeson qualified as Aeson+import Data.Aeson.Encoding qualified as AesonEnc+import Data.Maybe (fromJust)+import Data.Text (Text)+import Data.Text qualified as T+import GHC.Generics (Generic)+import Keiki.Codec.JSON.TH (deriveRegFileCodec)+import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)++-- * Test fixtures -----------------------------------------------------------++-- | Non-trivial two-field record used to exercise round-trip and strict+-- decoder behaviour.+data TestRec = TestRec+  { trCount :: Int,+    trNote :: Text+  }+  deriving stock (Eq, Show, Generic)++$(deriveRegFileCodec ''TestRec)++-- | Singleton record used to exercise the empty-slot-list edge case.+data Empty = Empty+  deriving stock (Eq, Show, Generic)++$(deriveRegFileCodec ''Empty)++-- * Spec --------------------------------------------------------------------++spec :: Spec+spec = describe "deriveRegFileCodec" $ do+  let tr = TestRec {trCount = 7, trNote = T.pack "hi"}++  describe "TestRec — round-trip and encoding agreement" $ do+    it "Value path round-trips" $+      testRecFromJSON (testRecToJSON tr) `shouldBe` Right tr++    it "Encoding path bytes parse back to the same value" $ do+      let bytes = AesonEnc.encodingToLazyByteString (testRecToEncoding tr)+          v = fromJust (Aeson.decode bytes :: Maybe Aeson.Value)+      testRecFromJSON v `shouldBe` Right tr++    it "Value path emits both slots in slot-list order" $+      testRecToJSON tr+        `shouldBe` Aeson.object+          [ "trCount" Aeson..= (7 :: Int),+            "trNote" Aeson..= T.pack "hi"+          ]++  describe "TestRec — strict decoder" $ do+    it "rejects an Object missing trCount with a slot-prefixed message" $ do+      let v = Aeson.object ["trNote" Aeson..= T.pack "hi"]+      testRecFromJSON v `shouldBe` Left "trCount: missing slot"++    it "rejects an Object with an unknown extra field" $ do+      let v =+            Aeson.object+              [ "trCount" Aeson..= (7 :: Int),+                "trNote" Aeson..= T.pack "hi",+                "bogus" Aeson..= (1 :: Int)+              ]+      testRecFromJSON v `shouldSatisfy` isExtraFieldsLeft++    it "rejects a type-mismatched field with a slot-prefixed message" $ do+      let v =+            Aeson.object+              [ "trCount" Aeson..= T.pack "seven",+                "trNote" Aeson..= T.pack "hi"+              ]+      testRecFromJSON v `shouldSatisfy` hasPrefix "trCount:"++  describe "Empty — empty-slot-list edge case" $ do+    it "encodes Empty to the empty JSON object" $+      emptyToJSON Empty `shouldBe` Aeson.object []++    it "decodes the empty JSON object back to Empty" $+      emptyFromJSON (Aeson.object []) `shouldBe` Right Empty++    it "encodes Empty via the streaming path to the literal bytes {}" $+      AesonEnc.encodingToLazyByteString (emptyToEncoding Empty)+        `shouldBe` AesonEnc.encodingToLazyByteString (AesonEnc.pairs mempty)++    it "rejects a non-empty JSON object as unknown extra fields" $+      emptyFromJSON (Aeson.object ["x" Aeson..= (1 :: Int)])+        `shouldSatisfy` isExtraFieldsLeft++-- * Helpers -----------------------------------------------------------------++isExtraFieldsLeft :: Either String a -> Bool+isExtraFieldsLeft = \case+  Left msg -> T.pack "regfile: unknown extra fields:" `T.isPrefixOf` T.pack msg+  Right _ -> False++hasPrefix :: String -> Either String a -> Bool+hasPrefix p = \case+  Left msg -> T.pack p `T.isPrefixOf` T.pack msg+  Right _ -> False

@@ -0,0 +1,196 @@+-- | EP-36 M2 unit tests for the JSON codec.+--+-- Covers acceptance items from the milestone: empty RegFile encode /+-- decode on both paths (Value and Encoding); a single-slot list; a+-- multi-slot list with both encoders producing the same bytes after+-- @'Aeson.encode'@ / @'AesonEnc.encodingToLazyByteString'@; strict failure+-- on missing slot, extra slot, type mismatch.+module Main (main) where++import Data.Aeson qualified as Aeson+import Data.Aeson.Encoding qualified as AesonEnc+import Data.ByteString.Lazy qualified as LBS+import Data.Kind (Type)+import Data.Maybe (fromJust)+import Data.Proxy (Proxy (..))+import Data.Text (Text)+import Data.Text qualified as T+import GHC.TypeLits (Symbol)+import Keiki.Codec.JSON (regFileFromJSON, regFileToEncoding, regFileToJSON)+import Keiki.Codec.JSON.GoldenSpec qualified+import Keiki.Codec.JSON.PropSpec qualified+import Keiki.Codec.JSON.SensitivitySpec qualified+import Keiki.Codec.JSON.THEventSpec qualified+import Keiki.Codec.JSON.THSpec qualified+import Keiki.Core (RegFile (..))+import Test.Hspec+  ( Spec,+    describe,+    hspec,+    it,+    shouldBe,+  )++main :: IO ()+main = hspec $ do+  spec+  describe "M3 properties" Keiki.Codec.JSON.PropSpec.spec+  describe "M3 sensitivity" Keiki.Codec.JSON.SensitivitySpec.spec+  describe "M3 golden hash" Keiki.Codec.JSON.GoldenSpec.spec+  describe "EP-38 deriveRegFileCodec" Keiki.Codec.JSON.THSpec.spec+  describe "EP-59 deriveEventCodecSkeleton" Keiki.Codec.JSON.THEventSpec.spec++spec :: Spec+spec = do+  describe "Empty RegFile" $ do+    it "encodes to {}" $+      regFileToJSON (RNil :: RegFile '[])+        `shouldBe` Aeson.object []++    it "encodes via streaming to the same bytes as the Value path" $+      AesonEnc.encodingToLazyByteString (regFileToEncoding (RNil :: RegFile '[]))+        `shouldBe` Aeson.encode (regFileToJSON (RNil :: RegFile '[]))++    it "decodes {} back to RNil" $ do+      let r = regFileFromJSON @'[] (Aeson.object [])+      case r of+        Right RNil -> (True :: Bool) `shouldBe` True+        Left msg -> error ("expected Right RNil, got Left " <> msg)++    it "rejects {\"x\": 1} as having unknown extra fields" $ do+      let r = regFileFromJSON @'[] (Aeson.object ["x" Aeson..= (1 :: Int)])+      isExtraFieldsLeft r `shouldBe` True++  describe "Single-slot RegFile '[ '(\"retryCount\", Int) ]" $ do+    let rf = RCons (Proxy @"retryCount") (3 :: Int) RNil :: RegFile '[ '("retryCount", Int)]++    it "encodes to {\"retryCount\": 3}" $+      regFileToJSON rf+        `shouldBe` Aeson.object ["retryCount" Aeson..= (3 :: Int)]++    it "encodes via streaming to byte-equal bytes" $+      AesonEnc.encodingToLazyByteString (regFileToEncoding rf)+        `shouldBe` Aeson.encode (regFileToJSON rf)++    it "round-trips through the Value path" $ do+      let r = regFileFromJSON @'[ '("retryCount", Int)] (regFileToJSON rf)+      case r of+        Right (RCons _ n RNil) -> n `shouldBe` 3+        Left msg -> error ("expected round-trip success, got Left " <> msg)++    it "round-trips through the Encoding path" $ do+      let bytes = AesonEnc.encodingToLazyByteString (regFileToEncoding rf)+          v = fromJust (Aeson.decode bytes :: Maybe Aeson.Value)+          r = regFileFromJSON @'[ '("retryCount", Int)] v+      case r of+        Right (RCons _ n RNil) -> n `shouldBe` 3+        Left msg -> error ("expected round-trip success, got Left " <> msg)++    it "rejects {} as missing retryCount" $ do+      let r = regFileFromJSON @'[ '("retryCount", Int)] (Aeson.object [])+      case r of+        Left msg -> msg `shouldBe` "retryCount: missing slot"+        Right _ -> error "expected Left, got Right"++    it "rejects {\"retryCount\": \"three\"} as type mismatch" $ do+      let r =+            regFileFromJSON @'[ '("retryCount", Int)]+              (Aeson.object ["retryCount" Aeson..= ("three" :: Text)])+      case r of+        Left msg+          | "retryCount:" `T.isPrefixOf` T.pack msg ->+              (True :: Bool) `shouldBe` True+        Left msg -> error ("expected slot-prefixed type error, got " <> msg)+        Right _ -> error "expected Left, got Right"++    it "rejects {\"retryCount\": 3, \"extra\": 1} as unknown extra fields" $ do+      let r =+            regFileFromJSON @'[ '("retryCount", Int)]+              ( Aeson.object+                  [ "retryCount" Aeson..= (3 :: Int),+                    "extra" Aeson..= (1 :: Int)+                  ]+              )+      isExtraFieldsLeft r `shouldBe` True++  describe "Multi-slot RegFile (Int + Text)" $ do+    let rf :: RegFile '[ '("retryCount", Int), '("note", Text)]+        rf =+          RCons (Proxy @"retryCount") (5 :: Int) $+            RCons (Proxy @"note") ("hello" :: Text) RNil++    it "encodes both slots in slot-list order via Value path" $+      regFileToJSON rf+        `shouldBe` Aeson.object+          [ "retryCount" Aeson..= (5 :: Int),+            "note" Aeson..= ("hello" :: Text)+          ]++    -- The Value path emits keys in 'Aeson.KeyMap' order (alphabetical for+    -- aeson 2.2's default backing 'Map Key'); the Encoding path emits in+    -- slot-list order. The two byte streams therefore differ when slot+    -- order is not alphabetical. What both paths guarantee is /semantic/+    -- round-trip equality plus within-path determinism — see the next+    -- two tests.+    it "Encoding path emits keys in slot-list order; Value path is sorted" $ do+      let viaStreaming = AesonEnc.encodingToLazyByteString (regFileToEncoding rf)+          viaValue = Aeson.encode (regFileToJSON rf)+      viaStreaming+        `shouldBe` LBS.pack+          ( map+              (fromIntegral . fromEnum)+              "{\"retryCount\":5,\"note\":\"hello\"}"+          )+      viaValue+        `shouldBe` LBS.pack+          ( map+              (fromIntegral . fromEnum)+              "{\"note\":\"hello\",\"retryCount\":5}"+          )++    it "both paths round-trip to the same RegFile (cross-path semantic equality)" $ do+      let valueBytes = Aeson.encode (regFileToJSON rf)+          streamBytes = AesonEnc.encodingToLazyByteString (regFileToEncoding rf)+          fromValue =+            regFileFromJSON @'[ '("retryCount", Int), '("note", Text)]+              =<< maybe (Left "decode failed") Right (Aeson.decode valueBytes)+          fromStream =+            regFileFromJSON @'[ '("retryCount", Int), '("note", Text)]+              =<< maybe (Left "decode failed") Right (Aeson.decode streamBytes)+      assertMultiRoundTrip fromValue+      assertMultiRoundTrip fromStream++    it "within-path determinism: re-encoding produces byte-equal output (R9)" $ do+      Aeson.encode (regFileToJSON rf)+        `shouldBe` Aeson.encode (regFileToJSON rf)+      AesonEnc.encodingToLazyByteString (regFileToEncoding rf)+        `shouldBe` AesonEnc.encodingToLazyByteString (regFileToEncoding rf)++    it "rejects {\"retryCount\": 5} as missing note" $ do+      let r =+            regFileFromJSON+              @'[ '("retryCount", Int), '("note", Text)]+              (Aeson.object ["retryCount" Aeson..= (5 :: Int)])+      case r of+        Left msg -> msg `shouldBe` "note: missing slot"+        Right _ -> error "expected Left, got Right"++isExtraFieldsLeft :: Either String a -> Bool+isExtraFieldsLeft = \case+  Left msg -> "regfile: unknown extra fields:" `T.isPrefixOf` T.pack msg+  Right _ -> False++assertMultiRoundTrip ::+  Either String (RegFile '[ '("retryCount", Int), '("note", Text)]) ->+  IO ()+assertMultiRoundTrip = \case+  Right (RCons _ n (RCons _ t RNil)) -> do+    n `shouldBe` 5+    t `shouldBe` ("hello" :: Text)+  Left msg -> error ("expected round-trip success, got Left " <> msg)++-- Silence GHC's unused-import warnings: Symbol/Type are referenced by+-- the type-level slot lists above, but GHC's warning pass doesn't see+-- the kind annotations as references.+_unused :: (Proxy (rs :: [(Symbol, Type)]), ())+_unused = (Proxy, ())