{-# LANGUAGE ScopedTypeVariables #-}
module Test.Utils.Roundtrip
( jsonRoundtripAndGolden
, httpApiDataRoundtrip
) where
import Prelude
import Data.Aeson
( FromJSON (..), ToJSON (..) )
import Data.Char
( isAlphaNum )
import Data.Proxy
( Proxy (..) )
import Data.Typeable
( Typeable, splitTyConApp, tyConName, typeRep )
import Test.Aeson.GenericSpecs
( GoldenDirectoryOption (CustomDirectoryName)
, Settings
, defaultSettings
, goldenDirectoryOption
, sampleSize
, useModuleNameAsSubDirectory
)
import Test.Aeson.Internal.GoldenSpecs
( goldenSpecsWithNotePlain )
import Test.Aeson.Internal.RoundtripSpecs
( roundtripSpecs )
import Test.Aeson.Internal.Utils
( TypeName (..), TypeNameInfo (..), mkTypeNameInfo )
import Test.Hspec
( Spec, it, runIO, shouldBe )
import Test.QuickCheck
( Arbitrary (..), property )
import Web.HttpApiData
( FromHttpApiData (..), ToHttpApiData (..) )
jsonRoundtripAndGolden
:: forall a. (Arbitrary a, ToJSON a, FromJSON a, Typeable a)
=> FilePath
-> Proxy a
-> Spec
jsonRoundtripAndGolden :: FilePath -> Proxy a -> Spec
jsonRoundtripAndGolden FilePath
dir Proxy a
proxy = do
Proxy a -> Spec
forall a.
(Typeable a, Arbitrary a, ToJSON a, FromJSON a) =>
Proxy a -> Spec
roundtripSpecs Proxy a
proxy
TypeNameInfo a
typeNameInfo <- IO (TypeNameInfo a) -> SpecM () (TypeNameInfo a)
forall r a. IO r -> SpecM a r
runIO IO (TypeNameInfo a)
mkCompatibleTypeNameInfo
Settings -> TypeNameInfo a -> Maybe FilePath -> Spec
forall a.
(Arbitrary a, ToJSON a, FromJSON a) =>
Settings -> TypeNameInfo a -> Maybe FilePath -> Spec
goldenSpecsWithNotePlain Settings
settings TypeNameInfo a
typeNameInfo Maybe FilePath
forall a. Maybe a
Nothing
where
mkCompatibleTypeNameInfo :: IO (TypeNameInfo a)
mkCompatibleTypeNameInfo :: IO (TypeNameInfo a)
mkCompatibleTypeNameInfo = do
TypeNameInfo a
typeNameInfo <- Settings -> Proxy a -> IO (TypeNameInfo a)
forall a.
(Arbitrary a, Typeable a) =>
Settings -> Proxy a -> IO (TypeNameInfo a)
mkTypeNameInfo Settings
settings Proxy a
proxy
TypeNameInfo a -> IO (TypeNameInfo a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeNameInfo a -> IO (TypeNameInfo a))
-> TypeNameInfo a -> IO (TypeNameInfo a)
forall a b. (a -> b) -> a -> b
$ TypeNameInfo a
typeNameInfo
{ typeNameTypeName :: TypeName
typeNameTypeName =
TypeName -> TypeName
mkValidForWindows (TypeNameInfo a -> TypeName
forall a. TypeNameInfo a -> TypeName
typeNameTypeName TypeNameInfo a
typeNameInfo)
}
where
mkValidForWindows :: TypeName -> TypeName
mkValidForWindows :: TypeName -> TypeName
mkValidForWindows (TypeName FilePath
typeName) =
FilePath -> TypeName
TypeName ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAlphaNum FilePath
typeName)
settings :: Settings
settings :: Settings
settings = Settings
defaultSettings
{ goldenDirectoryOption :: GoldenDirectoryOption
goldenDirectoryOption =
FilePath -> GoldenDirectoryOption
CustomDirectoryName FilePath
dir
, useModuleNameAsSubDirectory :: Bool
useModuleNameAsSubDirectory =
Bool
False
, sampleSize :: Int
sampleSize = Int
10
}
httpApiDataRoundtrip
:: forall a.
( Arbitrary a
, FromHttpApiData a
, ToHttpApiData a
, Typeable a
, Eq a
, Show a
)
=> Proxy a
-> Spec
httpApiDataRoundtrip :: Proxy a -> Spec
httpApiDataRoundtrip Proxy a
proxy =
FilePath -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
FilePath -> a -> SpecWith (Arg a)
it (FilePath
"URL encoding of " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> TypeRep -> FilePath
cons (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
proxy)) (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ (a -> Expectation) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> Expectation) -> Property) -> (a -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
x :: a) -> do
let bytes :: Text
bytes = a -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece a
x
let x' :: Either Text a
x' = Text -> Either Text a
forall a. FromHttpApiData a => Text -> Either Text a
parseUrlPiece Text
bytes
Either Text a
x' Either Text a -> Either Text a -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a -> Either Text a
forall a b. b -> Either a b
Right a
x
where
cons :: TypeRep -> FilePath
cons TypeRep
rep =
let
(TyCon
c, [TypeRep]
args) = TypeRep -> (TyCon, [TypeRep])
splitTyConApp TypeRep
rep
in
case [TypeRep]
args of
[] ->
TyCon -> FilePath
tyConName TyCon
c
[TypeRep]
xs ->
FilePath
"(" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> TyCon -> FilePath
tyConName TyCon
c FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> FilePath
unwords (TypeRep -> FilePath
cons (TypeRep -> FilePath) -> [TypeRep] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeRep]
xs) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
")"