diff --git a/ChangeLog.md b/ChangeLog.md index 22c5633..ce2eb8a 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -12,7 +12,7 @@ don't exist, to create them, set the `CREATE_MISSING_GOLDEN` environment variable. This is to prevent missing golden files from silently making golden tests degrade to round-trip tests -* Add a `RECREATE_BROKEN_GOLDEN` environemnt variable. When present it will +* Add a `RECREATE_BROKEN_GOLDEN` environment variable. When present it will cause golden files to be re-created if they cause the test to fail. This is useful for updating golden files when serialization has been purposedly modified and to update the seed if it breaks due to overflow now that it is diff --git a/package.yaml b/package.yaml index 625fdb4..d3753b6 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: hspec-golden-aeson -version: 0.9.0.0 +version: 0.10.0.0 synopsis: Use tests to monitor changes in Aeson serialization description: Use tests to monitor changes in Aeson serialization category: Testing @@ -38,7 +38,7 @@ library: - HUnit ghc-options: - -Wall -# - -Werror + - -Werror tests: test: diff --git a/src/Test/Aeson/Internal/ADT/GoldenSpecs.hs b/src/Test/Aeson/Internal/ADT/GoldenSpecs.hs index 3caa82a..f0231bd 100644 --- a/src/Test/Aeson/Internal/ADT/GoldenSpecs.hs +++ b/src/Test/Aeson/Internal/ADT/GoldenSpecs.hs @@ -23,7 +23,7 @@ import Control.Arrow import Control.Exception import Control.Monad -import Data.Aeson (ToJSON, FromJSON) +import Data.Aeson (ToJSON, FromJSON, eitherDecode, encode) import Data.ByteString.Lazy (writeFile, readFile) import Data.Int (Int32) import Data.Maybe (isJust) @@ -105,66 +105,77 @@ testConstructor Settings{..} moduleName typeName cap = -- the golden files of each constructor and compare. compareWithGolden :: forall a. (Show a, Eq a, FromJSON a, ToJSON a, ToADTArbitrary a) => 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 - whenFails (writeComparisonFile newSamples) $ do - goldenBytes <- readFile goldenFile - goldenSamples :: RandomSamples a <- aesonDecodeIO goldenBytes - if newSamples == goldenSamples - then - -- random samples match; test encoding of samples (the above check only tested the decoding) - encodePrettySortedKeys 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 = encodePrettySortedKeys 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 <- aesonDecodeIO 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 (encodePrettySortedKeys newSamples) - putStrLn $ - "\n" ++ - "INFO: Written the current encodings into " ++ faultyFile ++ "." - writeReencodedComparisonFile samples = do - writeFile faultyReencodedFile (encodePrettySortedKeys samples) - putStrLn $ - "\n" ++ - "INFO: Written the re-encodings into " ++ faultyReencodedFile ++ "." +compareWithGolden _randomOption _topDir _mModuleName _typeName _cap goldenFile = do + _goldenSeed <- readSeed =<< readFile goldenFile + _sampleSize <- readSampleSize =<< readFile goldenFile + + goldenBytes <- readFile goldenFile + goldenSamples :: RandomSamples a <- aesonDecodeIO goldenBytes + + let byteStrA = encode goldenSamples + decodedVal = (eitherDecode byteStrA) :: Either String (RandomSamples a) + eitherByteStrB = encode <$> decodedVal + + eitherByteStrB `shouldBe` (Right byteStrA) + + + -- newSamples <- mkRandomADTSamplesForConstructor sampleSize (Proxy :: Proxy a) (capConstructor cap) goldenSeed + -- whenFails (writeComparisonFile newSamples) $ do + -- goldenBytes <- readFile goldenFile + -- goldenSamples :: RandomSamples a <- aesonDecodeIO goldenBytes + -- if newSamples == goldenSamples + -- then + -- -- random samples match; test encoding of samples (the above check only tested the decoding) + -- encodePrettySortedKeys 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 = encodePrettySortedKeys 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 <- aesonDecodeIO 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 (encodePrettySortedKeys newSamples) + -- putStrLn $ + -- "\n" ++ + -- "INFO: Written the current encodings into " ++ faultyFile ++ "." + -- writeReencodedComparisonFile samples = do + -- writeFile faultyReencodedFile (encodePrettySortedKeys 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) => diff --git a/src/Test/Aeson/Internal/GoldenSpecs.hs b/src/Test/Aeson/Internal/GoldenSpecs.hs index ab84872..9147ea1 100644 --- a/src/Test/Aeson/Internal/GoldenSpecs.hs +++ b/src/Test/Aeson/Internal/GoldenSpecs.hs @@ -15,6 +15,7 @@ Internal module, use at your own risk. {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} module Test.Aeson.Internal.GoldenSpecs where import Control.Exception @@ -98,44 +99,59 @@ goldenSpecsWithNotePlain settings@Settings{..} typeNameInfo@(TypeNameInfo{typeNa compareWithGolden :: forall a . ( Arbitrary a, ToJSON a, FromJSON a) => TypeNameInfo a -> Proxy a -> FilePath -> ComparisonFile ->IO () -compareWithGolden typeNameInfo proxy goldenFile comparisonFile = do - goldenSeed <- readSeed =<< readFile goldenFile - sampleSize <- readSampleSize =<< readFile goldenFile - newSamples <- mkRandomSamples sampleSize proxy goldenSeed - whenFails (writeComparisonFile newSamples) $ do - goldenBytes <- readFile goldenFile - goldenSamples :: RandomSamples a <- aesonDecodeIO goldenBytes - if encodePrettySortedKeys newSamples == encodePrettySortedKeys 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 encodePrettySortedKeys 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 - filePath = - case comparisonFile of - FaultyFile -> mkFaultyFile typeNameInfo - OverwriteGoldenFile -> goldenFile - faultyReencodedFilePath = mkFaultyReencodedFile typeNameInfo - writeComparisonFile newSamples = do - writeFile filePath (encodePrettySortedKeys newSamples) - putStrLn $ - "\n" ++ - "INFO: Written the current encodings into " ++ filePath ++ "." - writeReencodedComparisonFile samples = do - writeFile faultyReencodedFilePath (encodePrettySortedKeys samples) - putStrLn $ - "\n" ++ - "INFO: Written the reencoded goldenFile into " ++ faultyReencodedFilePath ++ "." +compareWithGolden _typeNameInfo _proxy goldenFile _comparisonFile = do + _goldenSeed <- readSeed =<< readFile goldenFile + _sampleSize <- readSampleSize =<< readFile goldenFile + goldenBytes <- readFile goldenFile + goldenSamples :: RandomSamples a <- aesonDecodeIO goldenBytes + + -- let e = encodePrettySortedKeys goldenSamples + -- let d = + let byteStrA = encode goldenSamples + decodedVal = (eitherDecode byteStrA) :: Either String a + eitherByteStrB = encode <$> decodedVal + + (Right byteStrA) `shouldBe` eitherByteStrB + + -- let eitherGoldenFile = decodeGoldenFile @a goldenFile + -- let recodedGoldenFile = join (encodeGoldenFile `traverse` eitherGoldenFile) + -- eitherGoldenFile `shouldBe` recodedGoldenFile + + -- newSamples <- mkRandomSamples sampleSize proxy goldenSeed + -- whenFails (writeComparisonFile newSamples) $ do + -- goldenBytes <- readFile goldenFile + -- goldenSamples :: RandomSamples a <- aesonDecodeIO goldenBytes + -- if encodePrettySortedKeys newSamples == encodePrettySortedKeys 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 encodePrettySortedKeys 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 + -- filePath = + -- case comparisonFile of + -- FaultyFile -> mkFaultyFile typeNameInfo + -- OverwriteGoldenFile -> goldenFile + -- faultyReencodedFilePath = mkFaultyReencodedFile typeNameInfo + -- writeComparisonFile newSamples = do + -- writeFile filePath (encodePrettySortedKeys newSamples) + -- putStrLn $ + -- "\n" ++ + -- "INFO: Written the current encodings into " ++ filePath ++ "." + -- writeReencodedComparisonFile samples = do + -- writeFile faultyReencodedFilePath (encodePrettySortedKeys 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) => diff --git a/stack.yaml b/stack.yaml index d130670..f0618cb 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-9.9 +resolver: lts-16.31 packages: - '.' diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..9c8a0e6 --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,19 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: +- completed: + hackage: quickcheck-arbitrary-adt-0.3.0.0@sha256:490d0de779c2851a00531a9bcd70f9a64bb850fb4cfa790331eb6bf9198bbe4a,1471 + pantry-tree: + size: 381 + sha256: 947164bcae0978b2624a1d3777f5b9d97ae3b7f618a16a82430eda67f35b50b5 + original: + hackage: quickcheck-arbitrary-adt-0.3.0.0 +snapshots: +- completed: + size: 534126 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/31.yaml + sha256: 637fb77049b25560622a224845b7acfe81a09fdb6a96a3c75997a10b651667f6 + original: lts-16.31 diff --git a/test/Test/Aeson/GenericSpecsSpec.hs b/test/Test/Aeson/GenericSpecsSpec.hs index 0b42a0d..3a13d8a 100644 --- a/test/Test/Aeson/GenericSpecsSpec.hs +++ b/test/Test/Aeson/GenericSpecsSpec.hs @@ -5,6 +5,7 @@ module Test.Aeson.GenericSpecsSpec where import Data.Proxy import System.Directory +import System.Environment (setEnv) import Test.Aeson.GenericSpecs import Test.Aeson.Internal.Utils (RandomMismatchOption(..)) @@ -24,6 +25,8 @@ import qualified Test.Types.NewSelector as TNS -- summaryFailures spec :: Spec spec = do + runIO $ setEnv "CREATE_MISSING_GOLDEN" "true" + describe "Test.Aeson.GenericSpecs: roundtripSpecs" $ do it "should pass when ToJSON and FromJSON are defined appropriately" $ do (s1,_) <- hspecSilently $ roundtripSpecs (Proxy :: Proxy T.Person) @@ -51,7 +54,7 @@ spec = do else return () -- files for Person and SumType do not exist - -- create them by running goldenADTSpecs + -- create them by running goldenSpecs _ <- hspecSilently $ goldenSpecs defaultSettings (Proxy :: Proxy T.Person) _ <- hspecSilently $ goldenSpecs defaultSettings (Proxy :: Proxy T.SumType) @@ -66,7 +69,7 @@ spec = do else return () -- files for Person and SumType do not exist - -- create them by running goldenADTSpecs + -- create them by running goldenSpecs _ <- hspecSilently $ goldenSpecs (defaultSettings { useModuleNameAsSubDirectory = True }) (Proxy :: Proxy T.Person) _ <- hspecSilently $ goldenSpecs (defaultSettings { useModuleNameAsSubDirectory = True }) (Proxy :: Proxy T.SumType) @@ -82,27 +85,27 @@ spec = do else return () -- files for Person and SumType do not exist - -- create them by running goldenADTSpecs + -- create them by running goldenSpecs _ <- hspecSilently $ goldenSpecs (defaultSettings {goldenDirectoryOption = CustomDirectoryName topDir}) (Proxy :: Proxy T.Person) _ <- hspecSilently $ goldenSpecs (defaultSettings {goldenDirectoryOption = CustomDirectoryName topDir}) (Proxy :: Proxy T.SumType) doesFileExist "json-tests/Person.json" `shouldReturn` True doesFileExist "json-tests/SumType.json" `shouldReturn` True - it "goldenADTSpecs should pass for existing golden files in which model types and serialization have not changed" $ do + it "goldenSpecs should pass for existing golden files in which model types and serialization have not changed" $ do (s1,_) <- hspecSilently $ goldenSpecs defaultSettings (Proxy :: Proxy T.Person) (s2,_) <- hspecSilently $ goldenSpecs defaultSettings (Proxy :: Proxy T.SumType) (summaryFailures s1 + summaryFailures s2) `shouldBe` 0 - it "goldenADTSpecs for types which have changed the values of ToJSON or FromJSON keys should fail to match the goldenFiles" $ do + it "goldenSpecs for types which have changed the values of ToJSON or FromJSON keys should fail to match the goldenFiles" $ do (s1,_) <- hspecSilently $ goldenSpecs defaultSettings (Proxy :: Proxy TBS.Person) summaryFailures s1 `shouldBe` 1 - it "goldenADTSpecs for types which have changed the values of ToJSON or FromJSON keys should fail to match the goldenFiles" $ do + it "goldenSpecs for types which have changed the values of ToJSON or FromJSON keys should fail to match the goldenFiles" $ do (s1,_) <- hspecSilently $ goldenSpecs defaultSettings (Proxy :: Proxy TNS.Person) summaryFailures s1 `shouldBe` 1 - it "goldenADTSpecs for types which have altered the name of the selector and using generic implementation of ToJSON and FromJSON should fail to match the goldenFiles" $ do + it "goldenSpecs for types which have altered the name of the selector and using generic implementation of ToJSON and FromJSON should fail to match the goldenFiles" $ do (s1,_) <- hspecSilently $ goldenSpecs defaultSettings (Proxy :: Proxy TAS.Person) summaryFailures s1 `shouldBe` 1 @@ -156,7 +159,9 @@ spec = do doesFileExist "json-tests/SumType/SumType3.json" `shouldReturn` True it "goldenADTSpecs should pass for existing golden files in which model types and serialization have not changed" $ do - (s1,_) <- hspecSilently $ goldenADTSpecs defaultSettings (Proxy :: Proxy T.Person) + (s1,z) <- hspecSilently $ goldenADTSpecs defaultSettings (Proxy :: Proxy T.Person) + print s1 + print z (s2,_) <- hspecSilently $ goldenADTSpecs defaultSettings (Proxy :: Proxy T.SumType) (summaryFailures s1 + summaryFailures s2) `shouldBe` 0 @@ -244,6 +249,7 @@ spec = do writeFile "golden/Person/Person.json" goldenByteIdentical (s1,_) <- hspecSilently $ goldenADTSpecs defaultSettings (Proxy :: Proxy T.Person) + print s1 summaryFailures s1 `shouldBe` 0 it "different random seed but byte-for-byte identical should fail (with custom setting)" $ do