hspec-golden-aeson 0.1.0.0 → 0.2.0.0

raw patch · 9 files changed

+331/−109 lines, 9 filesdep ~quickcheck-arbitrary-adtPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: quickcheck-arbitrary-adt

API changes (from Hackage documentation)

Files

• hspec-golden-aeson.cabal +3/−3
• src/Test/Aeson/GenericSpecs.hs +41/−10
• src/Test/Aeson/Internal/ADT/GoldenSpecs.hs +77/−25
• src/Test/Aeson/Internal/ADT/RoundtripSpecs.hs +20/−8
• src/Test/Aeson/Internal/GoldenSpecs.hs +90/−45
• src/Test/Aeson/Internal/RandomSamples.hs +15/−3
• src/Test/Aeson/Internal/RoundtripSpecs.hs +15/−4
• src/Test/Aeson/Internal/Utils.hs +26/−0
• test/Test/Aeson/GenericSpecsSpec.hs +44/−11

@@ -1,5 +1,5 @@ name:                hspec-golden-aeson-version:             0.1.0.0+version:             0.2.0.0 synopsis:            Use tests to monitor changes in Aeson serialization description:         Use tests to monitor changes in Aeson serialization homepage:            https://github.com/plow-technologies/hspec-golden-aeson#readme@@ -30,7 +30,7 @@                      , filepath                      , hspec                      , random-                     , quickcheck-arbitrary-adt+                     , quickcheck-arbitrary-adt >= 0.2.0.0                      , QuickCheck                      , transformers   default-language:    Haskell2010@@ -55,7 +55,7 @@                      , quickcheck-arbitrary-adt                      , QuickCheck                      , transformers-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  ghc-options:         -Wall -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fno-warn-name-shadowing   default-language:    Haskell2010  source-repository head

