hspec-golden-aeson (empty) → 0.1.0.0
raw patch · 17 files changed
+767/−0 lines, 17 filesdep +QuickCheckdep +aesondep +aeson-prettysetup-changed
Dependencies added: QuickCheck, aeson, aeson-pretty, base, bytestring, directory, filepath, hspec, hspec-core, hspec-golden-aeson, quickcheck-arbitrary-adt, random, silently, transformers
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- hspec-golden-aeson.cabal +63/−0
- src/Test/Aeson/GenericSpecs.hs +55/−0
- src/Test/Aeson/Internal/ADT/GoldenSpecs.hs +110/−0
- src/Test/Aeson/Internal/ADT/RoundtripSpecs.hs +47/−0
- src/Test/Aeson/Internal/GoldenSpecs.hs +105/−0
- src/Test/Aeson/Internal/RandomSamples.hs +43/−0
- src/Test/Aeson/Internal/RoundtripSpecs.hs +38/−0
- src/Test/Aeson/Internal/Utils.hs +36/−0
- test/Spec.hs +1/−0
- test/Test/Aeson/GenericSpecsSpec.hs +75/−0
- test/Test/Types.hs +30/−0
- test/Test/Types/AlteredSelector.hs +30/−0
- test/Test/Types/BrokenSerialization.hs +36/−0
- test/Test/Types/NewSelector.hs +31/−0
- test/Test/Utils.hs +35/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Plow Technologies (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of James M.C. Haver II, Plow Technologies, nor the names+ of other contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hspec-golden-aeson.cabal view
@@ -0,0 +1,63 @@+name: hspec-golden-aeson+version: 0.1.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+license: BSD3+license-file: LICENSE+author: James M.C. Haver II+maintainer: mchaver@gmail.com+copyright: 2016 Plow Technologies+category: Testing+build-type: Simple+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Test.Aeson.GenericSpecs+ Test.Aeson.Internal.ADT.GoldenSpecs+ Test.Aeson.Internal.ADT.RoundtripSpecs+ Test.Aeson.Internal.GoldenSpecs+ Test.Aeson.Internal.RoundtripSpecs+ Test.Aeson.Internal.RandomSamples+ Test.Aeson.Internal.Utils++ build-depends: base >= 4.7 && < 5+ , aeson+ , aeson-pretty+ , bytestring+ , directory+ , filepath+ , hspec+ , random+ , quickcheck-arbitrary-adt+ , QuickCheck+ , transformers+ default-language: Haskell2010++test-suite test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules: Test.Aeson.GenericSpecsSpec+ Test.Types+ Test.Types.AlteredSelector+ Test.Types.BrokenSerialization+ Test.Types.NewSelector+ Test.Utils+ build-depends: base+ , aeson+ , directory+ , hspec+ , hspec-core+ , hspec-golden-aeson+ , silently+ , quickcheck-arbitrary-adt+ , QuickCheck+ , transformers+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/plow-technologies/hspec-golden-aeson
+ src/Test/Aeson/GenericSpecs.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Aeson.GenericSpecs (+ -- * Arbitrary testing+ goldenSpecs+, roundtripSpecs+, roundtripAndGoldenSpecs++ -- * ToADTArbitrary testing+, goldenADTSpecs+, roundtripADTSpecs+, roundtripAndGoldenADTSpecs++, shouldBeIdentity++ -- * re-exports+, Proxy(..)+) where++import Data.Aeson (FromJSON, ToJSON)+import Data.Proxy+import Data.Typeable++import Test.Aeson.Internal.ADT.GoldenSpecs (goldenADTSpecs)+import Test.Aeson.Internal.ADT.RoundtripSpecs (roundtripADTSpecs)+import Test.Aeson.Internal.GoldenSpecs (goldenSpecs)+import Test.Aeson.Internal.RoundtripSpecs (roundtripSpecs)+import Test.Aeson.Internal.Utils+import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Arbitrary.ADT++-- | run roundtrip and golden test for a type.+-- sampleSize is used only when creating the golden file. When it is+-- 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+ roundtripSpecs proxy+ goldenSpecs sampleSize 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+ roundtripADTSpecs proxy+ goldenADTSpecs sampleSize proxy
+ src/Test/Aeson/Internal/ADT/GoldenSpecs.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++module Test.Aeson.Internal.ADT.GoldenSpecs where++import Control.Arrow+import Control.Exception+import Control.Monad++import Data.Aeson (ToJSON, FromJSON)+import qualified Data.Aeson as A+import Data.Aeson.Encode.Pretty+import Data.ByteString.Lazy (writeFile, readFile)+import Data.Proxy++import Prelude hiding (writeFile,readFile)++import System.Directory+import System.FilePath+import System.Random++import Test.Aeson.Internal.RandomSamples+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+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++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)+ describe ("JSON encoding of " ++ typeName ++ note) $+ mapM_ (testConstructor sampleSize typeName) constructors+ where+ note = maybe "" (" " ++) mNote++testConstructor :: forall a. (Eq a, Show a, FromJSON a, ToJSON a, ToADTArbitrary a) =>+ Int -> String -> ConstructorArbitraryPair a -> SpecWith ( Arg (IO ()))+testConstructor sampleSize typeName cap =+ it ("produces the same JSON as is found in " ++ goldenFile) $ do+ exists <- doesFileExist goldenFile+ if exists+ then compareWithGolden typeName cap goldenFile+ else createGoldenFile sampleSize cap goldenFile+ where+ goldenFile = mkGoldenFilePath typeName cap++compareWithGolden :: forall a. (Show a, Eq a, FromJSON a, ToJSON a, ToADTArbitrary a) =>+ String -> ConstructorArbitraryPair a -> FilePath -> IO ()+compareWithGolden 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+ goldenSamples :: RandomSamples a <-+ either (throwIO . ErrorCall) return =<<+ A.eitherDecode' <$>+ readFile goldenFile+ newSamples `shouldBe` goldenSamples+ where+ whenFails :: forall b c. IO c -> IO b -> IO b+ whenFails = flip onException+ faultyFile = mkFaultyFilePath typeName cap+ writeComparisonFile newSamples = do+ writeFile faultyFile (encodePretty newSamples)+ putStrLn $+ "\n" +++ "INFO: Written the current encodings into " ++ faultyFile ++ "."++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+ 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."++mkGoldenFilePath :: forall a. String -> ConstructorArbitraryPair a -> FilePath+mkGoldenFilePath typeName cap = "golden" </> typeName </> _capConstructor cap <.> "json"++mkFaultyFilePath :: forall a. String -> ConstructorArbitraryPair a -> FilePath+mkFaultyFilePath typeName cap = "golden" </> typeName </> _capConstructor cap <.> "faulty" <.> "json"++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+ return $ RandomSamples rSeed arbs+ where+ correctedSampleSize = if sampleSize <= 0 then 1 else sampleSize+ gen = setSeed rSeed $ replicateM sampleSize (toADTArbitrary (Proxy :: Proxy a))
+ src/Test/Aeson/Internal/ADT/RoundtripSpecs.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE ScopedTypeVariables #-}++-- | Internal module, use at your own risk.+module Test.Aeson.Internal.ADT.RoundtripSpecs where++import Control.Arrow++import qualified Data.Aeson as Aeson+import Data.Aeson as Aeson hiding (encode)+import Data.Typeable++import Test.Aeson.Internal.Utils+import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Arbitrary.ADT++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.+--+-- 'roundtripSpecs' will+--+-- - create random values using 'Arbitrary',+-- - 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+-- using 'Eq'.+roundtripADTSpecs :: forall a.+ (ToADTArbitrary a, Eq a, Show a, Arbitrary a, ToJSON a, FromJSON a)+ => Proxy a+ -> Spec+roundtripADTSpecs proxy = genericAesonRoundtripADTWithNote proxy Nothing++genericAesonRoundtripADTWithNote :: forall a.+ (ToADTArbitrary a, Eq a, Show a, Arbitrary a, ToJSON a, FromJSON a)+ => Proxy a+ -> Maybe String+ -> Spec+genericAesonRoundtripADTWithNote _ mNote = do+ adt <- runIO $ generate (toADTArbitrary (Proxy :: Proxy a))+ 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+ where+ note = maybe "" (" " ++) mNote
+ src/Test/Aeson/Internal/GoldenSpecs.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Aeson.Internal.GoldenSpecs where++import Control.Exception+import Control.Monad++import Data.Aeson+import Data.Aeson.Encode.Pretty+import Data.ByteString.Lazy hiding (putStrLn)+import Data.Proxy+import Data.Typeable++import Prelude hiding (readFile, writeFile)++import System.Directory+import System.FilePath+import System.Random++import Test.Aeson.Internal.RandomSamples+import Test.Aeson.Internal.Utils+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+--+-- - 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.+--+-- You can consider putting the golden files under revision control. That way+-- it'll be obvious when JSON encodings change.+goldenSpecs :: (Eq a, Show a, Typeable a, Arbitrary a, ToJSON a, FromJSON a) =>+ Int -> Proxy a -> Spec+goldenSpecs sampleSize proxy = goldenSpecsWithNote sampleSize 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+ 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."++compareWithGolden :: forall a .+ (Eq a, Show a, Typeable a, Arbitrary a, ToJSON a, FromJSON a) =>+ Proxy a -> FilePath -> IO ()+compareWithGolden proxy goldenFile = do+ goldenSeed <- readSeed =<< readFile goldenFile+ sampleSize <- readSampleSize =<< readFile goldenFile+ newSamples <- mkRandomSamples sampleSize proxy goldenSeed+ whenFails (writeComparisonFile newSamples) $ do+ goldenSamples :: RandomSamples a <-+ either (throwIO . ErrorCall) return =<<+ eitherDecode' <$>+ readFile goldenFile+ newSamples `shouldBe` goldenSamples+ where+ whenFails :: forall b c . IO c -> IO b -> IO b+ whenFails = flip onException++ writeComparisonFile newSamples = do+ writeFile (mkFaultyFile proxy) (encodePretty newSamples)+ putStrLn $+ "\n" +++ "INFO: Written the current encodings into " ++ mkFaultyFile proxy ++ "."++mkRandomSamples :: forall a . Arbitrary a =>+ Int -> Proxy a -> Int -> IO (RandomSamples a)+mkRandomSamples sampleSize Proxy rSeed = RandomSamples rSeed <$> generate gen+ where+ correctedSampleSize = if sampleSize <= 0 then 1 else sampleSize+ gen :: Gen [a]+ gen = setSeed rSeed $ replicateM correctedSampleSize (arbitrary :: Gen a)
+ src/Test/Aeson/Internal/RandomSamples.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Aeson.Internal.RandomSamples where++import Control.Exception++import Data.Aeson+import Data.ByteString.Lazy (ByteString)++import GHC.Generics++import Test.QuickCheck+import Test.QuickCheck.Gen+import Test.QuickCheck.Random+++-- | 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++data RandomSamples a = RandomSamples {+ seed :: Int+, samples :: [a]+} deriving (Eq, Ord, Show, Generic)++instance FromJSON a => FromJSON (RandomSamples a)+instance ToJSON a => ToJSON (RandomSamples a)++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+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+readSampleSize :: ByteString -> IO Int+readSampleSize s = case eitherDecode s :: Either String (RandomSamples Value) of+ Right rSamples -> return . length . samples $ rSamples+ Left err -> throwIO $ ErrorCall err
+ src/Test/Aeson/Internal/RoundtripSpecs.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE ScopedTypeVariables #-}++-- | Internal module, use at your own risk.+module Test.Aeson.Internal.RoundtripSpecs where++import Control.Arrow+import qualified Data.Aeson as Aeson+import Data.Aeson as Aeson hiding (encode)+import Data.Typeable++import Test.Aeson.Internal.Utils+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.+--+-- 'roundtripSpecs' will+--+-- - create random values (using 'Arbitrary'),+-- - 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+-- (using 'Eq').+roundtripSpecs :: forall a .+ (Typeable a, Eq a, Show a, Arbitrary a, ToJSON a, FromJSON a) =>+ Proxy a -> Spec+roundtripSpecs proxy = genericAesonRoundtripWithNote proxy Nothing++-- | use this directly if you want to add your own notes.+genericAesonRoundtripWithNote :: forall a .+ (Typeable a, Eq a, Show a, Arbitrary a, ToJSON a, FromJSON a) =>+ Proxy a -> Maybe String -> Spec+genericAesonRoundtripWithNote proxy mNote = do+ let note = maybe "" (" " ++) mNote+ describe ("JSON encoding of " ++ addBrackets (show (typeRep proxy)) ++ note) $+ it "allows to encode values with aeson and read them back" $ shouldBeIdentity proxy $+ Aeson.encode >>> aesonDecodeIO
+ src/Test/Aeson/Internal/Utils.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Aeson.Internal.Utils where++import Control.Exception++import Data.Aeson+import Data.ByteString.Lazy (ByteString)+import Data.Proxy++import Prelude++import Test.Hspec+import Test.QuickCheck++-- | put brackets around a String.+addBrackets :: String -> String+addBrackets s =+ if ' ' `elem` s+ then "(" ++ s ++ ")"+ else s++-- | [hspec](http://hspec.github.io/) style combinator to easily write tests+-- that check the a given operation returns the same value it was given, e.g.+-- roundtrip tests.+shouldBeIdentity :: (Eq a, Show a, Arbitrary a) =>+ Proxy a -> (a -> IO a) -> Property+shouldBeIdentity Proxy function =+ property $ \ (a :: a) -> function a `shouldReturn` a++-- | run decode in IO, if it returns Left then throw an error.+aesonDecodeIO :: FromJSON a => ByteString -> IO a+aesonDecodeIO bs = case eitherDecode bs of+ Right a -> return a+ Left msg -> throwIO $ ErrorCall+ ("aeson couldn't parse value: " ++ msg)
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/Test/Aeson/GenericSpecsSpec.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Aeson.GenericSpecsSpec where++import Control.Monad.IO.Class++import Data.Aeson+import Data.Proxy++import GHC.Generics++import System.Directory++import Test.Aeson.GenericSpecs+import Test.Hspec+import Test.Hspec.Core.Runner+import Test.QuickCheck+import Test.QuickCheck.Arbitrary.ADT++import Test.Utils++-- various iterations of a Product and Sum Type and their serializations+import qualified Test.Types as T+import qualified Test.Types.AlteredSelector as TAS+import qualified Test.Types.BrokenSerialization as TBS+import qualified Test.Types.NewSelector as TNS+++-- summaryFailures+spec :: Spec+spec = do+ describe "Test.Aeson.GenericSpecs: roundTrip" $+ it "" $ do+ (s1,_) <- hspecSilently $ roundtripADTSpecs (Proxy :: Proxy T.Person)+ summaryFailures s1 `shouldBe` 0++ describe "Test.Aeson.GenericSpecs: goldenADTSpecs" $ do+ it "create golden test files" $ do+ -- clean up previously existing golden folder+ bg <- doesDirectoryExist "golden"+ if bg+ then removeDirectoryRecursive "golden"+ else return ()++ -- 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)++ 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 "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)+ (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)+ 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)+ 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)+ summaryFailures s1 `shouldBe` 1++++main :: IO ()+main = hspec spec
+ test/Test/Types.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE DeriveGeneric #-}++module Test.Types where++import Data.Aeson+import GHC.Generics+import Test.QuickCheck+import Test.QuickCheck.Arbitrary.ADT++data Person = Person {+ name :: String+, age :: Int+} deriving (Eq,Show,Generic)++instance ToJSON Person+instance FromJSON Person+instance ToADTArbitrary Person+instance Arbitrary Person where+ arbitrary = genericArbitrary++data SumType = SumType1 Int+ | SumType2 String Int+ | SumType3 Double String Int+ deriving (Eq,Show,Generic)++instance ToJSON SumType+instance FromJSON SumType+instance ToADTArbitrary SumType+instance Arbitrary SumType where+ arbitrary = genericArbitrary
+ test/Test/Types/AlteredSelector.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE DeriveGeneric #-}++module Test.Types.AlteredSelector where++import Data.Aeson+import GHC.Generics+import Test.QuickCheck+import Test.QuickCheck.Arbitrary.ADT++data Person = Person {+ name :: String+, height :: Int+} deriving (Eq,Show,Generic)++instance ToJSON Person+instance FromJSON Person+instance ToADTArbitrary Person+instance Arbitrary Person where+ arbitrary = genericArbitrary++data SumType = SumType1 Int+ | SumType2 String Int+ | SumType3 Double String Int+ deriving (Eq,Show,Generic)++instance ToJSON SumType+instance FromJSON SumType+instance ToADTArbitrary SumType+instance Arbitrary SumType where+ arbitrary = genericArbitrary
+ test/Test/Types/BrokenSerialization.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+module Test.Types.BrokenSerialization where++import Data.Aeson+import GHC.Generics+import Test.QuickCheck+import Test.QuickCheck.Arbitrary.ADT++data Person = Person {+ name :: String+, age :: Int+} deriving (Eq,Show,Generic)++instance ToJSON Person where+ toJSON (Person name age) = object [+ "personName" .= name+ , "personAge" .= age+ ]+instance FromJSON Person where+ parseJSON (Object o) = Person <$> o .: "personName" <*> o .: "personAge"++instance ToADTArbitrary Person+instance Arbitrary Person where+ arbitrary = genericArbitrary++data SumType = SumType1 Int+ | SumType2 String Int+ | SumType3 Double String Int+ deriving (Eq,Show,Generic)++instance ToJSON SumType+instance FromJSON SumType+instance ToADTArbitrary SumType+instance Arbitrary SumType where+ arbitrary = genericArbitrary
+ test/Test/Types/NewSelector.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE DeriveGeneric #-}++module Test.Types.NewSelector where++import Data.Aeson+import GHC.Generics+import Test.QuickCheck+import Test.QuickCheck.Arbitrary.ADT++data Person = Person {+ name :: String+, age :: Int+, address :: String+} deriving (Eq,Show,Generic)++instance ToJSON Person+instance FromJSON Person+instance ToADTArbitrary Person+instance Arbitrary Person where+ arbitrary = genericArbitrary++data SumType = SumType1 Int+ | SumType2 String Int+ | SumType3 Double String Int+ deriving (Eq,Show,Generic)++instance ToJSON SumType+instance FromJSON SumType+instance ToADTArbitrary SumType+instance Arbitrary SumType where+ arbitrary = genericArbitrary
+ test/Test/Utils.hs view
@@ -0,0 +1,35 @@+module Test.Utils where++import Control.Monad+import Data.Tuple+import System.IO.Silently+import Test.Hspec+import Test.Hspec.Core.Runner++hspecSilently :: Spec -> IO (Summary, String)+hspecSilently s = swap <$> capture (hspecResult s)++shouldTestAs :: Spec -> Summary -> IO ()+shouldTestAs spec expected = do+ (summary, output) <- hspecSilently spec+ when (summary /= expected) $+ expectationFailure $+ "spec didn't yield the expected summary:\n" +++ " expected: " ++ show expected ++ "\n" +++ " got: " ++ show summary ++ "\n" +++ "output of the test-suite:\n" +++ indent output++shouldProduceFailures :: Spec -> Int -> IO ()+shouldProduceFailures spec expected = do+ (summary, output) <- hspecSilently spec+ when (summaryFailures summary /= expected) $+ expectationFailure $+ "spec didn't yield the expected number of failures summary:\n" +++ " expected: " ++ show expected ++ "\n" +++ " got: " ++ show (summaryFailures summary) ++ "\n" +++ "output of the test-suite:\n" +++ indent output++indent :: String -> String+indent = unlines . map (" " ++ ) . lines