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.2.0.3 +version: 0.2.1.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 @@ -34,7 +34,7 @@ , QuickCheck , transformers default-language: Haskell2010 - + ghc-options: -Wall test-suite test type: exitcode-stdio-1.0 hs-source-dirs: test 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 @@ -55,14 +55,14 @@ -- 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) + (Arbitrary a, ToJSON a, FromJSON a, Typeable a) => 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) + (Arbitrary a, ToJSON a, FromJSON a, Typeable a) => Settings -> Proxy a -> Spec roundtripAndGoldenSpecsWithSettings settings proxy = do roundtripSpecs proxy @@ -72,14 +72,14 @@ -- 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) + (ToADTArbitrary a, Eq a, Show a, ToJSON a, FromJSON a) => 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) + (ToADTArbitrary a, Eq a, Show a, ToJSON a, FromJSON a) => Settings -> Proxy a -> Spec roundtripAndGoldenADTSpecsWithSettings settings proxy = do roundtripADTSpecs 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 @@ -54,13 +54,13 @@ -- 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) => +goldenADTSpecs :: forall a. (ToADTArbitrary a, Eq a, Show a, ToJSON a, FromJSON a) => 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) => +goldenADTSpecsWithNote :: forall a. (ToADTArbitrary a, Eq a, Show a, ToJSON a, FromJSON 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) 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 @@ -37,7 +37,7 @@ -- - 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) + (ToADTArbitrary a, Eq a, Show a, ToJSON a, FromJSON a) => Proxy a -> Spec roundtripADTSpecs proxy = genericAesonRoundtripADTWithNote proxy Nothing 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,3 +1,4 @@ +{-# LANGUAGE NamedFieldPuns #-} {-| Module : Test.Aeson.Internal.GoldenSpecs Description : Golden tests for Arbitrary @@ -12,7 +13,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} - +{-# LANGUAGE RankNTypes #-} module Test.Aeson.Internal.GoldenSpecs where import Control.Exception @@ -35,6 +36,10 @@ import Test.Hspec import Test.QuickCheck + + + + -- | Tests to ensure that JSON encoding has not unintentionally changed. This -- could be caused by the following: -- @@ -48,57 +53,53 @@ -- 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) => +goldenSpecs :: (Typeable a, Arbitrary a, ToJSON a, FromJSON a) => Settings -> Proxy a -> Spec goldenSpecs settings proxy = goldenSpecsWithNote settings proxy Nothing -- | 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) => +goldenSpecsWithNote :: forall 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 do - arbA <- runIO $ generate (arbitrary :: Gen a) - return $ Just $ tyConModule . typeRepTyCon . typeOf $ arbA - else return Nothing + typeNameInfo <- runIO $ fromTypeable settings proxy + goldenSpecsWithNotePlain settings typeNameInfo mNote - let goldenFile = mkGoldenFile topDir mModuleName proxy +-- | same as 'goldenSpecsWithNote' but does not require a Typeable, Eq or Show instance. +goldenSpecsWithNotePlain :: forall a. (Arbitrary a, ToJSON a, FromJSON a) => + Settings -> TypeNameInfo a -> Maybe String -> Spec +goldenSpecsWithNotePlain settings@Settings{..} typeNameInfo@(TypeNameInfo{typeNameTypeName}) mNote = do + let proxy = Proxy :: Proxy a + let goldenFile = mkGoldenFile typeNameInfo note = maybe "" (" " ++) mNote - describe ("JSON encoding of " ++ addBrackets (show (typeRep proxy)) ++ note) $ + describe ("JSON encoding of " ++ addBrackets (unTypeName typeNameTypeName) ++ note) $ it ("produces the same JSON as is found in " ++ goldenFile) $ do exists <- doesFileExist goldenFile if exists - then compareWithGolden topDir mModuleName proxy goldenFile + then compareWithGolden typeNameInfo 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) => - FilePath -> Maybe FilePath -> Proxy a -> FilePath -> IO () -compareWithGolden topDir mModuleName proxy goldenFile = do + ( Arbitrary a, ToJSON a, FromJSON a) => + TypeNameInfo a -> Proxy a -> FilePath -> IO () +compareWithGolden typeNameInfo 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 + either (throwIO . ErrorCall) return =<< + eitherDecode' <$> + readFile goldenFile + encode newSamples `shouldBe` encode goldenSamples where whenFails :: forall b c . IO c -> IO b -> IO b whenFails = flip onException - - faultyFile = mkFaultyFile topDir mModuleName proxy - + faultyFile = mkFaultyFile typeNameInfo writeComparisonFile newSamples = do writeFile faultyFile (encodePretty newSamples) putStrLn $ @@ -106,7 +107,7 @@ "INFO: Written the current encodings into " ++ faultyFile ++ "." -- | The golden files do not exist. Create it. -createGoldenfile :: forall a . (Show a, Arbitrary a, ToJSON a) => +createGoldenfile :: forall a . (Arbitrary a, ToJSON a) => Settings -> Proxy a -> FilePath -> IO () createGoldenfile Settings{..} proxy goldenFile = do createDirectoryIfMissing True (takeDirectory goldenFile) @@ -124,20 +125,20 @@ -- | 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" +mkGoldenFile :: TypeNameInfo a -> FilePath +mkGoldenFile (TypeNameInfo{typeNameTopDir,typeNameModuleName,typeNameTypeName}) = + case typeNameModuleName of + Nothing -> unTopDir typeNameTopDir unTypeName typeNameTypeName <.> "json" + Just moduleName -> unTopDir typeNameTopDir unModuleName moduleName unTypeName typeNameTypeName <.> "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" +mkFaultyFile :: TypeNameInfo a -> FilePath +mkFaultyFile (TypeNameInfo {typeNameTypeName,typeNameModuleName, typeNameTopDir}) = + case unModuleName <$> typeNameModuleName of + Nothing -> unTopDir typeNameTopDir unTypeName typeNameTypeName <.> "faulty" <.> "json" + Just moduleName -> unTopDir typeNameTopDir moduleName unTypeName typeNameTypeName <.> "faulty" <.> "json" -- | Create a number of arbitrary instances of a type -- a sample size and a random seed. @@ -148,3 +149,50 @@ correctedSampleSize = if sampleSize <= 0 then 1 else sampleSize gen :: Gen [a] gen = setSeed rSeed $ replicateM correctedSampleSize (arbitrary :: Gen a) + + + + + + +-------------------------------------------------- +-- Handle creating names +-------------------------------------------------- + +newtype TopDir = TopDir {unTopDir :: FilePath} +newtype ModuleName = ModuleName {unModuleName :: FilePath} +newtype TypeName = TypeName {unTypeName :: FilePath} + + +data TypeNameInfo a = TypeNameInfo { + typeNameTopDir :: TopDir, + typeNameModuleName :: Maybe ModuleName, + typeNameTypeName :: TypeName + } + + +{- +- Nothing -> topDir show (typeRep proxy) <.> "json" +- Just moduleName -> topDir moduleName show (typeRep proxy) <.> "json" + +-} + + +fromTypeable :: forall a . Arbitrary a => Typeable a => Settings -> Proxy a -> IO (TypeNameInfo a) +fromTypeable (Settings {useModuleNameAsSubDirectory + ,goldenDirectoryOption}) proxy = do + maybeModuleName <- maybeModuleNameIO + return $ TypeNameInfo (TopDir topDir ) + (ModuleName <$> maybeModuleName ) + (TypeName typeName) + where + typeName = show (typeRep proxy) + maybeModuleNameIO = if useModuleNameAsSubDirectory + then do + arbA <- generate (arbitrary :: Gen a) + return $ Just $ tyConModule . typeRepTyCon . typeOf $ arbA + else return Nothing + + topDir = case goldenDirectoryOption of + GoldenDirectory -> "golden" + CustomDirectoryName d -> d 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 @@ -13,15 +13,14 @@ 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 - +import Test.Hspec.QuickCheck -- | A roundtrip test to check whether values of the given type -- can be successfully converted to JSON and back to a Haskell value. -- @@ -33,17 +32,31 @@ -- - 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) => + (Typeable a, Arbitrary a, ToJSON a, FromJSON a) => Proxy a -> Spec roundtripSpecs proxy = genericAesonRoundtripWithNote proxy Nothing -- | 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) => + (Typeable a, Arbitrary a, ToJSON a, FromJSON a) => Proxy a -> Maybe String -> Spec genericAesonRoundtripWithNote proxy mNote = do + let typeIdentifier = show (typeRep proxy) + result <- genericAesonRoundtripWithNotePlain proxy mNote typeIdentifier + return result + +-- | Same as 'genericAesonRoundtripWithNote', but no need for Typeable, Eq, or Show +genericAesonRoundtripWithNotePlain :: forall a . + (Arbitrary a, ToJSON a, FromJSON a) => + Proxy a -> Maybe String -> String -> Spec +genericAesonRoundtripWithNotePlain _ mNote typeIdentifier = 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 + checkAesonEncodingEquality' :: JsonShow a -> Bool + checkAesonEncodingEquality' = checkAesonEncodingEquality + + describe ("JSON encoding of " ++ addBrackets (typeIdentifier) ++ note) $ + prop "allows to encode values with aeson and read them back" + (checkAesonEncodingEquality' ) + + 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 @@ -9,6 +9,7 @@ {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} module Test.Aeson.Internal.Utils where @@ -54,9 +55,32 @@ shouldBeIdentity Proxy function = property $ \ (a :: a) -> function a `shouldReturn` a +-- | This function will compare one JSON encoding to a subsequent JSON encoding, thus eliminating the need for an Eq instance +checkAesonEncodingEquality :: forall a . (ToJSON a, FromJSON a) => JsonShow a -> Bool +checkAesonEncodingEquality (JsonShow a) = + let byteStrA = encode a + decodedVal = (eitherDecode byteStrA) :: Either String a + eitherByteStrB = encode <$> decodedVal + in (Right byteStrA) == eitherByteStrB + -- | 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) + +newtype JsonShow a = JsonShow a + + +instance ToJSON a => Show (JsonShow a ) where + show (JsonShow v) = show . encode $ v + +instance ToJSON a => ToJSON (JsonShow a) where + toJSON (JsonShow a) = toJSON a + +instance FromJSON a => FromJSON (JsonShow a) where + parseJSON v = JsonShow <$> (parseJSON v) + +instance Arbitrary a => Arbitrary (JsonShow a) where + arbitrary = JsonShow <$> arbitrary