{-# LANGUAGE ScopedTypeVariables #-}
module Hedgehog.Classes.Json (jsonLaws) where
import Hedgehog
import Hedgehog.Classes.Common
import Data.Aeson (FromJSON, ToJSON(toJSON))
import qualified Data.Aeson as Aeson
jsonLaws :: (FromJSON a, ToJSON a, Eq a, Show a) => Gen a -> Laws
jsonLaws :: Gen a -> Laws
jsonLaws Gen a
gen = String -> [(String, Property)] -> Laws
Laws String
"ToJSON/FromJSON"
[ (String
"Partial Isomorphism", Gen a -> Property
forall a. (ToJSON a, FromJSON a, Show a, Eq a) => Gen a -> Property
jsonEncodingPartialIsomorphism Gen a
gen)
, (String
"Encoding equals value", Gen a -> Property
forall a. (ToJSON a, Show a) => Gen a -> Property
jsonEncodingEqualsValue Gen a
gen)
]
jsonEncodingPartialIsomorphism :: forall a. (ToJSON a, FromJSON a, Show a, Eq a) => Gen a -> Property
jsonEncodingPartialIsomorphism :: Gen a -> Property
jsonEncodingPartialIsomorphism Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
a
x <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
let encoded :: ByteString
encoded = a -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode a
x
let lhs :: Maybe a
lhs = ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode ByteString
encoded
let rhs :: Maybe a
rhs = a -> Maybe a
forall a. a -> Maybe a
Just a
x
let ctx :: Context
ctx = LawContext -> Context
contextualise (LawContext -> Context) -> LawContext -> Context
forall a b. (a -> b) -> a -> b
$ LawContext :: String -> String -> String -> String -> String -> LawContext
LawContext
{ lawContextLawName :: String
lawContextLawName = String
"Partial Isomorphism", lawContextTcName :: String
lawContextTcName = String
"ToJSON/FromJSON"
, lawContextLawBody :: String
lawContextLawBody = String
"decode . encode" String -> String -> String
`congruency` String
"Just"
, lawContextTcProp :: String
lawContextTcProp =
let showX :: String
showX = a -> String
forall a. Show a => a -> String
show a
x
showEncoded :: String
showEncoded = ByteString -> String
forall a. Show a => a -> String
show ByteString
encoded
in [String] -> String
lawWhere
[ String
"decode . encode $ x" String -> String -> String
`congruency` String
"Just x, where"
, String
"x = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
showX
, String
"encode x = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
showEncoded
]
, lawContextReduced :: String
lawContextReduced = Maybe a -> Maybe a -> String
forall a. Show a => a -> a -> String
reduced Maybe a
lhs Maybe a
rhs
}
Maybe a -> Maybe a -> Context -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx Maybe a
lhs Maybe a
rhs Context
ctx
jsonEncodingEqualsValue :: forall a. (ToJSON a, Show a) => Gen a -> Property
jsonEncodingEqualsValue :: Gen a -> Property
jsonEncodingEqualsValue Gen a
gen = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
a
x <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
let encoded :: ByteString
encoded = a -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode a
x
let decoded :: Maybe Value
decoded = ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode ByteString
encoded :: Maybe Aeson.Value
let lhs :: Maybe Value
lhs = Maybe Value
decoded
let rhs :: Maybe Value
rhs = Value -> Maybe Value
forall a. a -> Maybe a
Just (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
x)
let ctx :: Context
ctx = LawContext -> Context
contextualise (LawContext -> Context) -> LawContext -> Context
forall a b. (a -> b) -> a -> b
$ LawContext :: String -> String -> String -> String -> String -> LawContext
LawContext
{ lawContextLawName :: String
lawContextLawName = String
"Encoding equals value", lawContextTcName :: String
lawContextTcName = String
"ToJSON"
, lawContextLawBody :: String
lawContextLawBody = String
"decode . encode" String -> String -> String
`congruency` String
"Just . toJSON"
, lawContextTcProp :: String
lawContextTcProp =
let showX :: String
showX = a -> String
forall a. Show a => a -> String
show a
x
showEncoded :: String
showEncoded = ByteString -> String
forall a. Show a => a -> String
show ByteString
encoded
showDecoded :: String
showDecoded = Maybe Value -> String
forall a. Show a => a -> String
show Maybe Value
decoded
in [String] -> String
lawWhere
[ String
"decode . encode $ x" String -> String -> String
`congruency` String
"Just . toJSON, where"
, String
"x = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
showX
, String
"encoded = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
showEncoded
, String
"decoded = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
showDecoded
]
, lawContextReduced :: String
lawContextReduced = Maybe Value -> Maybe Value -> String
forall a. Show a => a -> a -> String
reduced Maybe Value
lhs Maybe Value
rhs
}
Maybe Value -> Maybe Value -> Context -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx Maybe Value
lhs Maybe Value
rhs Context
ctx