{-# LANGUAGE CPP #-}

{-# LANGUAGE FlexibleContexts #-} -- For arbitrary Compose

{-# LANGUAGE OverloadedStrings #-}

{-# LANGUAGE RankNTypes #-}

{-# LANGUAGE ScopedTypeVariables #-}

module Properties (module Properties) where

import Prelude ()

import Prelude.Compat

import Control.Applicative (Const)

import Data.Aeson (eitherDecode, encode)

import Data.Aeson.Encoding (encodingToLazyByteString)

import Data.Aeson.Internal (IResult(..), formatError, ifromJSON, iparse)

import qualified Data.Aeson.Internal as I

import Data.Aeson.Parser (value)

import Data.Aeson.Types

import Data.DList (DList)

import Data.Functor.Compose (Compose (..))

import Data.HashMap.Strict (HashMap)

import Data.Hashable (Hashable)

import Data.Int (Int8)

import Data.List.NonEmpty (NonEmpty)

import Data.Map (Map)

import Data.Proxy (Proxy)

import Data.Ratio (Ratio)

import Data.Semigroup (Option(..))

import Data.Sequence (Seq)

import Data.Tagged (Tagged)

import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)

import Data.Version (Version)

import Encoders

import Instances ()

import Numeric.Natural (Natural)

import Test.Framework (Test, testGroup)

import Test.Framework.Providers.QuickCheck2 (testProperty)

import Test.QuickCheck (Arbitrary(..), Property, Testable, (===), (.&&.), counterexample)

import Types

import qualified Data.Attoparsec.Lazy as L

import qualified Data.ByteString.Lazy.Char8 as L

import qualified Data.HashMap.Strict as H

import qualified Data.Map as Map

import qualified Data.Text as T

import qualified Data.Text.Lazy as LT

import qualified Data.UUID.Types as UUID

import qualified Data.Vector as V

encodeDouble :: Double -> Double -> Property

encodeDouble num denom

    | isInfinite d || isNaN d = encode d === "null"

    | otherwise               = (read . L.unpack . encode) d === d

  where d = num / denom

encodeInteger :: Integer -> Property

encodeInteger i = encode i === L.pack (show i)

toParseJSON :: (Eq a, Show a) =>

               (Value -> Parser a) -> (a -> Value) -> a -> Property

toParseJSON parsejson tojson x =

    case iparse parsejson . tojson $ x of

      IError path msg -> failure "parse" (formatError path msg) x

      ISuccess x'     -> x === x'

toParseJSON1

    :: (Eq (f Int), Show (f Int))

    => (forall a. LiftParseJSON f a)

    -> (forall a. LiftToJSON f a)

    -> f Int

    -> Property

toParseJSON1 parsejson1 tojson1 = toParseJSON parsejson tojson

  where

    parsejson = parsejson1 parseJSON (listParser parseJSON)

    tojson    = tojson1 toJSON (listValue toJSON)

roundTripEnc :: (FromJSON a, ToJSON a, Show a) =>

             (a -> a -> Property) -> a -> a -> Property

roundTripEnc eq _ i =

    case fmap ifromJSON . L.parse value . encode $ i of

      L.Done _ (ISuccess v)      -> v `eq` i

      L.Done _ (IError path err) -> failure "fromJSON" (formatError path err) i

      L.Fail _ _ err             -> failure "parse" err i

roundTripNoEnc :: (FromJSON a, ToJSON a, Show a) =>

             (a -> a -> Property) -> a -> a -> Property

roundTripNoEnc eq _ i =

    case ifromJSON . toJSON $ i of

      (ISuccess v)      -> v `eq` i

      (IError path err) -> failure "fromJSON" (formatError path err) i

roundTripEq :: (Eq a, FromJSON a, ToJSON a, Show a) => a -> a -> Property

roundTripEq x y = roundTripEnc (===) x y .&&. roundTripNoEnc (===) x y

-- We test keys by encoding HashMap and Map with it

roundTripKey

    :: (Ord a, Hashable a, FromJSONKey a, ToJSONKey a, Show a)

    => a -> HashMap a Int -> Map a Int -> Property

roundTripKey _ h m = roundTripEq h h .&&. roundTripEq m m

infix 4 ==~

(==~) :: (ApproxEq a, Show a) => a -> a -> Property

x ==~ y =

  counterexample (show x ++ " /= " ++ show y) (x =~ y)

toFromJSON :: (Arbitrary a, Eq a, FromJSON a, ToJSON a, Show a) => a -> Property

toFromJSON x = case ifromJSON (toJSON x) of

                IError path err -> failure "fromJSON" (formatError path err) x

                ISuccess x'     -> x === x'

modifyFailureProp :: String -> String -> Bool

modifyFailureProp orig added =

    result == Error (added ++ orig)

  where

    parser = const $ modifyFailure (added ++) $ fail orig

    result :: Result ()

    result = parse parser ()

parserThrowErrorProp :: String -> Property

parserThrowErrorProp msg =

    result === Error msg

  where

    parser = const $ parserThrowError [] msg

    result :: Result ()

    result = parse parser ()

-- | Tests (also) that we catch the JSONPath and it has elements in the right order.

parserCatchErrorProp :: [String] -> String -> Property

parserCatchErrorProp path msg =

    result === Success ([I.Key "outer", I.Key "inner"] ++ jsonPath, msg)

  where

    parser = parserCatchError outer (curry pure)

    outer = inner I. I.Key "outer"

    inner = parserThrowError jsonPath msg I. I.Key "inner"

    result :: Result (I.JSONPath, String)

    result = parse (const parser) ()

    jsonPath = map (I.Key . T.pack) path

-- | Perform a structural comparison of the results of two encoding

-- methods. Compares decoded values to account for HashMap-driven

-- variation in JSON object key ordering.

sameAs :: (a -> Value) -> (a -> Encoding) -> a -> Property

sameAs toVal toEnc v =

  counterexample (show s) $

    eitherDecode s === Right (toVal v)

  where

    s = encodingToLazyByteString (toEnc v)

sameAs1

    :: (forall a. LiftToJSON f a)

    -> (forall a. LiftToEncoding f a)

    -> f Int

    -> Property

sameAs1 toVal1 toEnc1 v = lhs === rhs

  where

    rhs = Right $ toVal1 toJSON (listValue toJSON) v

    lhs = eitherDecode . encodingToLazyByteString $

        toEnc1 toEncoding (listEncoding toEncoding) v

sameAs1Agree

    :: ToJSON a

    => (f a -> Encoding)

    -> (forall b. LiftToEncoding f b)

    -> f a

    -> Property

sameAs1Agree toEnc toEnc1 v = rhs === lhs

  where

    rhs = encodingToLazyByteString $ toEnc v

    lhs = encodingToLazyByteString $ toEnc1 toEncoding (listEncoding toEncoding) v

type P6 = Product6 Int Bool String (Approx Double) (Int, Approx Double) ()

type S4 = Sum4 Int8 ZonedTime T.Text (Map.Map String Int)

--------------------------------------------------------------------------------

-- Value properties

--------------------------------------------------------------------------------

-- | Add the formatted @Value@ to the printed counterexample when the property

-- fails.

checkValue :: Testable a => (Value -> a) -> Value -> Property

checkValue prop v = counterexample (L.unpack (encode v)) (prop v)

isString :: Value -> Bool

isString (String _) = True

isString _          = False

is2ElemArray :: Value -> Bool

is2ElemArray (Array v) = V.length v == 2 && isString (V.head v)

is2ElemArray _         = False

isTaggedObjectValue :: Value -> Bool

isTaggedObjectValue (Object obj) = "tag"      `H.member` obj &&

                                   "contents" `H.member` obj

isTaggedObjectValue _            = False

isNullaryTaggedObject :: Value -> Bool

isNullaryTaggedObject obj = isTaggedObject' obj && isObjectWithSingleField obj

isTaggedObject :: Value -> Property

isTaggedObject = checkValue isTaggedObject'

isTaggedObject' :: Value -> Bool

isTaggedObject' (Object obj) = "tag" `H.member` obj

isTaggedObject' _            = False

isObjectWithSingleField :: Value -> Bool

isObjectWithSingleField (Object obj) = H.size obj == 1

isObjectWithSingleField _            = False

-- | is untaggedValue of EitherTextInt

isUntaggedValueETI :: Value -> Bool

isUntaggedValueETI (String s)

    | s == "nonenullary"   = True

isUntaggedValueETI (Bool _)   = True

isUntaggedValueETI (Number _) = True

isUntaggedValueETI (Array a)  = length a == 2

isUntaggedValueETI _          = False

isEmptyArray :: Value -> Property

isEmptyArray = checkValue isEmptyArray'

isEmptyArray' :: Value -> Bool

isEmptyArray' = (Array mempty ==)

--------------------------------------------------------------------------------

tests :: Test

tests = testGroup "properties" [

  testGroup "encode" [

      testProperty "encodeDouble" encodeDouble

    , testProperty "encodeInteger" encodeInteger

    ]

  , testGroup "roundTrip" [

      testProperty "Bool" $ roundTripEq True

    , testProperty "Double" $ roundTripEq (1 :: Approx Double)

    , testProperty "Int" $ roundTripEq (1 :: Int)

    , testProperty "NonEmpty Char" $ roundTripEq (undefined :: NonEmpty Char)

    , testProperty "Integer" $ roundTripEq (1 :: Integer)

    , testProperty "String" $ roundTripEq ("" :: String)

    , testProperty "Text" $ roundTripEq T.empty

    , testProperty "Lazy Text" $ roundTripEq LT.empty

    , testProperty "Foo" $ roundTripEq (undefined :: Foo)

    , testProperty "Day" $ roundTripEq (undefined :: Day)

    , testProperty "BCE Day" $ roundTripEq (undefined :: BCEDay)

    , testProperty "DotNetTime" $ roundTripEq (undefined :: Approx DotNetTime)

    , testProperty "LocalTime" $ roundTripEq (undefined :: LocalTime)

    , testProperty "TimeOfDay" $ roundTripEq (undefined :: TimeOfDay)

    , testProperty "UTCTime" $ roundTripEq (undefined :: UTCTime)

    , testProperty "ZonedTime" $ roundTripEq (undefined :: ZonedTime)

    , testProperty "NominalDiffTime" $ roundTripEq (undefined :: NominalDiffTime)

    , testProperty "DiffTime" $ roundTripEq (undefined :: DiffTime)

    , testProperty "Version" $ roundTripEq (undefined :: Version)

    , testProperty "Natural" $ roundTripEq (undefined :: Natural)

    , testProperty "Proxy" $ roundTripEq (undefined :: Proxy Int)

    , testProperty "Tagged" $ roundTripEq (undefined :: Tagged Int Char)

    , testProperty "Const" $ roundTripEq (undefined :: Const Int Char)

    , testProperty "DList" $ roundTripEq (undefined :: DList Int)

    , testProperty "Seq" $ roundTripEq (undefined :: Seq Int)

    , testProperty "Rational" $ roundTripEq (undefined :: Rational)

    , testProperty "Ratio Int" $ roundTripEq (undefined :: Ratio Int)

    , testProperty "UUID" $ roundTripEq UUID.nil

    , testGroup "functors"

      [ testProperty "Identity Char" $ roundTripEq (undefined :: I Int)

      , testProperty "Identity Char" $ roundTripEq (undefined :: I Char)

      , testProperty "Identity [Char]" $ roundTripEq (undefined :: I String)

      , testProperty "[Identity Char]" $ roundTripEq (undefined :: [I Char])

      , testProperty "Compose I  I  Int" $ roundTripEq (undefined :: LogScaled (Compose I  I  Int))

      , testProperty "Compose [] I  Int" $ roundTripEq (undefined :: LogScaled (Compose [] I  Int))

      , testProperty "Compose I  [] Int" $ roundTripEq (undefined :: LogScaled (Compose I  [] Int))

      , testProperty "Compose [] [] Int" $ roundTripEq (undefined :: LogScaled (Compose [] [] Int))

      , testProperty "Compose I  I  Char" $ roundTripEq (undefined :: LogScaled (Compose I  I  Char))

      , testProperty "Compose [] I  Char" $ roundTripEq (undefined :: LogScaled (Compose [] I  Char))

      , testProperty "Compose I  [] Char" $ roundTripEq (undefined :: LogScaled (Compose I  [] Char))

      , testProperty "Compose [] [] Char" $ roundTripEq (undefined :: LogScaled (Compose [] [] Char))

      , testProperty "Compose3 I  I  I  Char" $ roundTripEq (undefined :: LogScaled (Compose3 I  I  I  Char))

      , testProperty "Compose3 I  [] I  Char" $ roundTripEq (undefined :: LogScaled (Compose3 I  [] I  Char))

      , testProperty "Compose3 I  I  [] Char" $ roundTripEq (undefined :: LogScaled (Compose3 I  I  [] Char))

      , testProperty "Compose3 I  [] [] Char" $ roundTripEq (undefined :: LogScaled (Compose3 I  [] [] Char))

      , testProperty "Compose3 [] I  I  Char" $ roundTripEq (undefined :: LogScaled (Compose3 [] I  I  Char))

      , testProperty "Compose3 [] [] I  Char" $ roundTripEq (undefined :: LogScaled (Compose3 [] [] I  Char))

      , testProperty "Compose3 [] I  [] Char" $ roundTripEq (undefined :: LogScaled (Compose3 [] I  [] Char))

      , testProperty "Compose3 [] [] [] Char" $ roundTripEq (undefined :: LogScaled (Compose3 [] [] [] Char))

      , testProperty "Compose3' I  I  I  Char" $ roundTripEq (undefined :: LogScaled (Compose3' I  I  I  Char))

      , testProperty "Compose3' I  [] I  Char" $ roundTripEq (undefined :: LogScaled (Compose3' I  [] I  Char))

      , testProperty "Compose3' I  I  [] Char" $ roundTripEq (undefined :: LogScaled (Compose3' I  I  [] Char))

      , testProperty "Compose3' I  [] [] Char" $ roundTripEq (undefined :: LogScaled (Compose3' I  [] [] Char))

      , testProperty "Compose3' [] I  I  Char" $ roundTripEq (undefined :: LogScaled (Compose3' [] I  I  Char))

      , testProperty "Compose3' [] [] I  Char" $ roundTripEq (undefined :: LogScaled (Compose3' [] [] I  Char))

      , testProperty "Compose3' [] I  [] Char" $ roundTripEq (undefined :: LogScaled (Compose3' [] I  [] Char))

      , testProperty "Compose3' [] [] [] Char" $ roundTripEq (undefined :: LogScaled (Compose3' [] [] [] Char))

      ]

    , testGroup "ghcGenerics" [

        testProperty "OneConstructor" $ roundTripEq OneConstructor

      , testProperty "Product2" $ roundTripEq (undefined :: Product2 Int Bool)

      , testProperty "Product6" $ roundTripEq (undefined :: P6)

      , testProperty "Sum4" $ roundTripEq (undefined :: S4)

      ]

    ]

  , testGroup "roundTrip Key"

    [ testProperty "Bool" $ roundTripKey True

    , testProperty "Text" $ roundTripKey (undefined :: T.Text)

    , testProperty "String" $ roundTripKey (undefined :: String)

    , testProperty "Int" $ roundTripKey (undefined :: Int)

    , testProperty "[Text]" $ roundTripKey (undefined :: LogScaled [T.Text])

    , testProperty "(Int,Char)" $ roundTripKey (undefined :: (Int,Char))

    , testProperty "Integer" $ roundTripKey (undefined :: Integer)

    , testProperty "Natural" $ roundTripKey (undefined :: Natural)

    , testProperty "Float" $ roundTripKey (undefined :: Float)

    , testProperty "Double" $ roundTripKey (undefined :: Double)

#if MIN_VERSION_base(4,7,0)

    , testProperty "Day" $ roundTripKey (undefined :: Day)

    , testProperty "LocalTime" $ roundTripKey (undefined :: LocalTime)

    , testProperty "TimeOfDay" $ roundTripKey (undefined :: TimeOfDay)

    , testProperty "UTCTime" $ roundTripKey (undefined :: UTCTime)

#endif

    , testProperty "Version" $ roundTripKey (undefined :: Version)

    , testProperty "Lazy Text" $ roundTripKey (undefined :: LT.Text)

    , testProperty "UUID" $ roundTripKey UUID.nil

    ]

  , testGroup "toFromJSON" [

      testProperty "Integer" (toFromJSON :: Integer -> Property)

    , testProperty "Double" (toFromJSON :: Double -> Property)

    , testProperty "Maybe Integer" (toFromJSON :: Maybe Integer -> Property)

    , testProperty "Either Integer Double" (toFromJSON :: Either Integer Double -> Property)

    , testProperty "Either Integer Integer" (toFromJSON :: Either Integer Integer -> Property)

    ]

  , testGroup "failure messages" [

      testProperty "modify failure" modifyFailureProp

    , testProperty "parserThrowError" parserThrowErrorProp

    , testProperty "parserCatchError" parserCatchErrorProp

    ]

  , testGroup "generic" [

      testGroup "toJSON" [

        testGroup "Nullary" [

            testProperty "string" (isString . gNullaryToJSONString)

          , testProperty "2ElemArray" (is2ElemArray . gNullaryToJSON2ElemArray)

          , testProperty "TaggedObject" (isNullaryTaggedObject . gNullaryToJSONTaggedObject)

          , testProperty "ObjectWithSingleField" (isObjectWithSingleField . gNullaryToJSONObjectWithSingleField)

          , testGroup "roundTrip" [

              testProperty "string" (toParseJSON gNullaryParseJSONString gNullaryToJSONString)

            , testProperty "2ElemArray" (toParseJSON gNullaryParseJSON2ElemArray gNullaryToJSON2ElemArray)

            , testProperty "TaggedObject" (toParseJSON gNullaryParseJSONTaggedObject gNullaryToJSONTaggedObject)

            , testProperty "ObjectWithSingleField" (toParseJSON gNullaryParseJSONObjectWithSingleField gNullaryToJSONObjectWithSingleField)

            ]

        ]

      , testGroup "EitherTextInt" [

          testProperty "UntaggedValue" (isUntaggedValueETI . gEitherTextIntToJSONUntaggedValue)

        , testProperty "roundtrip" (toParseJSON gEitherTextIntParseJSONUntaggedValue gEitherTextIntToJSONUntaggedValue)

        ]

      , testGroup "SomeType" [

          testProperty "2ElemArray" (is2ElemArray . gSomeTypeToJSON2ElemArray)

        , testProperty "TaggedObject" (isTaggedObject . gSomeTypeToJSONTaggedObject)

        , testProperty "ObjectWithSingleField" (isObjectWithSingleField . gSomeTypeToJSONObjectWithSingleField)

        , testGroup "roundTrip" [

            testProperty "2ElemArray" (toParseJSON gSomeTypeParseJSON2ElemArray gSomeTypeToJSON2ElemArray)

          , testProperty "TaggedObject" (toParseJSON gSomeTypeParseJSONTaggedObject gSomeTypeToJSONTaggedObject)

          , testProperty "ObjectWithSingleField" (toParseJSON gSomeTypeParseJSONObjectWithSingleField gSomeTypeToJSONObjectWithSingleField)

#if __GLASGOW_HASKELL__ >= 706

          , testProperty "2ElemArray unary" (toParseJSON1 gSomeTypeLiftParseJSON2ElemArray gSomeTypeLiftToJSON2ElemArray)

          , testProperty "TaggedObject unary" (toParseJSON1 gSomeTypeLiftParseJSONTaggedObject gSomeTypeLiftToJSONTaggedObject)

          , testProperty "ObjectWithSingleField unary" (toParseJSON1 gSomeTypeLiftParseJSONObjectWithSingleField gSomeTypeLiftToJSONObjectWithSingleField)

#endif

          ]

        ]

      , testGroup "OneConstructor" [

          testProperty "default" (isEmptyArray . gOneConstructorToJSONDefault)

        , testProperty "Tagged"  (isTaggedObject . gOneConstructorToJSONTagged)

        , testGroup "roundTrip" [

            testProperty "default" (toParseJSON gOneConstructorParseJSONDefault gOneConstructorToJSONDefault)

          , testProperty "Tagged"  (toParseJSON gOneConstructorParseJSONTagged  gOneConstructorToJSONTagged)

          ]

        ]

      , testGroup "OptionField" [

          testProperty "like Maybe" $

          \x -> gOptionFieldToJSON (OptionField (Option x)) === thMaybeFieldToJSON (MaybeField x)

        , testProperty "roundTrip" (toParseJSON gOptionFieldParseJSON gOptionFieldToJSON)

        ]

      ]

    , testGroup "toEncoding" [

        testProperty "NullaryString" $

        gNullaryToJSONString `sameAs` gNullaryToEncodingString

      , testProperty "Nullary2ElemArray" $

        gNullaryToJSON2ElemArray `sameAs` gNullaryToEncoding2ElemArray

      , testProperty "NullaryTaggedObject" $

        gNullaryToJSONTaggedObject `sameAs` gNullaryToEncodingTaggedObject

      , testProperty "NullaryObjectWithSingleField" $

        gNullaryToJSONObjectWithSingleField `sameAs`

        gNullaryToEncodingObjectWithSingleField

      -- , testProperty "ApproxUnwrap" $

      --   gApproxToJSONUnwrap `sameAs` gApproxToEncodingUnwrap

      , testProperty "ApproxDefault" $

        gApproxToJSONDefault `sameAs` gApproxToEncodingDefault

      , testProperty "EitherTextInt UntaggedValue" $

        gEitherTextIntToJSONUntaggedValue `sameAs` gEitherTextIntToEncodingUntaggedValue

      , testProperty "SomeType2ElemArray" $

        gSomeTypeToJSON2ElemArray `sameAs` gSomeTypeToEncoding2ElemArray

#if __GLASGOW_HASKELL__ >= 706

      , testProperty "SomeType2ElemArray unary" $

        gSomeTypeLiftToJSON2ElemArray `sameAs1` gSomeTypeLiftToEncoding2ElemArray

      , testProperty "SomeType2ElemArray unary agree" $

        gSomeTypeToEncoding2ElemArray `sameAs1Agree` gSomeTypeLiftToEncoding2ElemArray

#endif

      , testProperty "SomeTypeTaggedObject" $

        gSomeTypeToJSONTaggedObject `sameAs` gSomeTypeToEncodingTaggedObject

#if __GLASGOW_HASKELL__ >= 706

      , testProperty "SomeTypeTaggedObject unary" $

        gSomeTypeLiftToJSONTaggedObject `sameAs1` gSomeTypeLiftToEncodingTaggedObject

      , testProperty "SomeTypeTaggedObject unary agree" $

        gSomeTypeToEncodingTaggedObject `sameAs1Agree` gSomeTypeLiftToEncodingTaggedObject

#endif

      , testProperty "SomeTypeObjectWithSingleField" $

        gSomeTypeToJSONObjectWithSingleField `sameAs` gSomeTypeToEncodingObjectWithSingleField

#if __GLASGOW_HASKELL__ >= 706

      , testProperty "SomeTypeObjectWithSingleField unary" $

        gSomeTypeLiftToJSONObjectWithSingleField `sameAs1` gSomeTypeLiftToEncodingObjectWithSingleField

      , testProperty "SomeTypeObjectWithSingleField unary agree" $

        gSomeTypeToEncodingObjectWithSingleField `sameAs1Agree` gSomeTypeLiftToEncodingObjectWithSingleField

#endif

      , testProperty "SomeTypeOmitNothingFields" $

        gSomeTypeToJSONOmitNothingFields `sameAs` gSomeTypeToEncodingOmitNothingFields

      , testProperty "OneConstructorDefault" $

        gOneConstructorToJSONDefault `sameAs` gOneConstructorToEncodingDefault

      , testProperty "OneConstructorTagged" $

        gOneConstructorToJSONTagged `sameAs` gOneConstructorToEncodingTagged

      , testProperty "OptionField" $

        gOptionFieldToJSON `sameAs` gOptionFieldToEncoding

      ]

    ]

  , testGroup "template-haskell" [

      testGroup "toJSON" [

        testGroup "Nullary" [

            testProperty "string" (isString . thNullaryToJSONString)

          , testProperty "2ElemArray" (is2ElemArray . thNullaryToJSON2ElemArray)

          , testProperty "TaggedObject" (isNullaryTaggedObject . thNullaryToJSONTaggedObject)

          , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thNullaryToJSONObjectWithSingleField)

          , testGroup "roundTrip" [

              testProperty "string" (toParseJSON thNullaryParseJSONString thNullaryToJSONString)

            , testProperty "2ElemArray" (toParseJSON thNullaryParseJSON2ElemArray thNullaryToJSON2ElemArray)

            , testProperty "TaggedObject" (toParseJSON thNullaryParseJSONTaggedObject thNullaryToJSONTaggedObject)

            , testProperty "ObjectWithSingleField" (toParseJSON thNullaryParseJSONObjectWithSingleField thNullaryToJSONObjectWithSingleField)

            ]

        ]

      , testGroup "EitherTextInt" [

          testProperty "UntaggedValue" (isUntaggedValueETI . thEitherTextIntToJSONUntaggedValue)

        , testProperty "roundtrip" (toParseJSON thEitherTextIntParseJSONUntaggedValue thEitherTextIntToJSONUntaggedValue)

        ]

      , testGroup "SomeType" [

          testProperty "2ElemArray" (is2ElemArray . thSomeTypeToJSON2ElemArray)

        , testProperty "TaggedObject" (isTaggedObject . thSomeTypeToJSONTaggedObject)

        , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thSomeTypeToJSONObjectWithSingleField)

        , testGroup "roundTrip" [

            testProperty "2ElemArray" (toParseJSON thSomeTypeParseJSON2ElemArray thSomeTypeToJSON2ElemArray)

          , testProperty "TaggedObject" (toParseJSON thSomeTypeParseJSONTaggedObject thSomeTypeToJSONTaggedObject)

          , testProperty "ObjectWithSingleField" (toParseJSON thSomeTypeParseJSONObjectWithSingleField thSomeTypeToJSONObjectWithSingleField)

          , testProperty "2ElemArray unary" (toParseJSON1 thSomeTypeLiftParseJSON2ElemArray thSomeTypeLiftToJSON2ElemArray)

          , testProperty "TaggedObject unary" (toParseJSON1 thSomeTypeLiftParseJSONTaggedObject thSomeTypeLiftToJSONTaggedObject)

          , testProperty "ObjectWithSingleField unary" (toParseJSON1 thSomeTypeLiftParseJSONObjectWithSingleField thSomeTypeLiftToJSONObjectWithSingleField)

          ]

        ]

      , testGroup "Approx" [

          testProperty "string"                (isString                . thApproxToJSONUnwrap)

        , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thApproxToJSONDefault)

        , testGroup "roundTrip" [

            testProperty "string"                (toParseJSON thApproxParseJSONUnwrap  thApproxToJSONUnwrap)

          , testProperty "ObjectWithSingleField" (toParseJSON thApproxParseJSONDefault thApproxToJSONDefault)

          ]

        ]

      , testGroup "GADT" [

          testProperty "string"                (isString                . thGADTToJSONUnwrap)

        , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thGADTToJSONDefault)

        , testGroup "roundTrip" [

            testProperty "string"                (toParseJSON thGADTParseJSONUnwrap  thGADTToJSONUnwrap)

          , testProperty "ObjectWithSingleField" (toParseJSON thGADTParseJSONDefault thGADTToJSONDefault)

          ]

        ]

      , testGroup "OneConstructor" [

          testProperty "default" (isEmptyArray . thOneConstructorToJSONDefault)

        , testProperty "Tagged"  (isTaggedObject . thOneConstructorToJSONTagged)

        , testGroup "roundTrip" [

            testProperty "default" (toParseJSON thOneConstructorParseJSONDefault thOneConstructorToJSONDefault)

          , testProperty "Tagged"  (toParseJSON thOneConstructorParseJSONTagged  thOneConstructorToJSONTagged)

          ]

        ]

      , testGroup "OptionField" [

          testProperty "like Maybe" $

          \x -> thOptionFieldToJSON (OptionField (Option x)) === thMaybeFieldToJSON (MaybeField x)

        , testProperty "roundTrip" (toParseJSON thOptionFieldParseJSON thOptionFieldToJSON)

        ]

      ]

    , testGroup "toEncoding" [

        testProperty "NullaryString" $

        thNullaryToJSONString `sameAs` thNullaryToEncodingString

      , testProperty "Nullary2ElemArray" $

        thNullaryToJSON2ElemArray `sameAs` thNullaryToEncoding2ElemArray

      , testProperty "NullaryTaggedObject" $

        thNullaryToJSONTaggedObject `sameAs` thNullaryToEncodingTaggedObject

      , testProperty "NullaryObjectWithSingleField" $

        thNullaryToJSONObjectWithSingleField `sameAs`

        thNullaryToEncodingObjectWithSingleField

      , testProperty "ApproxUnwrap" $

        thApproxToJSONUnwrap `sameAs` thApproxToEncodingUnwrap

      , testProperty "ApproxDefault" $

        thApproxToJSONDefault `sameAs` thApproxToEncodingDefault

      , testProperty "EitherTextInt UntaggedValue" $

        thEitherTextIntToJSONUntaggedValue `sameAs` thEitherTextIntToEncodingUntaggedValue

      , testProperty "SomeType2ElemArray" $

        thSomeTypeToJSON2ElemArray `sameAs` thSomeTypeToEncoding2ElemArray

      , testProperty "SomeType2ElemArray unary" $

        thSomeTypeLiftToJSON2ElemArray `sameAs1` thSomeTypeLiftToEncoding2ElemArray

      , testProperty "SomeType2ElemArray unary agree" $

        thSomeTypeToEncoding2ElemArray `sameAs1Agree` thSomeTypeLiftToEncoding2ElemArray

      , testProperty "SomeTypeTaggedObject" $

        thSomeTypeToJSONTaggedObject `sameAs` thSomeTypeToEncodingTaggedObject

      , testProperty "SomeTypeTaggedObject unary" $

        thSomeTypeLiftToJSONTaggedObject `sameAs1` thSomeTypeLiftToEncodingTaggedObject

      , testProperty "SomeTypeTaggedObject unary agree" $

        thSomeTypeToEncodingTaggedObject `sameAs1Agree` thSomeTypeLiftToEncodingTaggedObject

      , testProperty "SomeTypeObjectWithSingleField" $

        thSomeTypeToJSONObjectWithSingleField `sameAs` thSomeTypeToEncodingObjectWithSingleField

      , testProperty "SomeTypeObjectWithSingleField unary" $

        thSomeTypeLiftToJSONObjectWithSingleField `sameAs1` thSomeTypeLiftToEncodingObjectWithSingleField

      , testProperty "SomeTypeObjectWithSingleField unary agree" $

        thSomeTypeToEncodingObjectWithSingleField `sameAs1Agree` thSomeTypeLiftToEncodingObjectWithSingleField

      , testProperty "OneConstructorDefault" $

        thOneConstructorToJSONDefault `sameAs` thOneConstructorToEncodingDefault

      , testProperty "OneConstructorTagged" $

        thOneConstructorToJSONTagged `sameAs` thOneConstructorToEncodingTagged

      , testProperty "OptionField" $

        thOptionFieldToJSON `sameAs` thOptionFieldToEncoding

      ]

    ]

  ]