diff --git a/hspec-golden-aeson.cabal b/hspec-golden-aeson.cabal --- a/hspec-golden-aeson.cabal +++ b/hspec-golden-aeson.cabal @@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: fd3131a3ad56f72d492984264b8e7c4a6a6fadd8afc71dac6295c5758fdcf4ce +-- hash: 96e9eaa9508a1b5c37e6826a1052424945f28adfd1feed94092e594e5c9d96fd name: hspec-golden-aeson -version: 0.6.0.0 +version: 0.7.0.0 synopsis: Use tests to monitor changes in Aeson serialization description: Use tests to monitor changes in Aeson serialization category: Testing @@ -24,6 +24,16 @@ location: https://github.com/plow-technologies/hspec-golden-aeson library + exposed-modules: + Test.Aeson.GenericSpecs + Test.Aeson.Internal.ADT.GoldenSpecs + Test.Aeson.Internal.ADT.RoundtripSpecs + Test.Aeson.Internal.GoldenSpecs + Test.Aeson.Internal.RoundtripSpecs + Test.Aeson.Internal.RandomSamples + Test.Aeson.Internal.Utils + other-modules: + Paths_hspec_golden_aeson hs-source-dirs: src ghc-options: -Wall @@ -39,21 +49,20 @@ , quickcheck-arbitrary-adt >=0.3.0.0 , random , transformers - exposed-modules: - Test.Aeson.GenericSpecs - Test.Aeson.Internal.ADT.GoldenSpecs - Test.Aeson.Internal.ADT.RoundtripSpecs - Test.Aeson.Internal.GoldenSpecs - Test.Aeson.Internal.RoundtripSpecs - Test.Aeson.Internal.RandomSamples - Test.Aeson.Internal.Utils - other-modules: - Paths_hspec_golden_aeson default-language: Haskell2010 test-suite test type: exitcode-stdio-1.0 main-is: Spec.hs + other-modules: + Test.Aeson.GenericSpecsSpec + Test.Types + Test.Types.AlteredSelector + Test.Types.BrokenSerialization + Test.Types.MismatchedToAndFromSerialization + Test.Types.NewSelector + Test.Utils + Paths_hspec_golden_aeson hs-source-dirs: test ghc-options: -Wall @@ -68,13 +77,4 @@ , quickcheck-arbitrary-adt , silently , transformers - other-modules: - Test.Aeson.GenericSpecsSpec - Test.Types - Test.Types.AlteredSelector - Test.Types.BrokenSerialization - Test.Types.MismatchedToAndFromSerialization - Test.Types.NewSelector - Test.Utils - Paths_hspec_golden_aeson default-language: Haskell2010 diff --git a/src/Test/Aeson/Internal/ADT/GoldenSpecs.hs b/src/Test/Aeson/Internal/ADT/GoldenSpecs.hs --- a/src/Test/Aeson/Internal/ADT/GoldenSpecs.hs +++ b/src/Test/Aeson/Internal/ADT/GoldenSpecs.hs @@ -76,7 +76,7 @@ it ("produces the same JSON as is found in " ++ goldenFile) $ do exists <- doesFileExist goldenFile if exists - then compareWithGolden topDir mModuleName typeName cap goldenFile + then compareWithGolden randomMismatchOption topDir mModuleName typeName cap goldenFile else createGoldenFile sampleSize cap goldenFile where goldenFile = mkGoldenFilePath topDir mModuleName typeName cap @@ -90,8 +90,8 @@ -- | The golden files already exist. Serialize values with the same seed from -- the golden files of each constructor and compare. compareWithGolden :: forall a. (Show a, Eq a, FromJSON a, ToJSON a, ToADTArbitrary a) => - String -> Maybe String -> String -> ConstructorArbitraryPair a -> FilePath -> IO () -compareWithGolden topDir mModuleName typeName cap goldenFile = do + RandomMismatchOption -> String -> Maybe String -> String -> ConstructorArbitraryPair a -> FilePath -> IO () +compareWithGolden randomOption topDir mModuleName typeName cap goldenFile = do goldenSeed <- readSeed =<< readFile goldenFile sampleSize <- readSampleSize =<< readFile goldenFile newSamples <- mkRandomADTSamplesForConstructor sampleSize (Proxy :: Proxy a) (capConstructor cap) goldenSeed @@ -100,19 +100,61 @@ goldenSamples :: RandomSamples a <- either (throwIO . ErrorCall) return $ A.eitherDecode' goldenBytes - newSamples `shouldBe` goldenSamples - encodePretty newSamples `shouldBe` goldenBytes + if newSamples == goldenSamples + then + -- random samples match; test encoding of samples (the above check only tested the decoding) + encodePretty newSamples == goldenBytes `shouldBe` True + else do + let + -- whether to pass the test or fail due to random value mismatch + finalResult = + case randomOption of + RandomMismatchWarning -> return () + RandomMismatchError -> expectationFailure "New random samples generated from seed in golden file do not match samples in golden file." + + -- do a fallback test to determine whether the mismatch is due to a random sample change only, + -- or due to a change in encoding + putStrLn $ + "\n" ++ + "WARNING: New random samples do not match those in " ++ goldenFile ++ ".\n" ++ + " Testing round-trip decoding/encoding of golden file." + let reencodedGoldenSamples = encodePretty goldenSamples + if reencodedGoldenSamples == goldenBytes + then + -- pass the test because round-trip decode/encode still gives the same bytes + finalResult + else do + -- how significant is the serialization change? + writeReencodedComparisonFile goldenSamples + testSamples :: RandomSamples a <- + either (throwIO . ErrorCall) return $ + A.eitherDecode' reencodedGoldenSamples + let + failureMessage = + if testSamples == goldenSamples + then + "Encoding has changed in a minor way; still can read old encodings. See " ++ faultyReencodedFile ++ "." + else + "Encoding has changed in a major way; cannot read old encodings. See " ++ faultyReencodedFile ++ "." + expectationFailure failureMessage + finalResult where whenFails :: forall b c. IO c -> IO b -> IO b whenFails = flip onException faultyFile = mkFaultyFilePath topDir mModuleName typeName cap + faultyReencodedFile = mkFaultyReencodedFilePath topDir mModuleName typeName cap writeComparisonFile newSamples = do writeFile faultyFile (encodePretty newSamples) putStrLn $ "\n" ++ "INFO: Written the current encodings into " ++ faultyFile ++ "." + writeReencodedComparisonFile samples = do + writeFile faultyReencodedFile (encodePretty samples) + putStrLn $ + "\n" ++ + "INFO: Written the re-encodings into " ++ faultyReencodedFile ++ "." -- | The golden files do not exist. Create them for each constructor. createGoldenFile :: forall a. (ToJSON a, ToADTArbitrary a) => @@ -147,6 +189,15 @@ case mModuleName of Nothing -> topDir typeName capConstructor cap <.> "faulty" <.> "json" Just moduleName -> topDir moduleName typeName capConstructor cap <.> "faulty" <.> "json" + +-- | Create the file path to save results from a failed fallback golden test. Optionally +-- use the module name to help avoid name collisions. Different modules can +-- have types of the same name. +mkFaultyReencodedFilePath :: forall a. FilePath -> Maybe FilePath -> FilePath -> ConstructorArbitraryPair a -> FilePath +mkFaultyReencodedFilePath topDir mModuleName typeName cap = + case mModuleName of + Nothing -> topDir typeName capConstructor cap <.> "faulty" <.> "reencoded" <.> "json" + Just moduleName -> topDir moduleName typeName capConstructor cap <.> "faulty" <.> "reencoded" <.> "json" -- | Create a number of arbitrary instances of a particular constructor given -- a sample size and a random seed. diff --git a/src/Test/Aeson/Internal/GoldenSpecs.hs b/src/Test/Aeson/Internal/GoldenSpecs.hs --- a/src/Test/Aeson/Internal/GoldenSpecs.hs +++ b/src/Test/Aeson/Internal/GoldenSpecs.hs @@ -88,11 +88,23 @@ sampleSize <- readSampleSize =<< readFile goldenFile newSamples <- mkRandomSamples sampleSize proxy goldenSeed whenFails (writeComparisonFile newSamples) $ do + goldenBytes <- readFile goldenFile goldenSamples :: RandomSamples a <- - either (throwIO . ErrorCall) return =<< - eitherDecode' <$> - readFile goldenFile - encode newSamples `shouldBe` encode goldenSamples + either (throwIO . ErrorCall) return $ + eitherDecode' goldenBytes + if encode newSamples == encode goldenSamples + then return () + else do + -- fallback to testing roundtrip decoding/encoding of golden file + putStrLn $ + "\n" ++ + "WARNING: Encoding new random samples do not match " ++ goldenFile ++ ".\n" ++ + " Testing round-trip decoding/encoding of golden file." + if encodePretty goldenSamples == goldenBytes + then return () + else do + writeReencodedComparisonFile goldenSamples + expectationFailure $ "Serialization has changed. Compare golden file with " ++ faultyReencodedFilePath ++ "." where whenFails :: forall b c . IO c -> IO b -> IO b whenFails = flip onException @@ -100,11 +112,17 @@ case comparisonFile of FaultyFile -> mkFaultyFile typeNameInfo OverwriteGoldenFile -> goldenFile + faultyReencodedFilePath = mkFaultyReencodedFile typeNameInfo writeComparisonFile newSamples = do writeFile filePath (encodePretty newSamples) putStrLn $ "\n" ++ "INFO: Written the current encodings into " ++ filePath ++ "." + writeReencodedComparisonFile samples = do + writeFile faultyReencodedFilePath (encodePretty samples) + putStrLn $ + "\n" ++ + "INFO: Written the reencoded goldenFile into " ++ faultyReencodedFilePath ++ "." -- | The golden files do not exist. Create it. createGoldenfile :: forall a . (Arbitrary a, ToJSON a) => @@ -139,6 +157,15 @@ case unModuleName <$> typeNameModuleName of Nothing -> unTopDir typeNameTopDir unTypeName typeNameTypeName <.> "faulty" <.> "json" Just moduleName -> unTopDir typeNameTopDir moduleName unTypeName typeNameTypeName <.> "faulty" <.> "json" + +-- | Create the file path to save results from a failed fallback golden test. Optionally +-- use the module name to help avoid name collisions. Different modules can +-- have types of the same name. +mkFaultyReencodedFile :: TypeNameInfo a -> FilePath +mkFaultyReencodedFile (TypeNameInfo {typeNameTypeName,typeNameModuleName, typeNameTopDir}) = + case unModuleName <$> typeNameModuleName of + Nothing -> unTopDir typeNameTopDir unTypeName typeNameTypeName <.> "faulty" <.> "reencoded" <.> "json" + Just moduleName -> unTopDir typeNameTopDir moduleName unTypeName typeNameTypeName <.> "faulty" <.> "reencoded" <.> "json" -- | Create a number of arbitrary instances of a type -- a sample size and a random seed. diff --git a/src/Test/Aeson/Internal/Utils.hs b/src/Test/Aeson/Internal/Utils.hs --- a/src/Test/Aeson/Internal/Utils.hs +++ b/src/Test/Aeson/Internal/Utils.hs @@ -25,16 +25,34 @@ import Test.Hspec import Test.QuickCheck - +-- | Option to indicate whether to create a separate comparison file or overwrite the golden file. +-- A separate file allows you to use `diff` to compare. +-- Overwriting allows you to use source control tools for comparison. data ComparisonFile = FaultyFile + -- ^ Create a new faulty file when tests fail | OverwriteGoldenFile + -- ^ Overwrite the golden file when tests fail +-- | Option indicating whether to fail tests when the random seed does not produce the same values as in the golden file. +-- Default is to output a warning. +data RandomMismatchOption + = RandomMismatchWarning + -- ^ Only output a warning when the random seed does not produce the same values + | RandomMismatchError + -- ^ Fail the test when the random seed does not produce the same value + data Settings = Settings - { goldenDirectoryOption :: GoldenDirectoryOption -- ^ use a custom directory name or use the generic "golden" directory. - , useModuleNameAsSubDirectory :: Bool -- ^ If true, use the module name in the file path, otherwise ignore it. - , sampleSize :: Int -- ^ How many instances of each type you want. If you use ADT versions than it will use the sample size for each constructor. + { goldenDirectoryOption :: GoldenDirectoryOption + -- ^ use a custom directory name or use the generic "golden" directory. + , useModuleNameAsSubDirectory :: Bool + -- ^ If true, use the module name in the file path, otherwise ignore it. + , sampleSize :: Int + -- ^ How many instances of each type you want. If you use ADT versions than it will use the sample size for each constructor. , comparisonFile :: ComparisonFile + -- ^ Whether to create a separate comparison file or ovewrite the golden file. + , randomMismatchOption :: RandomMismatchOption + -- ^ Whether to output a warning or fail the test when the random seed produces different values than the values in the golden file. } -- | A custom directory name or a preselected directory name. @@ -42,7 +60,7 @@ -- | The default settings for general use cases. defaultSettings :: Settings -defaultSettings = Settings GoldenDirectory False 5 FaultyFile +defaultSettings = Settings GoldenDirectory False 5 FaultyFile RandomMismatchWarning -- | put brackets around a String. addBrackets :: String -> String diff --git a/test/Test/Aeson/GenericSpecsSpec.hs b/test/Test/Aeson/GenericSpecsSpec.hs --- a/test/Test/Aeson/GenericSpecsSpec.hs +++ b/test/Test/Aeson/GenericSpecsSpec.hs @@ -7,6 +7,7 @@ import System.Directory import Test.Aeson.GenericSpecs +import Test.Aeson.Internal.Utils (RandomMismatchOption(..)) import Test.Hspec import Test.Hspec.Core.Runner @@ -171,17 +172,10 @@ (s1,_) <- hspecSilently $ goldenADTSpecs defaultSettings (Proxy :: Proxy TAS.Person) summaryFailures s1 `shouldBe` 1 - it "encoding change should fail test" $ do - -- clean up previously existing golden folder - bg <- doesDirectoryExist "golden" - if bg - then removeDirectoryRecursive "golden" - else return () - - -- manually create golden file which appends `.0` to all ages. - -- write as inline text to make test case clearer - let - goldenTweaked = "{\ + -- golden file which appends `.0` to all ages. + -- write as inline text to make test case clearer + let + goldenReadCompatible = "{\ \ \"seed\": -558805430132139320,\ \ \"samples\": [\ \ {\ @@ -207,12 +201,65 @@ \ ]\ \}" + it "encoding read-compatible change should fail test" $ do + -- clean up previously existing golden folder + bg <- doesDirectoryExist "golden" + if bg + then removeDirectoryRecursive "golden" + else return () + + -- directly create golden file for tests createDirectoryIfMissing True "golden/Person" - writeFile "golden/Person/Person.json" goldenTweaked + writeFile "golden/Person/Person.json" goldenReadCompatible -- Aeson can decode "10.0" as `10 :: Int` but it will encode `10 :: Int` as 10 -- This should cause the golden test to fail since it indicates a change in encoding (s1,_) <- hspecSilently $ goldenADTSpecs defaultSettings (Proxy :: Proxy T.Person) + summaryFailures s1 `shouldBe` 1 + + let + goldenByteIdentical = "{\n\ +\ \"seed\": 41,\n\ +\ \"samples\": [\n\ +\ {\n\ +\ \"age\": 1,\n\ +\ \"name\": \"abc\"\n\ +\ },\n\ +\ {\n\ +\ \"age\": 2,\n\ +\ \"name\": \"def\"\n\ +\ }\n\ +\ ]\n\ +\}" + + it "different random seed but byte-for-byte identical should pass (default setting)" $ do + -- clean up previously existing golden folder + bg <- doesDirectoryExist "golden" + if bg + then removeDirectoryRecursive "golden" + else return () + + -- directly create golden file for tests + createDirectoryIfMissing True "golden/Person" + writeFile "golden/Person/Person.json" goldenByteIdentical + + (s1,_) <- hspecSilently $ goldenADTSpecs defaultSettings (Proxy :: Proxy T.Person) + summaryFailures s1 `shouldBe` 0 + + it "different random seed but byte-for-byte identical should fail (with custom setting)" $ do + -- clean up previously existing golden folder + bg <- doesDirectoryExist "golden" + if bg + then removeDirectoryRecursive "golden" + else return () + + -- directly create golden file for tests + createDirectoryIfMissing True "golden/Person" + writeFile "golden/Person/Person.json" goldenByteIdentical + + let + customSettings = defaultSettings { randomMismatchOption = RandomMismatchError } + (s1,_) <- hspecSilently $ goldenADTSpecs customSettings (Proxy :: Proxy T.Person) summaryFailures s1 `shouldBe` 1 describe "mkGoldenFileForType" $ do