{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_GHC -Wall #-}

module Test.QuickCheck.Classes.Json
  (
#if HAVE_AESON
    jsonLaws
#endif  
  ) where

import Data.Proxy (Proxy)
import Test.QuickCheck hiding ((.&.))
import Test.QuickCheck.Property (Property(..))

#if HAVE_AESON
import Data.Aeson (FromJSON(..), ToJSON(..))
import qualified Data.Aeson as AE
#endif

import Test.QuickCheck.Classes.Internal (Laws(..))

-- | Tests the following properties:
--
-- [/Partial Isomorphism/]
--   @decode . encode ≡ Just@
-- [/Encoding Equals Value/]
--   @decode . encode ≡ Just . toJSON@
--
-- Note that in the second property, the type of decode is @ByteString -> Value@,
-- not @ByteString -> a@
#if HAVE_AESON
jsonLaws :: (ToJSON a, FromJSON a, Show a, Arbitrary a, Eq a) => Proxy a -> Laws
jsonLaws :: Proxy a -> Laws
jsonLaws Proxy a
p = String -> [(String, Property)] -> Laws
Laws String
"ToJSON/FromJSON"
  [ (String
"Partial Isomorphism", Proxy a -> Property
forall a.
(ToJSON a, FromJSON a, Show a, Eq a, Arbitrary a) =>
Proxy a -> Property
jsonEncodingPartialIsomorphism Proxy a
p)
  , (String
"Encoding Equals Value", Proxy a -> Property
forall a. (ToJSON a, Show a, Arbitrary a) => Proxy a -> Property
jsonEncodingEqualsValue Proxy a
p)
  ]

-- TODO: improve the quality of the error message if
-- something does not pass this test.
jsonEncodingEqualsValue :: forall a. (ToJSON a, Show a, Arbitrary a) => Proxy a -> Property
jsonEncodingEqualsValue :: Proxy a -> Property
jsonEncodingEqualsValue Proxy a
_ = (a -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> Bool) -> Property) -> (a -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) ->
  case ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
AE.decode (a -> ByteString
forall a. ToJSON a => a -> ByteString
AE.encode a
a) of
    Maybe Value
Nothing -> Bool
False
    Just (Value
v :: AE.Value) -> Value
v Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a

jsonEncodingPartialIsomorphism :: forall a. (ToJSON a, FromJSON a, Show a, Eq a, Arbitrary a) => Proxy a -> Property
jsonEncodingPartialIsomorphism :: Proxy a -> Property
jsonEncodingPartialIsomorphism Proxy a
_ =
#if MIN_VERSION_QuickCheck(2,9,0)
  Property -> Property
forall prop. Testable prop => prop -> Property
again (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
#endif
  Gen Prop -> Property
MkProperty (Gen Prop -> Property) -> Gen Prop -> Property
forall a b. (a -> b) -> a -> b
$
    Gen a
forall a. Arbitrary a => Gen a
arbitrary Gen a -> (a -> Gen Prop) -> Gen Prop
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
x :: a) ->
      Property -> Gen Prop
unProperty (Property -> Gen Prop) -> Property -> Gen Prop
forall a b. (a -> b) -> a -> b
$
      (a -> [a]) -> a -> (a -> Property) -> Property
forall prop a.
Testable prop =>
(a -> [a]) -> a -> (a -> prop) -> Property
shrinking a -> [a]
forall a. Arbitrary a => a -> [a]
shrink a
x ((a -> Property) -> Property) -> (a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \a
x' ->
        let desc1 :: String
desc1 = String
"Just"
            desc2 :: String
desc2 = String
"Data.Aeson.decode . Data.Aeson.encode"
            name1 :: String
name1 = String
"Data.Aeson.encode a"
            name2 :: String
name2 = String
"Data.Aeson.decode (Data.Aeson.encode a)"
            b1 :: ByteString
b1  = a -> ByteString
forall a. ToJSON a => a -> ByteString
AE.encode a
x'
            b2 :: Maybe a
b2  = ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
AE.decode (a -> ByteString
forall a. ToJSON a => a -> ByteString
AE.encode a
x')
            sb1 :: String
sb1 = ByteString -> String
forall a. Show a => a -> String
show ByteString
b1
            sb2 :: String
sb2 = Maybe a -> String
forall a. Show a => a -> String
show Maybe a
b2
            description :: String
description = String
"  Description: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
desc1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" == " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
desc2
            err :: String
err = String
description String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String
"a = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x'])) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sb1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sb2
        in String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
err (a -> Maybe a
forall a. a -> Maybe a
Just a
x' Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe a
b2)
#endif