    {-# 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 :: forall a.
    (ToJSON a, FromJSON a, Show a, Arbitrary a, Eq a) =>
    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 :: forall a. (ToJSON a, Show a, Arbitrary a) => 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 :: forall a.
    (ToJSON a, FromJSON a, Show a, Eq a, Arbitrary a) =>
    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 a b. Gen a -> (a -> Gen b) -> Gen b
    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