39 lines
1.6 KiB
Haskell
39 lines
1.6 KiB
Haskell
module Test.QuickCheck.Classes.JSON
|
|
( jsonKeyLaws
|
|
) where
|
|
|
|
import ClassyPrelude
|
|
import Test.QuickCheck
|
|
import Test.QuickCheck.Property (failed)
|
|
import Test.QuickCheck.Classes
|
|
import Data.Aeson
|
|
import Data.Aeson.Encoding.Internal
|
|
import Data.Aeson.Types (parseMaybe)
|
|
import Data.Proxy
|
|
import Unsafe.Coerce -- DON'T PANIC, it's aeson's fault
|
|
|
|
jsonKeyLaws :: forall a. (Arbitrary a, FromJSONKey a, ToJSONKey a, Eq a, Show a, FromJSON a, ToJSON a) => Proxy a -> Laws
|
|
jsonKeyLaws _ = Laws "ToJSONKey/FromJSONKey"
|
|
[ ("Partial Isomorphism", property $ \(a :: a) -> partialIsomorphism a)
|
|
, ("Partial Isomorphism (List)", property $ \(as :: [a]) -> partialIsomorphism as)
|
|
, ("Encoding Equals Value", property $ \(a :: a)
|
|
-> let (toVal, toEnc) = case toJSONKey of
|
|
ToJSONKeyText toVal' toEnc' -> (String . toVal', retagEncoding . toEnc')
|
|
ToJSONKeyValue toVal' toEnc' -> (toVal', toEnc')
|
|
in decode (encodingToLazyByteString $ toEnc a) == Just (toVal a)
|
|
)
|
|
]
|
|
where
|
|
partialIsomorphism :: forall a'. (FromJSONKey a', ToJSONKey a', Eq a') => a' -> Property
|
|
partialIsomorphism a = case (toJSONKey, fromJSONKey) of
|
|
(ToJSONKeyText toVal _, FromJSONKeyCoerce _)
|
|
-> property $ unsafeCoerce (toVal a) == a
|
|
(ToJSONKeyText toVal _, FromJSONKeyText fromVal)
|
|
-> property $ fromVal (toVal a) == a
|
|
(ToJSONKeyText toVal _, FromJSONKeyTextParser parser)
|
|
-> property $ parseMaybe parser (toVal a) == Just a
|
|
(ToJSONKeyValue toVal _, FromJSONKeyValue parser)
|
|
-> property $ parseMaybe parser (toVal a) == Just a
|
|
(_, _)
|
|
-> property failed
|