    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    #if HAVE_QUANTIFIED_CONSTRAINTS
    {-# LANGUAGE QuantifiedConstraints #-}
    #endif
    {-# OPTIONS_GHC -Wall #-}

    module Test.QuickCheck.Classes.Generic
      (
    #if MIN_VERSION_base(4,5,0)
        genericLaws
    #if HAVE_UNARY_LAWS
      , generic1Laws
    #endif
    #endif
      ) where

    #if MIN_VERSION_base(4,5,0)
    import Control.Applicative
    import Data.Semigroup as SG
    import Data.Monoid as MD
    import GHC.Generics
    #if HAVE_UNARY_LAWS
    import Data.Functor.Classes
    #endif
    import Data.Proxy (Proxy(Proxy))
    import Test.QuickCheck
    import Test.QuickCheck.Property (Property)

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

    -- | Tests the following properties:
    --
    -- [/From-To Inverse/]
    --   @'from' '.' 'to' ≡  'id'@
    -- [/To-From Inverse/]
    --   @'to' '.' 'from' ≡  'id'@
    --
    -- /Note:/ This property test is only available when
    -- using @base-4.5@ or newer.
    --
    -- /Note:/ 'from' and 'to' don't actually care about
    -- the type variable @x@ in @'Rep' a x@, so here we instantiate
    -- it to @'()'@ by default. If you would like to instantiate @x@
    -- as something else, please file a bug report.
    genericLaws :: (Generic a, Eq a, Arbitrary a, Show a, Show (Rep a ()), Arbitrary (Rep a ()), Eq (Rep a ())) => Proxy a -> Laws
    genericLaws :: forall a.
    (Generic a, Eq a, Arbitrary a, Show a, Show (Rep a ()),
     Arbitrary (Rep a ()), Eq (Rep a ())) =>
    Proxy a -> Laws
    genericLaws Proxy a
    pa = String -> [(String, Property)] -> Laws
    Laws String
    "Generic"
      [ (String
    "From-To inverse", Proxy a -> Proxy () -> Property
    forall (proxy :: * -> *) a x.
    (Generic a, Show (Rep a x), Arbitrary (Rep a x), Eq (Rep a x)) =>
    proxy a -> proxy x -> Property
    fromToInverse Proxy a
    pa (Proxy ()
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy ()))
      , (String
    "To-From inverse", Proxy a -> Property
    forall (proxy :: * -> *) a.
    (Generic a, Eq a, Arbitrary a, Show a) =>
    proxy a -> Property
    toFromInverse Proxy a
    pa)
      ]

    toFromInverse :: forall proxy a. (Generic a, Eq a, Arbitrary a, Show a) => proxy a -> Property
    toFromInverse :: forall (proxy :: * -> *) a.
    (Generic a, Eq a, Arbitrary a, Show a) =>
    proxy a -> Property
    toFromInverse 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
    v :: a) -> (Rep a (ZonkAny 0) -> a
    forall a x. Generic a => Rep a x -> a
    forall x. Rep a x -> a
    to (Rep a (ZonkAny 0) -> a) -> (a -> Rep a (ZonkAny 0)) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Rep a (ZonkAny 0)
    forall x. a -> Rep a x
    forall a x. Generic a => a -> Rep a x
    from (a -> a) -> a -> a
    forall a b. (a -> b) -> a -> b
    $ a
    v) a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    v

    fromToInverse ::
         forall proxy a x.
         (Generic a, Show (Rep a x), Arbitrary (Rep a x), Eq (Rep a x))
      => proxy a
      -> proxy x
      -> Property
    fromToInverse :: forall (proxy :: * -> *) a x.
    (Generic a, Show (Rep a x), Arbitrary (Rep a x), Eq (Rep a x)) =>
    proxy a -> proxy x -> Property
    fromToInverse proxy a
    _ proxy x
    _ = (Rep a x -> Bool) -> Property
    forall prop. Testable prop => prop -> Property
    property ((Rep a x -> Bool) -> Property) -> (Rep a x -> Bool) -> Property
    forall a b. (a -> b) -> a -> b
    $ \(Rep a x
    r :: Rep a x) -> Rep a x
    r Rep a x -> Rep a x -> Bool
    forall a. Eq a => a -> a -> Bool
    == (a -> Rep a x
    forall x. a -> Rep a x
    forall a x. Generic a => a -> Rep a x
    from (Rep a x -> a
    forall a x. Generic a => Rep a x -> a
    forall x. Rep a x -> a
    to Rep a x
    r :: a))

    #if HAVE_UNARY_LAWS
    -- | Tests the following properties:
    --
    -- [/From-To Inverse/]
    --   @'from1' '.' 'to1' ≡  'id'@
    -- [/To-From Inverse/]
    --   @'to1' '.' 'from1' ≡  'id'@
    --
    -- /Note:/ This property test is only available when
    -- using @base-4.9@ or newer.
    generic1Laws :: (Generic1 f, Eq1 f, Arbitrary1 f, Show1 f, Eq1 (Rep1 f), Show1 (Rep1 f), Arbitrary1 (Rep1 f))
      => proxy f -> Laws
    generic1Laws :: forall (f :: * -> *) (proxy :: (* -> *) -> *).
    (Generic1 f, Eq1 f, Arbitrary1 f, Show1 f, Eq1 (Rep1 f),
     Show1 (Rep1 f), Arbitrary1 (Rep1 f)) =>
    proxy f -> Laws
    generic1Laws proxy f
    p = String -> [(String, Property)] -> Laws
    Laws String
    "Generic1"
      [ (String
    "From1-To1 inverse", proxy f -> Property
    forall (proxy :: (* -> *) -> *) (f :: * -> *).
    (Generic1 f, Eq1 (Rep1 f), Arbitrary1 (Rep1 f), Show1 (Rep1 f)) =>
    proxy f -> Property
    fromToInverse1 proxy f
    p)
      , (String
    "To1-From1 inverse", proxy f -> Property
    forall (proxy :: (* -> *) -> *) (f :: * -> *).
    (Generic1 f, Eq1 f, Arbitrary1 f, Show1 f) =>
    proxy f -> Property
    toFromInverse1 proxy f
    p)
      ]

    -- hack for quantified constraints: under base >= 4.12,
    -- our usual 'Apply' wrapper has Eq, Show, and Arbitrary
    -- instances that are incompatible.
    newtype GApply f a = GApply { forall (f :: * -> *) a. GApply f a -> f a
    getGApply :: f a }

    instance (Applicative f, Semigroup a) => Semigroup (GApply f a) where
      GApply f a
    x <> :: GApply f a -> GApply f a -> GApply f a
    <> GApply f a
    y = f a -> GApply f a
    forall (f :: * -> *) a. f a -> GApply f a
    GApply (f a -> GApply f a) -> f a -> GApply f a
    forall a b. (a -> b) -> a -> b
    $ (a -> a -> a) -> f a -> f a -> f a
    forall a b c. (a -> b -> c) -> f a -> f b -> f c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 a -> a -> a
    forall a. Semigroup a => a -> a -> a
    (SG.<>) f a
    x f a
    y

    instance (Applicative f, Monoid a) => Monoid (GApply f a) where
      mempty :: GApply f a
    mempty = f a -> GApply f a
    forall (f :: * -> *) a. f a -> GApply f a
    GApply (f a -> GApply f a) -> f a -> GApply f a
    forall a b. (a -> b) -> a -> b
    $ a -> f a
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    forall a. Monoid a => a
    mempty
      mappend :: GApply f a -> GApply f a -> GApply f a
    mappend (GApply f a
    x) (GApply f a
    y) = f a -> GApply f a
    forall (f :: * -> *) a. f a -> GApply f a
    GApply (f a -> GApply f a) -> f a -> GApply f a
    forall a b. (a -> b) -> a -> b
    $ (a -> a -> a) -> f a -> f a -> f a
    forall a b c. (a -> b -> c) -> f a -> f b -> f c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 a -> a -> a
    forall a. Semigroup a => a -> a -> a
    (MD.<>) f a
    x f a
    y

    instance (Eq1 f, Eq a) => Eq (GApply f a) where
      GApply f a
    a == :: GApply f a -> GApply f a -> Bool
    == GApply f a
    b = f a -> f a -> Bool
    forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
    eq1 f a
    a f a
    b

    instance (Show1 f, Show a) => Show (GApply f a) where
      showsPrec :: Int -> GApply f a -> ShowS
    showsPrec Int
    p = Int -> f a -> ShowS
    forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
    showsPrec1 Int
    p (f a -> ShowS) -> (GApply f a -> f a) -> GApply f a -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GApply f a -> f a
    forall (f :: * -> *) a. GApply f a -> f a
    getGApply

    instance (Arbitrary1 f, Arbitrary a) => Arbitrary (GApply f a) where
      arbitrary :: Gen (GApply f a)
    arbitrary = (f a -> GApply f a) -> Gen (f a) -> Gen (GApply f a)
    forall a b. (a -> b) -> Gen a -> Gen b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap f a -> GApply f a
    forall (f :: * -> *) a. f a -> GApply f a
    GApply Gen (f a)
    forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
    arbitrary1
      shrink :: GApply f a -> [GApply f a]
    shrink = (f a -> GApply f a) -> [f a] -> [GApply f a]
    forall a b. (a -> b) -> [a] -> [b]
    map f a -> GApply f a
    forall (f :: * -> *) a. f a -> GApply f a
    GApply ([f a] -> [GApply f a])
    -> (GApply f a -> [f a]) -> GApply f a -> [GApply f a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f a -> [f a]
    forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => f a -> [f a]
    shrink1 (f a -> [f a]) -> (GApply f a -> f a) -> GApply f a -> [f a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GApply f a -> f a
    forall (f :: * -> *) a. GApply f a -> f a
    getGApply

    toFromInverse1 :: forall proxy f. (Generic1 f, Eq1 f, Arbitrary1 f, Show1 f) => proxy f -> Property
    toFromInverse1 :: forall (proxy :: (* -> *) -> *) (f :: * -> *).
    (Generic1 f, Eq1 f, Arbitrary1 f, Show1 f) =>
    proxy f -> Property
    toFromInverse1 proxy f
    _ = (GApply f Integer -> Bool) -> Property
    forall prop. Testable prop => prop -> Property
    property ((GApply f Integer -> Bool) -> Property)
    -> (GApply f Integer -> Bool) -> Property
    forall a b. (a -> b) -> a -> b
    $ \(GApply (f Integer
    v :: f Integer)) -> f Integer -> f Integer -> Bool
    forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
    eq1 f Integer
    v (Rep1 f Integer -> f Integer
    forall a. Rep1 f a -> f a
    forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
    to1 (Rep1 f Integer -> f Integer)
    -> (f Integer -> Rep1 f Integer) -> f Integer -> f Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f Integer -> Rep1 f Integer
    forall a. f a -> Rep1 f a
    forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
    from1 (f Integer -> f Integer) -> f Integer -> f Integer
    forall a b. (a -> b) -> a -> b
    $ f Integer
    v)

    fromToInverse1 :: forall proxy f. (Generic1 f, Eq1 (Rep1 f), Arbitrary1 (Rep1 f), Show1 (Rep1 f)) => proxy f -> Property
    fromToInverse1 :: forall (proxy :: (* -> *) -> *) (f :: * -> *).
    (Generic1 f, Eq1 (Rep1 f), Arbitrary1 (Rep1 f), Show1 (Rep1 f)) =>
    proxy f -> Property
    fromToInverse1 proxy f
    _ = (GApply (Rep1 f) Integer -> Bool) -> Property
    forall prop. Testable prop => prop -> Property
    property ((GApply (Rep1 f) Integer -> Bool) -> Property)
    -> (GApply (Rep1 f) Integer -> Bool) -> Property
    forall a b. (a -> b) -> a -> b
    $ \(GApply (Rep1 f Integer
    r :: Rep1 f Integer)) -> Rep1 f Integer -> Rep1 f Integer -> Bool
    forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
    eq1 Rep1 f Integer
    r (f Integer -> Rep1 f Integer
    forall a. f a -> Rep1 f a
    forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
    from1 ((Rep1 f Integer -> f Integer
    forall a. Rep1 f a -> f a
    forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
    to1 (Rep1 f Integer -> f Integer) -> Rep1 f Integer -> f Integer
    forall a b. (a -> b) -> a -> b
    $ Rep1 f Integer
    r) :: f Integer))

    #endif

    #endif