diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,18 @@ ## [Unreleased] +## [0.2.0.0] — 2026-07-13 + +### Added + +- `EqRegFile` and `regFileCodecPropsEq` provide value-level heterogeneous + round-trip checks. The original byte-comparing `regFileCodecProps` remains for + compatibility, with its nested-`Maybe` blind spot now documented. +- `Keiki.Codec.JSON.Test.GoldenFile.regFileGoldenFileSpec` pins a whole + register file against checked-in JSON in both directions, with a deliberately + failing `KEIKI_UPDATE_GOLDENS` regeneration workflow. + + ## [0.1.0.0] — 2026-06-07 Initial Hackage release. Co-released with `keiki-0.1.0.0` and diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -33,7 +33,7 @@ import Test.Hspec (describe, hspec) import Keiki.Codec.JSON.Test - ( regFileCodecProps + ( regFileCodecPropsEq , regFileShapeSensitivitySpec , someKnownShape ) @@ -41,6 +41,9 @@ ( SlotGolden (..) , slotGoldenSpec ) +import Keiki.Codec.JSON.Test.GoldenFile + ( regFileGoldenFileSpec + ) -- Your slot type and slot lists: -- data Email = Email Text deriving (...) @@ -56,8 +59,15 @@ , sgBytes = "\"alice@example.com\"" }) + -- Whole-snapshot backward compatibility. `myFixture` is a fixed + -- `RegFile MySlots`; add the JSON file to extra-source-files. + regFileGoldenFileSpec + "MySlots" + "test/golden/my-slots.value.json" + myFixture + -- Round-trip + determinism over the snapshot's slot list. - describe "props: MySlots" (regFileCodecProps @MySlots) + describe "props: MySlots" (regFileCodecPropsEq @MySlots) -- Sensitivity: every named mutation must flip the shape hash. describe "sensitivity: MySlots" $ @@ -73,6 +83,21 @@ lacks `Arbitrary`, write one — it is typically a one-liner via `quickcheck-instances` for the standard library types. +`regFileCodecPropsEq` is the preferred round-trip helper: its inductive +`EqRegFile` comparison checks decoded slot values. The older +`regFileCodecProps` remains available for slot types without `Eq`, but it compares +re-encoded bytes and therefore cannot detect lossy decodes that re-encode +identically (notably `Just Nothing -> null -> Nothing`). + +When an intentional wire change requires regenerating whole-snapshot files, use +the guarded two-run workflow: + +```sh +KEIKI_UPDATE_GOLDENS=1 cabal test # rewrites files, then fails deliberately +cabal test # must pass with the variable unset +git diff test/golden/ # review every changed byte +``` + ## When you don't need this `keiki-codec-json` alone is sufficient for production use. This @@ -88,4 +113,4 @@ The self-test exercises every public helper against a small toy fixture (`Email`, `DemoSlots`, `DemoSlotsRenamed`). Expected -output: 7 examples, 0 failures. +output: 11 examples, 0 failures. diff --git a/keiki-codec-json-test.cabal b/keiki-codec-json-test.cabal --- a/keiki-codec-json-test.cabal +++ b/keiki-codec-json-test.cabal @@ -1,6 +1,6 @@ -cabal-version: 3.0 -name: keiki-codec-json-test -version: 0.1.0.0 +cabal-version: 3.0 +name: keiki-codec-json-test +version: 0.2.0.0 synopsis: Property-test toolkit for keiki-codec-json downstream consumers. @@ -22,17 +22,24 @@ for production do not transitively pick up @QuickCheck@ / @hspec@ / @quickcheck-instances@. -license: BSD-3-Clause -author: Nadeem Bitar -maintainer: nadeem@gmail.com -copyright: 2026 Nadeem Bitar -category: Codec, Testing -build-type: Simple -tested-with: GHC >=9.12 && <9.13 +license: BSD-3-Clause +author: Nadeem Bitar +maintainer: nadeem@gmail.com +copyright: 2026 Nadeem Bitar +category: Codec, Testing +build-type: Simple +tested-with: GHC >=9.12 && <9.13 extra-doc-files: CHANGELOG.md README.md +extra-source-files: test/golden/*.json + +source-repository head + type: git + location: https://github.com/shinzui/keiki.git + subdir: keiki-codec-json-test + common warnings ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates @@ -54,6 +61,7 @@ exposed-modules: Keiki.Codec.JSON.Test Keiki.Codec.JSON.Test.Golden + Keiki.Codec.JSON.Test.GoldenFile hs-source-dirs: src build-depends: @@ -61,8 +69,8 @@ , base ^>=4.21 , bytestring ^>=0.12 , hspec ^>=2.11 - , keiki ^>=0.1 - , keiki-codec-json ^>=0.1 + , keiki ^>=0.2 + , keiki-codec-json ^>=0.2 , QuickCheck ^>=2.15 , quickcheck-instances ^>=0.3 , text ^>=2.1 @@ -78,9 +86,9 @@ , base ^>=4.21 , bytestring ^>=0.12 , hspec ^>=2.11 - , keiki ^>=0.1 - , keiki-codec-json ^>=0.1 - , keiki-codec-json-test ^>=0.1 + , keiki ^>=0.2 + , keiki-codec-json ^>=0.2 + , keiki-codec-json-test ^>=0.2 , QuickCheck ^>=2.15 , quickcheck-instances ^>=0.3 , text ^>=2.1 diff --git a/src/Keiki/Codec/JSON/Test.hs b/src/Keiki/Codec/JSON/Test.hs --- a/src/Keiki/Codec/JSON/Test.hs +++ b/src/Keiki/Codec/JSON/Test.hs @@ -5,7 +5,7 @@ -- -- Wires three helpers into a consumer's @hspec@ test suite: -- --- * 'regFileCodecProps' — four QuickCheck properties (Value-path and +-- * 'regFileCodecProps' / 'regFileCodecPropsEq' — four QuickCheck properties (Value-path and -- Encoding-path round-trip, within-path determinism on both -- paths) against the consumer's own slot list. Mirror of the -- EP-36 M3 in-tree property suite at @@ -34,8 +34,12 @@ ( -- * Arbitrary generator for slot lists ArbitraryRegFile (..), + -- * Value equality for slot lists + EqRegFile (..), + -- * Round-trip + determinism properties regFileCodecProps, + regFileCodecPropsEq, -- * Sensitivity helper SomeKnownRegFileShape (..), @@ -92,6 +96,19 @@ where arbRegFile = RCons (Proxy @s) <$> arbitrary <*> arbRegFile +-- * Value equality for slot lists ------------------------------------------- + +-- | Inductive equality for a heterogeneous 'RegFile'. Consumers receive an +-- instance automatically when every slot value has 'Eq'. +class EqRegFile (rs :: [Slot]) where + eqRegFile :: RegFile rs -> RegFile rs -> Bool + +instance EqRegFile '[] where + eqRegFile _ _ = True + +instance (Eq t, EqRegFile rs) => EqRegFile ('(s, t) ': rs) where + eqRegFile (RCons _ x xs) (RCons _ y ys) = x == y && eqRegFile xs ys + -- * Round-trip + determinism properties ------------------------------------- -- | Run the EP-36 M3 codec property suite against an arbitrary slot @@ -107,12 +124,12 @@ -- 'RegFile' yields byte-equal output. -- * /Encoding path within-path determinism (R9):/ same. -- --- Implementation note: 'RegFile' has no 'Eq' or 'Show' instance (the --- slot list is heterogeneous), so the round-trip assertion uses the --- re-encoded bytes as the comparison point. If the parsed --- 'RegFile' re-encodes to the same bytes as the original, the --- round-trip is structurally exact. This is the same trick the --- in-tree EP-36 M3 spec uses. +-- Implementation note: 'RegFile' has no general 'Eq' or 'Show' instance (the +-- slot list is heterogeneous), so this compatibility helper compares re-encoded +-- bytes. That cannot detect a lossy decode when the changed value re-encodes to +-- the same bytes; aeson's @Just Nothing -> null -> Nothing@ collapse is the known +-- example. Consumers whose slot values have 'Eq' should prefer +-- 'regFileCodecPropsEq', which compares decoded values through 'EqRegFile'. -- -- Type-application invocation form: -- @@ -174,6 +191,70 @@ Right rf' -> AesonEnc.encodingToLazyByteString (regFileToEncoding rf') === bytes + + valueDeterministic :: RegFile rs -> Property + valueDeterministic rf = + Aeson.encode (regFileToJSON rf) + === Aeson.encode (regFileToJSON rf) + + encodingDeterministic :: RegFile rs -> Property + encodingDeterministic rf = + AesonEnc.encodingToLazyByteString (regFileToEncoding rf) + === AesonEnc.encodingToLazyByteString (regFileToEncoding rf) + +-- | Value-comparing form of 'regFileCodecProps'. It runs the same four +-- properties but compares decoded slot values through 'EqRegFile', closing the +-- byte-idempotence blind spot of the compatibility helper. +-- +-- @ +-- regFileCodecPropsEq \@MyAppSnapshotSlots +-- @ +regFileCodecPropsEq :: + forall rs. + ( RegFileToJSON rs, + ArbitraryRegFile rs, + EqRegFile rs + ) => + Spec +regFileCodecPropsEq = do + describe "Roundtrip" $ do + it "Value path round-trips by value" $ + forAllShow (arbRegFile @rs) showRf valueRoundTrip + it "Encoding path round-trips by value" $ + forAllShow (arbRegFile @rs) showRf encodingRoundTrip + + describe "Determinism (R9 within-path)" $ do + it "Value path is deterministic" $ + forAllShow (arbRegFile @rs) showRf valueDeterministic + it "Encoding path is deterministic" $ + forAllShow (arbRegFile @rs) showRf encodingDeterministic + where + showRf :: RegFile rs -> String + showRf = show . regFileToJSON + + valueRoundTrip :: RegFile rs -> Property + valueRoundTrip rf = + let bytes = Aeson.encode (regFileToJSON rf) + in case Aeson.decode bytes of + Nothing -> + False + === error + "Aeson.decode failed on our own Value-path encoder output" + Just value -> case regFileFromJSON @rs value of + Left message -> + False === error ("regFileFromJSON failed: " <> message) + Right decoded -> eqRegFile decoded rf === True + + encodingRoundTrip :: RegFile rs -> 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 value -> case regFileFromJSON @rs value of + Left message -> + False === error ("regFileFromJSON failed: " <> message) + Right decoded -> eqRegFile decoded rf === True valueDeterministic :: RegFile rs -> Property valueDeterministic rf = diff --git a/src/Keiki/Codec/JSON/Test/GoldenFile.hs b/src/Keiki/Codec/JSON/Test/GoldenFile.hs new file mode 100644 --- /dev/null +++ b/src/Keiki/Codec/JSON/Test/GoldenFile.hs @@ -0,0 +1,59 @@ +-- | +-- Module : Keiki.Codec.JSON.Test.GoldenFile +-- Description : Checked-in whole-RegFile JSON golden-file discipline. +-- +-- 'regFileGoldenFileSpec' checks both persistence directions: the current +-- decoder must read bytes checked into source control as the fixed expected +-- value, and the current Value-path encoder must reproduce those bytes exactly. +-- +-- To accept an intentional wire-format change, run the consumer test suite once +-- with @KEIKI_UPDATE_GOLDENS=1@. The helper rewrites the file and deliberately +-- fails; unset the variable, review the diff, and rerun before committing. +module Keiki.Codec.JSON.Test.GoldenFile + ( regFileGoldenFileSpec, + ) +where + +import Data.Aeson qualified as Aeson +import Data.ByteString.Lazy qualified as LBS +import Keiki.Codec.JSON (RegFileToJSON, regFileFromJSON, regFileToJSON) +import Keiki.Codec.JSON.Test (EqRegFile (eqRegFile)) +import Keiki.Core (RegFile) +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, expectationFailure, it, runIO, shouldBe) + +-- | Pin a fixed register file against a checked-in Value-path JSON file. +-- +-- The file path is resolved relative to the consumer package's test working +-- directory. Add it to the package's @extra-source-files@ so source +-- distributions retain the compatibility evidence. +regFileGoldenFileSpec :: + forall rs. + (RegFileToJSON rs, EqRegFile rs) => + String -> + FilePath -> + RegFile rs -> + Spec +regFileGoldenFileSpec label path expected = describe label $ do + update <- runIO (lookupEnv "KEIKI_UPDATE_GOLDENS") + case update of + Just _ -> do + runIO (LBS.writeFile path currentBytes) + it "regenerates and requires a clean review run" $ + expectationFailure regenerationMessage + Nothing -> do + historicalBytes <- runIO (LBS.readFile path) + it "decodes checked-in bytes to the fixed value" $ + case Aeson.decode historicalBytes of + Nothing -> expectationFailure "golden file is not valid JSON" + Just value -> case regFileFromJSON @rs value of + Left message -> expectationFailure ("golden decode failed: " <> message) + Right actual -> eqRegFile actual expected `shouldBe` True + it "freezes current Value-path bytes" $ + currentBytes `shouldBe` historicalBytes + where + currentBytes = Aeson.encode (regFileToJSON expected) + +regenerationMessage :: String +regenerationMessage = + "golden regenerated; unset KEIKI_UPDATE_GOLDENS, re-run, and review git diff" diff --git a/test/Keiki/Codec/JSON/Test/Demo.hs b/test/Keiki/Codec/JSON/Test/Demo.hs --- a/test/Keiki/Codec/JSON/Test/Demo.hs +++ b/test/Keiki/Codec/JSON/Test/Demo.hs @@ -9,12 +9,16 @@ ( Email (..), DemoSlots, DemoSlotsRenamed, + demoRegFile, ) where import Data.Aeson qualified as Aeson +import Data.Proxy (Proxy (..)) import Data.Text (Text) +import Data.Text qualified as T import GHC.Generics (Generic) +import Keiki.Core (RegFile (..)) import Keiki.Shape (CanonicalTypeName) import Test.QuickCheck (Arbitrary (..)) import Test.QuickCheck.Instances () @@ -43,3 +47,8 @@ '[ '("emailAddress", Email), '("count", Int) ] + +demoRegFile :: RegFile DemoSlots +demoRegFile = + RCons (Proxy @"email") (Email (T.pack "a@b.c")) $ + RCons (Proxy @"count") (7 :: Int) RNil diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -13,6 +13,7 @@ import Data.Text qualified as T import Keiki.Codec.JSON.Test ( regFileCodecProps, + regFileCodecPropsEq, regFileShapeSensitivitySpec, someKnownShape, ) @@ -20,11 +21,13 @@ ( DemoSlots, DemoSlotsRenamed, Email (..), + demoRegFile, ) import Keiki.Codec.JSON.Test.Golden ( SlotGolden (..), slotGoldenSpec, ) +import Keiki.Codec.JSON.Test.GoldenFile (regFileGoldenFileSpec) import Test.Hspec (describe, hspec) main :: IO () @@ -41,6 +44,16 @@ describe "Keiki.Codec.JSON.Test.regFileCodecProps @DemoSlots" (regFileCodecProps @DemoSlots) + + describe + "Keiki.Codec.JSON.Test.regFileCodecPropsEq @DemoSlots" + (regFileCodecPropsEq @DemoSlots) + + describe "Keiki.Codec.JSON.Test.GoldenFile.regFileGoldenFileSpec" $ + regFileGoldenFileSpec + "DemoSlots" + "test/golden/demo-regfile.value.json" + demoRegFile describe "Keiki.Codec.JSON.Test.regFileShapeSensitivitySpec" $ regFileShapeSensitivitySpec diff --git a/test/golden/demo-regfile.value.json b/test/golden/demo-regfile.value.json new file mode 100644 --- /dev/null +++ b/test/golden/demo-regfile.value.json @@ -0,0 +1,1 @@ +{"count":7,"email":"a@b.c"}