diff --git a/hspec-golden-aeson.cabal b/hspec-golden-aeson.cabal --- a/hspec-golden-aeson.cabal +++ b/hspec-golden-aeson.cabal @@ -1,64 +1,77 @@ -name: hspec-golden-aeson -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 -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 +-- This file has been generated from package.yaml by hpack version 0.17.1. +-- +-- see: https://github.com/sol/hpack - build-depends: base >= 4.7 && < 5 - , aeson - , aeson-pretty - , bytestring - , directory - , filepath - , hspec - , random - , quickcheck-arbitrary-adt >= 0.2.0.0 - , QuickCheck - , transformers - default-language: Haskell2010 - ghc-options: -Wall -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.MismatchedToAndFromSerialization - Test.Types.NewSelector - Test.Utils - build-depends: base - , aeson - , directory - , hspec - , hspec-core - , hspec-golden-aeson - , silently - , quickcheck-arbitrary-adt - , QuickCheck - , transformers - ghc-options: -Wall -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fno-warn-name-shadowing - default-language: Haskell2010 +name: hspec-golden-aeson +version: 0.3.0.0 +synopsis: Use tests to monitor changes in Aeson serialization +description: Use tests to monitor changes in Aeson serialization +category: Testing +homepage: https://github.com/plow-technologies/hspec-golden-aeson#readme +bug-reports: https://github.com/plow-technologies/hspec-golden-aeson/issues +author: James M.C. Haver II +maintainer: mchaver@gmail.com +copyright: 2016 Plow Technologies +license: BSD3 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 source-repository head - type: git + type: git location: https://github.com/plow-technologies/hspec-golden-aeson + +library + hs-source-dirs: + src + ghc-options: -Wall + build-depends: + base >= 4.7 && < 5 + , aeson + , aeson-pretty + , bytestring + , directory + , filepath + , hspec + , random + , quickcheck-arbitrary-adt >= 0.2.0.0 + , QuickCheck + , transformers + 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 + other-modules: + Paths_hspec_golden_aeson + default-language: Haskell2010 + +test-suite test + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: + test + ghc-options: -Wall + build-depends: + base + , aeson + , directory + , hspec + , hspec-core + , hspec-golden-aeson + , silently + , quickcheck-arbitrary-adt + , QuickCheck + , transformers + other-modules: + Test.Aeson.GenericSpecsSpec + Test.Types + Test.Types.AlteredSelector + Test.Types.BrokenSerialization + Test.Types.MismatchedToAndFromSerialization + Test.Types.NewSelector + Test.Utils + default-language: Haskell2010 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 @@ -16,33 +16,37 @@ {-# LANGUAGE ScopedTypeVariables #-} -module Test.Aeson.GenericSpecs ( - -- * Arbitrary testing - goldenSpecs -, roundtripSpecs -, roundtripAndGoldenSpecs +module Test.Aeson.GenericSpecs + ( + -- * Arbitrary testing + goldenSpecs + , roundtripSpecs + , roundtripAndGoldenSpecs -- * ToADTArbitrary testing -, goldenADTSpecs -, roundtripADTSpecs -, roundtripAndGoldenADTSpecs -, roundtripAndGoldenADTSpecsWithSettings + , goldenADTSpecs + , roundtripADTSpecs + , roundtripAndGoldenADTSpecs + , roundtripAndGoldenADTSpecsWithSettings + -- * Make Files + , mkGoldenFileForType + -- * Util -, shouldBeIdentity -, GoldenDirectoryOption(..) -, Settings(..) -, defaultSettings + , shouldBeIdentity + , GoldenDirectoryOption(..) + , Settings(..) + , defaultSettings -- * re-exports -, Proxy(..) -) where + , 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.GoldenSpecs (goldenADTSpecs, mkGoldenFileForType) import Test.Aeson.Internal.ADT.RoundtripSpecs (roundtripADTSpecs) import Test.Aeson.Internal.GoldenSpecs (goldenSpecs) import Test.Aeson.Internal.RoundtripSpecs (roundtripSpecs) 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 @@ -41,6 +41,10 @@ import Test.QuickCheck import Test.QuickCheck.Arbitrary.ADT + +import Data.Monoid ((<>)) + + -- | Tests to ensure that JSON encoding has not unintentionally changed. This -- could be caused by the following: -- @@ -160,3 +164,20 @@ where correctedSampleSize = if sampleSize <= 0 then 1 else sampleSize gen = setSeed rSeed $ replicateM correctedSampleSize (toADTArbitrary (Proxy :: Proxy a)) + +-- | Make a Golden File for the Proxy of a type if the file does not exist. +mkGoldenFileForType :: forall a. (ToJSON a, ToADTArbitrary a) => Int -> Proxy a -> FilePath -> IO () +mkGoldenFileForType sampleSize Proxy goldenPath = do + (typeName, constructors) <- fmap (adtTypeName &&& adtCAPs) <$> generate $ toADTArbitrary (Proxy :: Proxy a) + mapM_ + (\constructor -> do + let goldenFile = goldenPath <> "/" <> typeName <> ".json" + exists <- doesFileExist goldenFile + if exists + then pure () + else do + createDirectoryIfMissing True (takeDirectory goldenFile) + rSeed <- randomIO :: IO Int + rSamples <- mkRandomADTSamplesForConstructor sampleSize (Proxy :: Proxy a) (capConstructor constructor) rSeed + writeFile goldenFile $ encodePretty rSamples + ) constructors 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,4 @@ -{-# LANGUAGE NamedFieldPuns #-} + {-| Module : Test.Aeson.Internal.GoldenSpecs Description : Golden tests for Arbitrary @@ -10,6 +10,7 @@ Internal module, use at your own risk. -} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -36,10 +37,6 @@ import Test.Hspec import Test.QuickCheck - - - - -- | Tests to ensure that JSON encoding has not unintentionally changed. This -- could be caused by the following: -- @@ -62,7 +59,7 @@ goldenSpecsWithNote :: forall a. (Typeable a, Arbitrary a, ToJSON a, FromJSON a) => Settings -> Proxy a -> Maybe String -> Spec goldenSpecsWithNote settings@Settings{..} proxy mNote = do - typeNameInfo <- runIO $ fromTypeable settings proxy + typeNameInfo <- runIO $ mkTypeNameInfo settings proxy goldenSpecsWithNotePlain settings typeNameInfo mNote -- | same as 'goldenSpecsWithNote' but does not require a Typeable, Eq or Show instance. @@ -77,7 +74,7 @@ it ("produces the same JSON as is found in " ++ goldenFile) $ do exists <- doesFileExist goldenFile if exists - then compareWithGolden typeNameInfo proxy goldenFile + then compareWithGolden typeNameInfo proxy goldenFile comparisonFile else createGoldenfile settings proxy goldenFile @@ -85,8 +82,8 @@ -- the golden file and compare the with the JSON in the golden file. compareWithGolden :: forall a . ( Arbitrary a, ToJSON a, FromJSON a) => - TypeNameInfo a -> Proxy a -> FilePath -> IO () -compareWithGolden typeNameInfo proxy goldenFile = do + TypeNameInfo a -> Proxy a -> FilePath -> ComparisonFile ->IO () +compareWithGolden typeNameInfo proxy goldenFile comparisonFile = do goldenSeed <- readSeed =<< readFile goldenFile sampleSize <- readSampleSize =<< readFile goldenFile newSamples <- mkRandomSamples sampleSize proxy goldenSeed @@ -99,12 +96,15 @@ where whenFails :: forall b c . IO c -> IO b -> IO b whenFails = flip onException - faultyFile = mkFaultyFile typeNameInfo + filePath = + case comparisonFile of + FaultyFile -> mkFaultyFile typeNameInfo + OverwriteGoldenFile -> goldenFile writeComparisonFile newSamples = do - writeFile faultyFile (encodePretty newSamples) + writeFile filePath (encodePretty newSamples) putStrLn $ "\n" ++ - "INFO: Written the current encodings into " ++ faultyFile ++ "." + "INFO: Written the current encodings into " ++ filePath ++ "." -- | The golden files do not exist. Create it. createGoldenfile :: forall a . (Arbitrary a, ToJSON a) => @@ -149,50 +149,3 @@ 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/Utils.hs b/src/Test/Aeson/Internal/Utils.hs --- a/src/Test/Aeson/Internal/Utils.hs +++ b/src/Test/Aeson/Internal/Utils.hs @@ -1,13 +1,13 @@ {-| Module : Test.Aeson.Internal.Utils -Description : Utility types, functions and values +Description : Internal types, functions and values Copyright : (c) Plow Technologies, 2016 License : BSD3 Maintainer : mchaver@gmail.com Stability : Beta -} - +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RankNTypes #-} @@ -18,6 +18,7 @@ import Data.Aeson import Data.ByteString.Lazy (ByteString) import Data.Proxy +import Data.Typeable import Prelude @@ -25,20 +26,23 @@ 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. +data ComparisonFile + = FaultyFile + | OverwriteGoldenFile -, 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. -} +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. + , comparisonFile :: ComparisonFile + } -- | 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 +defaultSettings = Settings GoldenDirectory False 5 FaultyFile -- | put brackets around a String. addBrackets :: String -> String @@ -70,10 +74,10 @@ Left msg -> throwIO $ ErrorCall ("aeson couldn't parse value: " ++ msg) +-- | Used to eliminate the need for an Eq instance newtype JsonShow a = JsonShow a - -instance ToJSON a => Show (JsonShow a ) where +instance ToJSON a => Show (JsonShow a) where show (JsonShow v) = show . encode $ v instance ToJSON a => ToJSON (JsonShow a) where @@ -84,3 +88,50 @@ instance Arbitrary a => Arbitrary (JsonShow a) where arbitrary = JsonShow <$> arbitrary + +-------------------------------------------------- +-- Handle creating names +-------------------------------------------------- + +newtype TopDir = + TopDir + { unTopDir :: FilePath + } deriving (Eq,Read,Show) + +newtype ModuleName = + ModuleName + { unModuleName :: FilePath + } deriving (Eq,Read,Show) + +newtype TypeName = + TypeName + { unTypeName :: FilePath + } deriving (Eq,Read,Show) + +data TypeNameInfo a = + TypeNameInfo + { typeNameTopDir :: TopDir + , typeNameModuleName :: Maybe ModuleName + , typeNameTypeName :: TypeName + } deriving (Eq,Read,Show) + +mkTypeNameInfo :: forall a . Arbitrary a => Typeable a => Settings -> Proxy a -> IO (TypeNameInfo a) +mkTypeNameInfo (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