summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormchaver <>2017-11-14 11:07:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-11-14 11:07:00 (GMT)
commit50795aae550dffacecac6803f0b14c86b0fabc4e (patch)
tree7821c7a0e84939eabadada6ec95e889b7f042587
parent0d3d07c496915e94a2684bf7e3570245514e4166 (diff)
version 0.3.0.0HEAD0.3.0.0master
-rw-r--r--hspec-golden-aeson.cabal133
-rw-r--r--src/Test/Aeson/GenericSpecs.hs36
-rw-r--r--src/Test/Aeson/Internal/ADT/GoldenSpecs.hs21
-rw-r--r--src/Test/Aeson/Internal/GoldenSpecs.hs71
-rw-r--r--src/Test/Aeson/Internal/Utils.hs75
5 files changed, 189 insertions, 147 deletions
diff --git a/hspec-golden-aeson.cabal b/hspec-golden-aeson.cabal
index 8d3977f..b33e329 100644
--- 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
+-- This file has been generated from package.yaml by hpack version 0.17.1.
+--
+-- see: https://github.com/sol/hpack
-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 >= 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
index fc6202f..349ccd3 100644
--- a/src/Test/Aeson/GenericSpecs.hs
+++ b/src/Test/Aeson/GenericSpecs.hs
@@ -16,33 +16,37 @@ This package provides tools for testing Aeson serialization.
{-# 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
index 6dc8cd2..ec35986 100644
--- a/src/Test/Aeson/Internal/ADT/GoldenSpecs.hs
+++ b/src/Test/Aeson/Internal/ADT/GoldenSpecs.hs
@@ -41,6 +41,10 @@ import Test.Hspec
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 @@ mkRandomADTSamplesForConstructor sampleSize Proxy conName rSeed = do
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
index 9b90de6..347ebc5 100644
--- 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 @@ Stability : Beta
Internal module, use at your own risk.
-}
+{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
@@ -36,10 +37,6 @@ import Test.Aeson.Internal.Utils
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 @@ goldenSpecs settings proxy = goldenSpecsWithNote settings proxy Nothing
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 @@ goldenSpecsWithNotePlain settings@Settings{..} typeNameInfo@(TypeNameInfo{typeNa
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 @@ goldenSpecsWithNotePlain settings@Settings{..} typeNameInfo@(TypeNameInfo{typeNa
-- 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 @@ compareWithGolden typeNameInfo proxy goldenFile = do
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 @@ mkRandomSamples sampleSize Proxy rSeed = RandomSamples rSeed <$> generate gen
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
index 05916e2..d88281c 100644
--- 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 Control.Exception
import Data.Aeson
import Data.ByteString.Lazy (ByteString)
import Data.Proxy
+import Data.Typeable
import Prelude
@@ -25,20 +26,23 @@ 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.
+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 @@ aesonDecodeIO bs = case eitherDecode bs of
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
@@ -83,4 +87,51 @@ instance FromJSON a => FromJSON (JsonShow a) where
parseJSON v = JsonShow <$> (parseJSON v)
instance Arbitrary a => Arbitrary (JsonShow a) where
- arbitrary = JsonShow <$> arbitrary \ No newline at end of file
+ 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