@@ -1,3 +1,19 @@+{-|+Module      : Test.Aeson.GenericSpecs+Description : Export all necessary functions+Copyright   : (c) Plow Technologies, 2016+License     : BSD3+Maintainer  : mchaver@gmail.com+Stability   : Beta++This package provides tools for testing Aeson serialization.++- Test that 'ToJSON' and 'FromJSON' instances are isomorphic.+- Alert you when unexpected changes in Aeson serialization occur.+- Record JSON formatting of Haskell types.++-}+ {-# LANGUAGE ScopedTypeVariables #-}  module Test.Aeson.GenericSpecs (@@ -10,8 +26,13 @@ , goldenADTSpecs , roundtripADTSpecs , roundtripAndGoldenADTSpecs+, roundtripAndGoldenADTSpecsWithSettings +  -- * Util , shouldBeIdentity+, GoldenDirectoryOption(..)+, Settings(..)+, defaultSettings    -- * re-exports , Proxy(..)@@ -35,21 +56,31 @@ -- compared, the sampleSize is derived from the file. roundtripAndGoldenSpecs :: forall a.   (Arbitrary a, Eq a, Show a, ToJSON a, FromJSON a, Typeable a)-  => Int-  -> Proxy a-  -> Spec-roundtripAndGoldenSpecs sampleSize proxy = do+  => Proxy a -> Spec+roundtripAndGoldenSpecs proxy =+  roundtripAndGoldenSpecsWithSettings defaultSettings proxy++-- | 'roundtripAndGoldenSpecs' with custom settings.+roundtripAndGoldenSpecsWithSettings :: forall a.+  (Arbitrary a, Eq a, Show a, ToJSON a, FromJSON a, Typeable a)+  => Settings -> Proxy a -> Spec+roundtripAndGoldenSpecsWithSettings settings proxy = do   roundtripSpecs proxy-  goldenSpecs sampleSize proxy+  goldenSpecs settings proxy  -- | run roundtrip and golden tests for all constructors of a type. -- sampleSize is used only when creating the golden files. When they are -- compared, the sampleSize is derived from the file. roundtripAndGoldenADTSpecs :: forall a.   (Arbitrary a, ToADTArbitrary a, Eq a, Show a, ToJSON a, FromJSON a)-  => Int-  -> Proxy a-  -> Spec-roundtripAndGoldenADTSpecs sampleSize proxy = do+  => Proxy a -> Spec+roundtripAndGoldenADTSpecs proxy =+  roundtripAndGoldenADTSpecsWithSettings defaultSettings proxy++-- | 'roundtripAndGoldenADTSpecs' with custom settings.+roundtripAndGoldenADTSpecsWithSettings :: forall a.+  (Arbitrary a, ToADTArbitrary a, Eq a, Show a, ToJSON a, FromJSON a)+  => Settings -> Proxy a -> Spec+roundtripAndGoldenADTSpecsWithSettings settings proxy = do   roundtripADTSpecs proxy-  goldenADTSpecs sampleSize proxy+  goldenADTSpecs settings proxy

@@ -1,6 +1,18 @@+{-|+Module      : Test.Aeson.Internal.ADT.GoldenSpecs+Description : Golden tests for ToADTArbitrary+Copyright   : (c) Plow Technologies, 2016+License     : BSD3+Maintainer  : mchaver@gmail.com+Stability   : Beta++Internal module, use at your own risk.+-}+ {-# LANGUAGE FlexibleContexts     #-} {-# LANGUAGE FlexibleInstances    #-} {-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE RecordWildCards      #-} {-# LANGUAGE ScopedTypeVariables  #-} {-# LANGUAGE TypeOperators        #-} {-# LANGUAGE UndecidableInstances #-}@@ -24,42 +36,65 @@ import           System.Random  import           Test.Aeson.Internal.RandomSamples+import           Test.Aeson.Internal.Utils import           Test.Hspec import           Test.QuickCheck import           Test.QuickCheck.Arbitrary.ADT --- | for a type a, create a set of golden files if they do not exist, compare--- with golden file if it exists. Golden file encodes json format of a type+-- | Tests to ensure that JSON encoding has not unintentionally changed. This+-- could be caused by the following:+--+-- - A type's instances of `ToJSON` or 'FromJSON' have changed.+-- - Selectors have been edited, added or deleted.+-- - You have changed version of Aeson the way Aeson serialization has changed+--   works.+--+-- If you run this function and the golden files do not+-- exist, it will create them for each constructor. It they do exist, it will+-- compare with golden file if it exists. Golden file encodes json format of a+-- type. It is recommended that you put the golden files under revision control+-- to help monitor changes. goldenADTSpecs :: forall a. (ToADTArbitrary a, Eq a, Show a, Arbitrary a, ToJSON a, FromJSON a) =>-  Int -> Proxy a -> Spec-goldenADTSpecs sampleSize proxy = goldenADTSpecsWithNote sampleSize proxy Nothing+  Settings -> Proxy a -> Spec+goldenADTSpecs settings proxy = goldenADTSpecsWithNote settings proxy Nothing +-- | same as 'goldenADTSpecs' but has the option of passing a note to the+-- 'describe' function. goldenADTSpecsWithNote :: forall a. (ToADTArbitrary a, Eq a, Show a, Arbitrary a, ToJSON a, FromJSON a) =>-  Int -> Proxy a -> Maybe String -> Spec-goldenADTSpecsWithNote sampleSize Proxy mNote = do-  (typeName,constructors) <- runIO $ fmap (_adtTypeName &&& _adtCAPs) <$> generate $ toADTArbitrary (Proxy :: Proxy a)+  Settings -> Proxy a -> Maybe String -> Spec+goldenADTSpecsWithNote settings Proxy mNote = do+  (moduleName,(typeName,constructors)) <- runIO $ fmap (adtModuleName &&& adtTypeName &&& adtCAPs) <$> generate $ toADTArbitrary (Proxy :: Proxy a)   describe ("JSON encoding of " ++ typeName ++ note) $-    mapM_ (testConstructor sampleSize typeName) constructors+    mapM_ (testConstructor settings moduleName typeName) constructors   where     note = maybe "" (" " ++) mNote +-- | test a single set of values from a constructor for a given type. testConstructor :: forall a. (Eq a, Show a, FromJSON a, ToJSON a, ToADTArbitrary a) =>-  Int -> String -> ConstructorArbitraryPair a -> SpecWith ( Arg (IO ()))-testConstructor sampleSize typeName cap =+  Settings -> String -> String -> ConstructorArbitraryPair a -> SpecWith ( Arg (IO ()))+testConstructor Settings{..} moduleName typeName cap = do   it ("produces the same JSON as is found in " ++ goldenFile) $ do     exists <- doesFileExist goldenFile     if exists-      then compareWithGolden typeName cap goldenFile+      then compareWithGolden topDir mModuleName typeName cap goldenFile       else createGoldenFile sampleSize cap goldenFile   where-    goldenFile = mkGoldenFilePath typeName cap+    goldenFile = mkGoldenFilePath topDir mModuleName typeName cap+    topDir = case goldenDirectoryOption of+      GoldenDirectory -> "golden"+      CustomDirectoryName d -> d+    mModuleName = case useModuleNameAsSubDirectory of+      True  -> Just moduleName+      False -> Nothing +-- | 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 -> ConstructorArbitraryPair a -> FilePath -> IO ()-compareWithGolden typeName cap goldenFile = do+  String -> Maybe String -> String -> ConstructorArbitraryPair a -> FilePath -> IO ()+compareWithGolden topDir mModuleName typeName cap goldenFile = do   goldenSeed <- readSeed =<< readFile goldenFile   sampleSize <- readSampleSize =<< readFile goldenFile-  newSamples <- mkRandomADTSamplesForConstructor sampleSize (Proxy :: Proxy a) (_capConstructor cap) goldenSeed+  newSamples <- mkRandomADTSamplesForConstructor sampleSize (Proxy :: Proxy a) (capConstructor cap) goldenSeed   whenFails (writeComparisonFile newSamples) $ do     goldenSamples :: RandomSamples a <-       either (throwIO . ErrorCall) return =<<@@ -69,19 +104,22 @@   where     whenFails :: forall b c. IO c -> IO b -> IO b     whenFails = flip onException-    faultyFile = mkFaultyFilePath typeName cap++    faultyFile = mkFaultyFilePath topDir mModuleName typeName cap+     writeComparisonFile newSamples = do       writeFile faultyFile (encodePretty newSamples)       putStrLn $         "\n" ++         "INFO: Written the current encodings into " ++ faultyFile ++ "." +-- | The golden files do not exist. Create them for each constructor. createGoldenFile :: forall a. (ToJSON a, ToADTArbitrary a) =>   Int -> ConstructorArbitraryPair a -> FilePath -> IO () createGoldenFile sampleSize cap goldenFile = do   createDirectoryIfMissing True (takeDirectory goldenFile)   rSeed <- randomIO :: IO Int-  rSamples <- mkRandomADTSamplesForConstructor sampleSize (Proxy :: Proxy a) (_capConstructor cap) rSeed+  rSamples <- mkRandomADTSamplesForConstructor sampleSize (Proxy :: Proxy a) (capConstructor cap) rSeed   writeFile goldenFile $ encodePretty rSamples    putStrLn $@@ -91,20 +129,34 @@     "  will compare JSON encodings with this from now on.\n" ++     "  Please, consider putting " ++ goldenFile ++ " under version control." -mkGoldenFilePath :: forall a. String -> ConstructorArbitraryPair a -> FilePath-mkGoldenFilePath typeName cap = "golden" </> typeName </> _capConstructor cap <.> "json"+-- | Create the file path for the golden file. Optionally use the module name to+-- help avoid name collissions. Different modules can have types of the same+-- name.+mkGoldenFilePath :: forall a. FilePath -> Maybe FilePath -> FilePath -> ConstructorArbitraryPair a -> FilePath+mkGoldenFilePath topDir mModuleName typeName cap =+  case mModuleName of+    Nothing -> topDir </> typeName </> capConstructor cap <.> "json"+    Just moduleName -> topDir </> moduleName </> typeName </> capConstructor cap <.> "json" -mkFaultyFilePath :: forall a. String -> ConstructorArbitraryPair a -> FilePath-mkFaultyFilePath typeName cap = "golden" </> typeName </> _capConstructor cap <.> "faulty" <.> "json"+-- | Create the file path to save results from a failed golden test. Optionally+-- use the module name to help avoid name collisions.  Different modules can+-- have types of the same name.+mkFaultyFilePath :: forall a. FilePath -> Maybe FilePath -> FilePath -> ConstructorArbitraryPair a -> FilePath+mkFaultyFilePath topDir mModuleName typeName cap =+  case mModuleName of+    Nothing -> topDir </> typeName </> capConstructor cap <.> "faulty" <.> "json"+    Just moduleName -> topDir </> moduleName </> typeName </> capConstructor cap <.> "faulty" <.> "json" +-- | Create a number of arbitrary instances of a particular constructor given+-- a sample size and a random seed. mkRandomADTSamplesForConstructor :: forall a. (ToADTArbitrary a) =>   Int -> Proxy a -> String -> Int -> IO (RandomSamples a) mkRandomADTSamplesForConstructor sampleSize Proxy conName rSeed = do   generatedADTs <- generate gen-  let caps         = concat $ _adtCAPs <$> generatedADTs-      filteredCAPs = filter (\x -> _capConstructor x == conName) caps-      arbs         = _capArbitrary <$> filteredCAPs+  let caps         = concat $ adtCAPs <$> generatedADTs+      filteredCAPs = filter (\x -> capConstructor x == conName) caps+      arbs         = capArbitrary <$> filteredCAPs   return $ RandomSamples rSeed arbs   where     correctedSampleSize = if sampleSize <= 0 then 1 else sampleSize-    gen = setSeed rSeed $ replicateM sampleSize (toADTArbitrary (Proxy :: Proxy a))+    gen = setSeed rSeed $ replicateM correctedSampleSize (toADTArbitrary (Proxy :: Proxy a))

@@ -1,6 +1,16 @@+{-|+Module      : Test.Aeson.Internal.ADT.RoundtripSpecs+Description : Roundtrip tests for ToADTArbitrary+Copyright   : (c) Plow Technologies, 2016+License     : BSD3+Maintainer  : mchaver@gmail.com+Stability   : Beta++Internal module, use at your own risk.+-}+ {-# LANGUAGE ScopedTypeVariables #-} --- | Internal module, use at your own risk. module Test.Aeson.Internal.ADT.RoundtripSpecs where  import           Control.Arrow@@ -16,12 +26,12 @@  import Control.Monad --- | A roundtrip test to check whether values of the given type--- can be successfully converted to JSON and back to a Haskell value.+-- | A roundtrip test to check whether values of all of constructors of the+-- given type can be successfully converted to JSON and back to a Haskell value. ----- 'roundtripSpecs' will+-- 'roundtripADTSpecs' will ----- - create random values using 'Arbitrary',+-- - create random values for each constructor using 'ToADTArbitrary', -- - convert them into JSON using 'ToJSON', -- - read them back into Haskell using 'FromJSON' and -- - make sure that the result is the same as the value it started with@@ -32,6 +42,8 @@   -> Spec roundtripADTSpecs proxy = genericAesonRoundtripADTWithNote proxy Nothing +-- | Same as 'roundtripADTSpecs' but has the option of passing a note to the+-- 'describe' function. genericAesonRoundtripADTWithNote :: forall a.   (ToADTArbitrary a, Eq a, Show a, Arbitrary a, ToJSON a, FromJSON a)   => Proxy a@@ -39,9 +51,9 @@   -> Spec genericAesonRoundtripADTWithNote _ mNote = do   adt <- runIO $ generate (toADTArbitrary (Proxy :: Proxy a))-  describe ("JSON encoding of " ++ addBrackets (_adtTypeName adt) ++ note) $+  describe ("JSON encoding of " ++ addBrackets (adtTypeName adt) ++ note) $     it "allows to encode values with aeson and read them back" $-      forM_ (_adtCAPs adt) $ \cap ->-        (Aeson.encode >>> aesonDecodeIO) (_capArbitrary cap) `shouldReturn` _capArbitrary cap+      forM_ (adtCAPs adt) $ \cap ->+        (Aeson.encode >>> aesonDecodeIO) (capArbitrary cap) `shouldReturn` capArbitrary cap   where     note = maybe "" (" " ++) mNote

@@ -1,4 +1,16 @@-{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : Test.Aeson.Internal.GoldenSpecs+Description : Golden tests for Arbitrary+Copyright   : (c) Plow Technologies, 2016+License     : BSD3+Maintainer  : mchaver@gmail.com+Stability   : Beta++Internal module, use at your own risk.+-}++{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE RecordWildCards     #-} {-# LANGUAGE ScopedTypeVariables #-}  module Test.Aeson.Internal.GoldenSpecs where@@ -23,60 +35,55 @@ import           Test.Hspec import           Test.QuickCheck --- | Allows to obtain tests that will try to ensure that the JSON encoding--- didn't change unintentionally. To this end 'goldenSpecs' will+-- | Tests to ensure that JSON encoding has not unintentionally changed. This+-- could be caused by the following: ----- - write a file @golden.json/TYPENAME.json@ in the current directory---   containing a number of JSON-encoded sample values,--- - during subsequent tests it will encode the same sample values again and---   compare them with the saved golden encodings,--- - on failure it will create a file @golden.json/TYPENAME.faulty.json@ for---   easy manual inspection.+-- - A type's instances of `ToJSON` or 'FromJSON' have changed.+-- - Selectors have been edited, added or deleted.+-- - You have changed version of Aeson the way Aeson serialization has changed+--   works. ----- You can consider putting the golden files under revision control. That way--- it'll be obvious when JSON encodings change.+-- If you run this function and the golden files do not+-- exist, it will create them for each constructor. It they do exist, it will+-- compare with golden file if it exists. Golden file encodes json format of a+-- type. It is recommended that you put the golden files under revision control+-- to help monitor changes. goldenSpecs :: (Eq a, Show a, Typeable a, Arbitrary a, ToJSON a, FromJSON a) =>-  Int -> Proxy a -> Spec-goldenSpecs sampleSize proxy = goldenSpecsWithNote sampleSize proxy Nothing+  Settings -> Proxy a -> Spec+goldenSpecs settings proxy = goldenSpecsWithNote settings proxy Nothing -goldenSpecsWithNote :: (Eq a, Show a, Typeable a, Arbitrary a, ToJSON a, FromJSON a) =>-  Int -> Proxy a -> Maybe String -> Spec-goldenSpecsWithNote sampleSize proxy mNote = do-  let goldenFile = mkGoldenFile proxy+-- | same as 'goldenSpecs' but has the option of passing a note to the+-- 'describe' function.+goldenSpecsWithNote :: forall a. (Eq a, Show a, Typeable a, Arbitrary a, ToJSON a, FromJSON a) =>+  Settings -> Proxy a -> Maybe String -> Spec+goldenSpecsWithNote settings@Settings{..} proxy mNote = do+  mModuleName <-+    if useModuleNameAsSubDirectory+      then return Nothing+      else do+        arbA <- runIO $ generate (arbitrary :: Gen a)+        return $ Just $ show . tyConModule . typeRepTyCon . typeOf $ arbA++  let goldenFile = mkGoldenFile topDir mModuleName proxy       note = maybe "" (" " ++) mNote+   describe ("JSON encoding of " ++ addBrackets (show (typeRep proxy)) ++ note) $     it ("produces the same JSON as is found in " ++ goldenFile) $ do       exists <- doesFileExist goldenFile       if exists-        then compareWithGolden proxy goldenFile-        else createGoldenfile sampleSize proxy goldenFile--mkGoldenFile :: Typeable a => Proxy a -> FilePath-mkGoldenFile proxy =-  "golden.json" </> show (typeRep proxy) <.> "json"--mkFaultyFile :: Typeable a => Proxy a -> FilePath-mkFaultyFile proxy =-  "golden.json" </> show (typeRep proxy) <.> "faulty" <.> "json"--createGoldenfile :: forall a . (Show a, Arbitrary a, ToJSON a) =>-  Int -> Proxy a -> FilePath -> IO ()-createGoldenfile sampleSize proxy goldenFile = do-  createDirectoryIfMissing True (takeDirectory goldenFile)-  rSeed <- randomIO-  rSamples <- mkRandomSamples sampleSize proxy rSeed-  writeFile goldenFile (encodePretty rSamples)-  putStrLn $-    "\n" ++-    "WARNING: Running for the first time, not testing anything.\n" ++-    "  Created " ++ goldenFile ++ " containing random samples,\n" ++-    "  will compare JSON encodings with this from now on.\n" ++-    "  Please, consider putting " ++ goldenFile ++ " under version control."+        then compareWithGolden topDir mModuleName proxy goldenFile+        else createGoldenfile settings proxy goldenFile+  where+    topDir = case goldenDirectoryOption of+      GoldenDirectory -> "golden"+      CustomDirectoryName d -> d +-- | The golden files already exist. Serialize values with the same seed from+-- the golden file and compare the with the JSON in the golden file. compareWithGolden :: forall a .   (Eq a, Show a, Typeable a, Arbitrary a, ToJSON a, FromJSON a) =>-  Proxy a -> FilePath -> IO ()-compareWithGolden proxy goldenFile = do+  FilePath -> Maybe FilePath -> Proxy a -> FilePath -> IO ()+compareWithGolden topDir mModuleName proxy goldenFile = do   goldenSeed <- readSeed =<< readFile goldenFile   sampleSize <- readSampleSize =<< readFile goldenFile   newSamples <- mkRandomSamples sampleSize proxy goldenSeed@@ -90,12 +97,50 @@     whenFails :: forall b c . IO c -> IO b -> IO b     whenFails = flip onException +    faultyFile = mkFaultyFile topDir mModuleName proxy+     writeComparisonFile newSamples = do-      writeFile (mkFaultyFile proxy) (encodePretty newSamples)+      writeFile faultyFile (encodePretty newSamples)       putStrLn $         "\n" ++-        "INFO: Written the current encodings into " ++ mkFaultyFile proxy ++ "."+        "INFO: Written the current encodings into " ++ faultyFile ++ "." +-- | The golden files do not exist. Create it.+createGoldenfile :: forall a . (Show a, Arbitrary a, ToJSON a) =>+  Settings -> Proxy a -> FilePath -> IO ()+createGoldenfile Settings{..} proxy goldenFile = do+  createDirectoryIfMissing True (takeDirectory goldenFile)+  rSeed <- randomIO+  rSamples <- mkRandomSamples sampleSize proxy rSeed+  writeFile goldenFile (encodePretty rSamples)++  putStrLn $+    "\n" +++    "WARNING: Running for the first time, not testing anything.\n" +++    "  Created " ++ goldenFile ++ " containing random samples,\n" +++    "  will compare JSON encodings with this from now on.\n" +++    "  Please, consider putting " ++ goldenFile ++ " under version control."++-- | Create the file path for the golden file. Optionally use the module name to+-- help avoid name collissions. Different modules can have types of the same+-- name.+mkGoldenFile :: Typeable a => FilePath -> Maybe FilePath -> Proxy a -> FilePath+mkGoldenFile topDir mModuleName proxy =+  case mModuleName of+    Nothing         -> topDir </> show (typeRep proxy) <.> "json"+    Just moduleName -> topDir </> moduleName </> show (typeRep proxy) <.> "json"++-- | Create the file path to save results from a failed golden test. Optionally+-- use the module name to help avoid name collisions.  Different modules can+-- have types of the same name.+mkFaultyFile :: Typeable a => FilePath -> Maybe FilePath -> Proxy a -> FilePath+mkFaultyFile topDir mModuleName proxy =+  case mModuleName of+    Nothing         -> topDir </> show (typeRep proxy) <.> "faulty" <.> "json"+    Just moduleName -> topDir </> moduleName </> show (typeRep proxy) <.> "faulty" <.> "json"++-- | Create a number of arbitrary instances of a type+-- a sample size and a random seed. mkRandomSamples :: forall a . Arbitrary a =>   Int -> Proxy a -> Int -> IO (RandomSamples a) mkRandomSamples sampleSize Proxy rSeed = RandomSamples rSeed <$> generate gen

@@ -1,3 +1,14 @@+{-|+Module      : Test.Aeson.Internal.RandomSamples+Description : Types and functions to faciliate sampling+Copyright   : (c) Plow Technologies, 2016+License     : BSD3+Maintainer  : mchaver@gmail.com+Stability   : Beta++Internal module, use at your own risk.+-}+ {-# LANGUAGE DeriveGeneric        #-} {-# LANGUAGE ScopedTypeVariables  #-} @@ -17,7 +28,7 @@  -- | RandomSamples, using a seed allows you to replicate an arbitrary. By -- storing the seed and the samples (previously produced arbitraries), we can--- try to reproduce the same samples by generating the arbitraries with a seed+-- try to reproduce the same samples by generating the arbitraries with a seed.  data RandomSamples a = RandomSamples {   seed    :: Int@@ -27,16 +38,17 @@ instance FromJSON a => FromJSON (RandomSamples a) instance ToJSON   a => ToJSON   (RandomSamples a) +-- | Apply the seed. setSeed :: Int -> Gen a -> Gen a setSeed rSeed (MkGen g) = MkGen $ \ _randomSeed size -> g (mkQCGen rSeed) size --- | reads the seed without looking at the samples+-- | Reads the seed without looking at the samples. readSeed :: ByteString -> IO Int readSeed s = case eitherDecode s :: Either String (RandomSamples Value) of   Right rSamples -> return $ seed rSamples   Left err -> throwIO $ ErrorCall err --- | read the sample size+-- | Read the sample size. readSampleSize :: ByteString -> IO Int readSampleSize s = case eitherDecode s :: Either String (RandomSamples Value) of   Right rSamples -> return . length . samples $ rSamples

@@ -1,6 +1,16 @@+{-|+Module      : Test.Aeson.Internal.RoundtripSpecs+Description : Roundtrip tests for Arbitrary+Copyright   : (c) Plow Technologies, 2016+License     : BSD3+Maintainer  : mchaver@gmail.com+Stability   : Beta++Internal module, use at your own risk.+-}+ {-# LANGUAGE ScopedTypeVariables #-} --- | Internal module, use at your own risk. module Test.Aeson.Internal.RoundtripSpecs where  import           Control.Arrow@@ -12,8 +22,8 @@ import           Test.Hspec import           Test.QuickCheck --- | Allows to obtain a roundtrip test to check whether values of the given type--- can be successfully converted to JSON and back.+-- | A roundtrip test to check whether values of the given type+-- can be successfully converted to JSON and back to a Haskell value. -- -- 'roundtripSpecs' will --@@ -27,7 +37,8 @@   Proxy a -> Spec roundtripSpecs proxy = genericAesonRoundtripWithNote proxy Nothing --- | use this directly if you want to add your own notes.+-- | Same as 'roundtripSpecs', but optionally add notes to the 'describe'+-- function. genericAesonRoundtripWithNote :: forall a .   (Typeable a, Eq a, Show a, Arbitrary a, ToJSON a, FromJSON a) =>   Proxy a -> Maybe String -> Spec

@@ -1,3 +1,13 @@+{-|+Module      : Test.Aeson.Internal.Utils+Description : Utility types, functions and values+Copyright   : (c) Plow Technologies, 2016+License     : BSD3+Maintainer  : mchaver@gmail.com+Stability   : Beta+-}++ {-# LANGUAGE ScopedTypeVariables #-}  module Test.Aeson.Internal.Utils where@@ -12,6 +22,22 @@  import           Test.Hspec import           Test.QuickCheck+++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.+}++-- | A custom directory name or a preselected directory name.+data GoldenDirectoryOption = CustomDirectoryName String | GoldenDirectory++-- | The default settings for general use cases.+defaultSettings :: Settings+defaultSettings = Settings GoldenDirectory False 5  -- | put brackets around a String. addBrackets :: String -> String

@@ -23,17 +23,22 @@ import qualified Test.Types                     as T import qualified Test.Types.AlteredSelector     as TAS import qualified Test.Types.BrokenSerialization as TBS+import qualified Test.Types.MismatchedToAndFromSerialization as MTFS import qualified Test.Types.NewSelector         as TNS   -- summaryFailures spec :: Spec spec = do-  describe "Test.Aeson.GenericSpecs: roundTrip" $-    it "" $ do+  describe "Test.Aeson.GenericSpecs: roundTrip" $ do+    it "should pass when ToJSON and FromJSON are defined appropriately" $ do       (s1,_) <- hspecSilently $ roundtripADTSpecs (Proxy :: Proxy T.Person)       summaryFailures s1 `shouldBe` 0 +    it "should fail when ToJSON and FromJSON definitions do not match" $ do+      (s1,_) <- hspecSilently $ roundtripADTSpecs (Proxy :: Proxy MTFS.Person)+      summaryFailures s1 `shouldBe` 1+   describe "Test.Aeson.GenericSpecs: goldenADTSpecs" $ do     it "create golden test files" $ do       -- clean up previously existing golden folder@@ -44,32 +49,60 @@        -- files for Person and SumType do not exist       -- create them by running goldenADTSpecs-      _ <- hspecSilently $ goldenADTSpecs 5 (Proxy :: Proxy T.Person)-      _ <- hspecSilently $ goldenADTSpecs 5 (Proxy :: Proxy T.SumType)+      _ <- hspecSilently $ goldenADTSpecs defaultSettings (Proxy :: Proxy T.Person)+      _ <- hspecSilently $ goldenADTSpecs defaultSettings (Proxy :: Proxy T.SumType)        doesFileExist "golden/Person/Person.json"    `shouldReturn` True       doesFileExist "golden/SumType/SumType1.json" `shouldReturn` True       doesFileExist "golden/SumType/SumType2.json" `shouldReturn` True       doesFileExist "golden/SumType/SumType3.json" `shouldReturn` True ++    it "create golden test files in a sub directory using the module name" $ do+      -- files for Person and SumType do not exist+      -- create them by running goldenADTSpecs+      _ <- hspecSilently $ goldenADTSpecs defaultSettings {useModuleNameAsSubDirectory = True } (Proxy :: Proxy T.Person)+      _ <- hspecSilently $ goldenADTSpecs defaultSettings {useModuleNameAsSubDirectory = True } (Proxy :: Proxy T.SumType)++      doesFileExist "golden/Test.Types/Person/Person.json"    `shouldReturn` True+      doesFileExist "golden/Test.Types/SumType/SumType1.json" `shouldReturn` True+      doesFileExist "golden/Test.Types/SumType/SumType2.json" `shouldReturn` True+      doesFileExist "golden/Test.Types/SumType/SumType3.json" `shouldReturn` True++    it "create golden test files in a user defined directory" $ do+      let topDir = "json-tests"+      -- clean up previously existing user defined folder+      bg <- doesDirectoryExist topDir+      if bg+        then removeDirectoryRecursive topDir+        else return ()++      -- files for Person and SumType do not exist+      -- create them by running goldenADTSpecs+      _ <- hspecSilently $ goldenADTSpecs (defaultSettings {goldenDirectoryOption = CustomDirectoryName topDir}) (Proxy :: Proxy T.Person)+      _ <- hspecSilently $ goldenADTSpecs (defaultSettings {goldenDirectoryOption = CustomDirectoryName topDir}) (Proxy :: Proxy T.SumType)++      doesFileExist "json-tests/Person/Person.json"    `shouldReturn` True+      doesFileExist "json-tests/SumType/SumType1.json" `shouldReturn` True+      doesFileExist "json-tests/SumType/SumType2.json" `shouldReturn` True+      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 5 (Proxy :: Proxy T.Person)-      (s2,_) <- hspecSilently $ goldenADTSpecs 5 (Proxy :: Proxy T.SumType)+      (s1,_) <- hspecSilently $ goldenADTSpecs defaultSettings (Proxy :: Proxy T.Person)+      (s2,_) <- hspecSilently $ goldenADTSpecs 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-      (s1,_) <- hspecSilently $ goldenADTSpecs 5 (Proxy :: Proxy TBS.Person)+      (s1,_) <- hspecSilently $ goldenADTSpecs 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-      (s1,_) <- hspecSilently $ goldenADTSpecs 5 (Proxy :: Proxy TNS.Person)+      (s1,_) <- hspecSilently $ goldenADTSpecs 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-      (s1,_) <- hspecSilently $ goldenADTSpecs 5 (Proxy :: Proxy TAS.Person)+      (s1,_) <- hspecSilently $ goldenADTSpecs defaultSettings (Proxy :: Proxy TAS.Person)       summaryFailures s1 `shouldBe` 1--  main :: IO () main = hspec spec