hspec-golden-aeson 0.2.0.3 → 0.2.1.0

raw patch · 7 files changed

+139/−54 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• hspec-golden-aeson.cabal +2/−2
• src/Test/Aeson/GenericSpecs.hs +4/−4
• src/Test/Aeson/Internal/ADT/GoldenSpecs.hs +2/−2
• src/Test/Aeson/Internal/ADT/RoundtripSpecs.hs +1/−1
• src/Test/Aeson/Internal/GoldenSpecs.hs +85/−37
• src/Test/Aeson/Internal/RoundtripSpecs.hs +21/−8
• src/Test/Aeson/Internal/Utils.hs +24/−0

@@ -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

@@ -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

@@ -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)

@@ -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

@@ -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

@@ -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' )++

@@ -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