Try removing random sample generation from compareWithGolden

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

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:

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) =>

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) =>

stack.yaml

@@ -1,4 +1,4 @@
-resolver: lts-9.9
+resolver: lts-16.31
 
 packages:
 - '.'

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

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