diff --git a/hspec-golden-aeson.cabal b/hspec-golden-aeson.cabal --- a/hspec-golden-aeson.cabal +++ b/hspec-golden-aeson.cabal @@ -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 diff --git a/src/Test/Aeson/GenericSpecs.hs b/src/Test/Aeson/GenericSpecs.hs --- a/src/Test/Aeson/GenericSpecs.hs +++ b/src/Test/Aeson/GenericSpecs.hs @@ -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 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 @@ -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)) diff --git a/src/Test/Aeson/Internal/ADT/RoundtripSpecs.hs b/src/Test/Aeson/Internal/ADT/RoundtripSpecs.hs --- a/src/Test/Aeson/Internal/ADT/RoundtripSpecs.hs +++ b/src/Test/Aeson/Internal/ADT/RoundtripSpecs.hs @@ -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 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 @@ -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 diff --git a/src/Test/Aeson/Internal/RandomSamples.hs b/src/Test/Aeson/Internal/RandomSamples.hs --- a/src/Test/Aeson/Internal/RandomSamples.hs +++ b/src/Test/Aeson/Internal/RandomSamples.hs @@ -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 diff --git a/src/Test/Aeson/Internal/RoundtripSpecs.hs b/src/Test/Aeson/Internal/RoundtripSpecs.hs --- a/src/Test/Aeson/Internal/RoundtripSpecs.hs +++ b/src/Test/Aeson/Internal/RoundtripSpecs.hs @@ -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 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 @@ -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 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 @@ -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