diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hspec-golden-aeson.cabal b/hspec-golden-aeson.cabal new file mode 100644 --- /dev/null +++ b/hspec-golden-aeson.cabal @@ -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 diff --git a/src/Test/Aeson/GenericSpecs.hs b/src/Test/Aeson/GenericSpecs.hs new file mode 100644 --- /dev/null +++ b/src/Test/Aeson/GenericSpecs.hs @@ -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 diff --git a/src/Test/Aeson/Internal/ADT/GoldenSpecs.hs b/src/Test/Aeson/Internal/ADT/GoldenSpecs.hs new file mode 100644 --- /dev/null +++ b/src/Test/Aeson/Internal/ADT/GoldenSpecs.hs @@ -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)) diff --git a/src/Test/Aeson/Internal/ADT/RoundtripSpecs.hs b/src/Test/Aeson/Internal/ADT/RoundtripSpecs.hs new file mode 100644 --- /dev/null +++ b/src/Test/Aeson/Internal/ADT/RoundtripSpecs.hs @@ -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 diff --git a/src/Test/Aeson/Internal/GoldenSpecs.hs b/src/Test/Aeson/Internal/GoldenSpecs.hs new file mode 100644 --- /dev/null +++ b/src/Test/Aeson/Internal/GoldenSpecs.hs @@ -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) diff --git a/src/Test/Aeson/Internal/RandomSamples.hs b/src/Test/Aeson/Internal/RandomSamples.hs new file mode 100644 --- /dev/null +++ b/src/Test/Aeson/Internal/RandomSamples.hs @@ -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 diff --git a/src/Test/Aeson/Internal/RoundtripSpecs.hs b/src/Test/Aeson/Internal/RoundtripSpecs.hs new file mode 100644 --- /dev/null +++ b/src/Test/Aeson/Internal/RoundtripSpecs.hs @@ -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 diff --git a/src/Test/Aeson/Internal/Utils.hs b/src/Test/Aeson/Internal/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Test/Aeson/Internal/Utils.hs @@ -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) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/Test/Aeson/GenericSpecsSpec.hs b/test/Test/Aeson/GenericSpecsSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Aeson/GenericSpecsSpec.hs @@ -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 diff --git a/test/Test/Types.hs b/test/Test/Types.hs new file mode 100644 --- /dev/null +++ b/test/Test/Types.hs @@ -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 diff --git a/test/Test/Types/AlteredSelector.hs b/test/Test/Types/AlteredSelector.hs new file mode 100644 --- /dev/null +++ b/test/Test/Types/AlteredSelector.hs @@ -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 diff --git a/test/Test/Types/BrokenSerialization.hs b/test/Test/Types/BrokenSerialization.hs new file mode 100644 --- /dev/null +++ b/test/Test/Types/BrokenSerialization.hs @@ -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 diff --git a/test/Test/Types/NewSelector.hs b/test/Test/Types/NewSelector.hs new file mode 100644 --- /dev/null +++ b/test/Test/Types/NewSelector.hs @@ -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 diff --git a/test/Test/Utils.hs b/test/Test/Utils.hs new file mode 100644 --- /dev/null +++ b/test/Test/Utils.hs @@ -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