diff --git a/src/Test/Aeson/Internal/ADT/GoldenSpecs.hs b/src/Test/Aeson/Internal/ADT/GoldenSpecs.hs index 7989e5c..16d04e7 100644 --- a/src/Test/Aeson/Internal/ADT/GoldenSpecs.hs +++ b/src/Test/Aeson/Internal/ADT/GoldenSpecs.hs @@ -63,8 +63,9 @@ goldenADTSpecs settings proxy = goldenADTSpecsWithNote settings proxy Nothing 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) - describe ("JSON encoding of " ++ typeName ++ note) $ + (moduleName,(typeName',constructors)) <- runIO $ fmap (adtModuleName &&& adtTypeName &&& adtCAPs) <$> generate $ toADTArbitrary (Proxy :: Proxy a) + let typeName = typeNameModifier settings typeName' + describe (encodingFormat settings ++ " encoding of " ++ typeName ++ note) $ mapM_ (testConstructor settings moduleName typeName) constructors where note = maybe "" (" " ++) mNote @@ -73,7 +74,7 @@ goldenADTSpecsWithNote settings Proxy mNote = do testConstructor :: forall a. (Eq a, Show a, FromJSON a, ToJSON a, ToADTArbitrary a) => Settings -> String -> String -> ConstructorArbitraryPair a -> SpecWith ( Arg (IO ())) testConstructor Settings{..} moduleName typeName cap = do - it ("produces the same JSON as is found in " ++ goldenFile) $ do + it ("produces the same " ++ encodingFormat ++ " as is found in " ++ goldenFile) $ do exists <- doesFileExist goldenFile if exists then compareWithGolden randomMismatchOption topDir mModuleName typeName cap goldenFile diff --git a/src/Test/Aeson/Internal/GoldenSpecs.hs b/src/Test/Aeson/Internal/GoldenSpecs.hs index 3a0b52c..9dfd77a 100644 --- a/src/Test/Aeson/Internal/GoldenSpecs.hs +++ b/src/Test/Aeson/Internal/GoldenSpecs.hs @@ -70,8 +70,8 @@ goldenSpecsWithNotePlain settings@Settings{..} typeNameInfo@(TypeNameInfo{typeNa let goldenFile = mkGoldenFile typeNameInfo note = maybe "" (" " ++) mNote - describe ("JSON encoding of " ++ addBrackets (unTypeName typeNameTypeName) ++ note) $ - it ("produces the same JSON as is found in " ++ goldenFile) $ do + describe (encodingFormat ++ " encoding of " ++ addBrackets (unTypeName typeNameTypeName) ++ note) $ + it ("produces the same " ++ encodingFormat ++ " as is found in " ++ goldenFile) $ do exists <- doesFileExist goldenFile if exists then compareWithGolden typeNameInfo proxy goldenFile comparisonFile diff --git a/src/Test/Aeson/Internal/Utils.hs b/src/Test/Aeson/Internal/Utils.hs index ec2ca31..ede95dc 100644 --- a/src/Test/Aeson/Internal/Utils.hs +++ b/src/Test/Aeson/Internal/Utils.hs @@ -21,6 +21,7 @@ import Data.Proxy import Data.Typeable import Prelude +import Data.Char import Test.Hspec import Test.QuickCheck @@ -53,6 +54,10 @@ data Settings = Settings -- ^ Whether to create a separate comparison file or ovewrite the golden file. , randomMismatchOption :: RandomMismatchOption -- ^ Whether to output a warning or fail the test when the random seed produces different values than the values in the golden file. + , typeNameModifier :: String -> String + -- ^ How to construct the type name from the string version of a type + , encodingFormat :: String + -- ^ The encoding format that is being tested } -- | A custom directory name or a preselected directory name. @@ -60,7 +65,7 @@ data GoldenDirectoryOption = CustomDirectoryName String | GoldenDirectory -- | The default settings for general use cases. defaultSettings :: Settings -defaultSettings = Settings GoldenDirectory False 5 FaultyFile RandomMismatchWarning +defaultSettings = Settings GoldenDirectory False 5 FaultyFile RandomMismatchWarning id "JSON" -- | put brackets around a String. addBrackets :: String -> String @@ -135,13 +140,14 @@ data TypeNameInfo a = mkTypeNameInfo :: forall a . Arbitrary a => Typeable a => Settings -> Proxy a -> IO (TypeNameInfo a) mkTypeNameInfo (Settings { useModuleNameAsSubDirectory - , goldenDirectoryOption}) proxy = do + , goldenDirectoryOption + , typeNameModifier }) proxy = do maybeModuleName <- maybeModuleNameIO return $ TypeNameInfo (TopDir topDir ) (ModuleName <$> maybeModuleName ) (TypeName typeName) where - typeName = show (typeRep proxy) + typeName = typeNameModifier (show (typeRep proxy)) maybeModuleNameIO = if useModuleNameAsSubDirectory then do