    {-# LANGUAGE CPP #-}
    {-# LANGUAGE KindSignatures #-}

    {-# OPTIONS_GHC -Wall #-}

    {-| This library provides sets of properties that should hold for common
        typeclasses.

        /Note:/ on GHC < 8.6, this library uses the higher-kinded typeclasses
        ('Data.Functor.Classes.Show1', 'Data.Functor.Classes.Eq1', 'Data.Functor.Classes.Ord1', etc.),
        but on GHC >= 8.6, it uses @-XQuantifiedConstraints@ to express these
        constraints more cleanly.
    -}
    module Test.QuickCheck.Classes.Base
      ( -- * Running
        lawsCheck
      , lawsCheckMany
      , lawsCheckOne
        -- * Properties
        -- ** Ground types
    #if MIN_VERSION_base(4,7,0)
      , bitsLaws
    #endif
      , eqLaws
      , substitutiveEqLaws
      , numLaws
      , integralLaws
      , ixLaws
    #if MIN_VERSION_base(4,7,0)
      , isListLaws
    #endif
      , monoidLaws
      , commutativeMonoidLaws
      , semigroupMonoidLaws
      , ordLaws
      , enumLaws
      , boundedEnumLaws
      , semigroupLaws
      , commutativeSemigroupLaws
      , exponentialSemigroupLaws
      , idempotentSemigroupLaws
      , rectangularBandSemigroupLaws
      , showLaws
      , showReadLaws
      , storableLaws
    #if MIN_VERSION_base(4,5,0)
      , genericLaws
      , generic1Laws
    #endif
    #if HAVE_UNARY_LAWS
        -- ** Unary type constructors
      , alternativeLaws
      , applicativeLaws
      , contravariantLaws
      , foldableLaws
      , functorLaws
      , monadLaws
      , monadPlusLaws
      , monadZipLaws
      , traversableLaws
    #endif
    #if HAVE_BINARY_LAWS
        -- ** Binary type constructors
      , bifoldableLaws
      , bifunctorLaws
      , bitraversableLaws
      , categoryLaws
      , commutativeCategoryLaws
    #endif
        -- * Types
      , Laws(..)
      , Proxy1(..)
      , Proxy2(..)
      ) where

    --
    -- re-exports
    --

    -- Ground Types
    import Test.QuickCheck.Classes.Bits
    import Test.QuickCheck.Classes.Enum
    import Test.QuickCheck.Classes.Eq
    import Test.QuickCheck.Classes.Num
    import Test.QuickCheck.Classes.Integral
    import Test.QuickCheck.Classes.Ix
    #if MIN_VERSION_base(4,7,0)
    import Test.QuickCheck.Classes.Base.IsList
    #endif
    import Test.QuickCheck.Classes.Monoid
    import Test.QuickCheck.Classes.Ord
    import Test.QuickCheck.Classes.Semigroup
    import Test.QuickCheck.Classes.Show
    import Test.QuickCheck.Classes.ShowRead
    import Test.QuickCheck.Classes.Storable
    #if MIN_VERSION_base(4,5,0)
    import Test.QuickCheck.Classes.Generic
    #endif
    -- Unary type constructors
    #if HAVE_UNARY_LAWS
    import Test.QuickCheck.Classes.Alternative
    import Test.QuickCheck.Classes.Applicative
    import Test.QuickCheck.Classes.Contravariant
    import Test.QuickCheck.Classes.Foldable
    import Test.QuickCheck.Classes.Functor
    import Test.QuickCheck.Classes.Monad
    import Test.QuickCheck.Classes.MonadPlus
    import Test.QuickCheck.Classes.MonadZip
    import Test.QuickCheck.Classes.Traversable
    #endif

    -- Binary type constructors
    #if HAVE_BINARY_LAWS
    import Test.QuickCheck.Classes.Bifunctor
    import Test.QuickCheck.Classes.Bifoldable
    import Test.QuickCheck.Classes.Bitraversable
    import Test.QuickCheck.Classes.Category
    #if HAVE_SEMIGROUPOIDS
    import Test.QuickCheck.Classes.Semigroupoid
    #endif
    #endif

    --
    -- used below
    --
    import Test.QuickCheck
    import Test.QuickCheck.Classes.Internal (foldMapA, Laws(..))
    import Control.Monad
    import Data.Foldable
    import Data.Monoid (Monoid(..))
    import Data.Proxy (Proxy(..))
    import Data.Semigroup (Semigroup)
    import System.Exit (exitFailure)
    import qualified Data.List as List
    import qualified Data.Semigroup as SG

    -- | A convenience function for testing properties in GHCi.
    -- For example, at GHCi:
    --
    -- >>> lawsCheck (monoidLaws (Proxy :: Proxy Ordering))
    -- Monoid: Associative +++ OK, passed 100 tests.
    -- Monoid: Left Identity +++ OK, passed 100 tests.
    -- Monoid: Right Identity +++ OK, passed 100 tests.
    --
    -- Assuming that the 'Arbitrary' instance for 'Ordering' is good, we now
    -- have confidence that the 'Monoid' instance for 'Ordering' satisfies
    -- the monoid laws.
    lawsCheck :: Laws -> IO ()
    lawsCheck :: Laws -> IO ()
    lawsCheck (Laws String
    className [(String, Property)]
    properties) = do
      (((String, Property) -> IO ()) -> [(String, Property)] -> IO ())
    -> [(String, Property)] -> ((String, Property) -> IO ()) -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((String, Property) -> IO ()) -> [(String, Property)] -> IO ()
    forall (t :: * -> *) m (f :: * -> *) a.
    (Foldable t, Monoid m, Semigroup m, Applicative f) =>
    (a -> f m) -> t a -> f m
    foldMapA [(String, Property)]
    properties (((String, Property) -> IO ()) -> IO ())
    -> ((String, Property) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(String
    name,Property
    p) -> do
        String -> IO ()
    putStr (String
    className String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ": " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " ")
        Property -> IO ()
    forall prop. Testable prop => prop -> IO ()
    quickCheck Property
    p

    -- | A convenience function that allows one to check many typeclass
    -- instances of the same type.
    --
    -- >>> specialisedLawsCheckMany (Proxy :: Proxy Word) [jsonLaws, showReadLaws]
    -- ToJSON/FromJSON: Encoding Equals Value +++ OK, passed 100 tests.
    -- ToJSON/FromJSON: Partial Isomorphism +++ OK, passed 100 tests.
    -- Show/Read: Partial Isomorphism +++ OK, passed 100 tests.
    lawsCheckOne :: Proxy a -> [Proxy a -> Laws] -> IO ()
    lawsCheckOne :: forall a. Proxy a -> [Proxy a -> Laws] -> IO ()
    lawsCheckOne Proxy a
    p [Proxy a -> Laws]
    ls = ((Proxy a -> Laws) -> IO ()) -> [Proxy a -> Laws] -> IO ()
    forall (t :: * -> *) b (m :: * -> *) a.
    (Foldable t, Monoid b, Monad m) =>
    (a -> m b) -> t a -> m b
    foldlMapM (Laws -> IO ()
    lawsCheck (Laws -> IO ())
    -> ((Proxy a -> Laws) -> Laws) -> (Proxy a -> Laws) -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Proxy a -> Laws) -> Proxy a -> Laws
    forall a b. (a -> b) -> a -> b
    $ Proxy a
    p)) [Proxy a -> Laws]
    ls

    -- | A convenience function for checking multiple typeclass instances
    --   of multiple types. Consider the following Haskell source file:
    --
    -- @
    -- import Data.Proxy (Proxy(..))
    -- import Data.Map (Map)
    -- import Data.Set (Set)
    --
    -- -- A 'Proxy' for 'Set' 'Int'.
    -- setInt :: Proxy (Set Int)
    -- setInt = Proxy
    --
    -- -- A 'Proxy' for 'Map' 'Int' 'Int'.
    -- mapInt :: Proxy (Map Int Int)
    -- mapInt = Proxy
    --
    -- myLaws :: Proxy a -> [Laws]
    -- myLaws p = [eqLaws p, monoidLaws p]
    --
    -- namedTests :: [(String, [Laws])]
    -- namedTests =
    --   [ ("Set Int", myLaws setInt)
    --   , ("Map Int Int", myLaws mapInt)
    --   ]
    -- @
    --
    -- Now, in GHCi:
    --
    -- >>> lawsCheckMany namedTests
    --
    -- @
    -- Testing properties for common typeclasses
    -- -------------
    -- -- Set Int --
    -- -------------
    --
    -- Eq: Transitive +++ OK, passed 100 tests.
    -- Eq: Symmetric +++ OK, passed 100 tests.
    -- Eq: Reflexive +++ OK, passed 100 tests.
    -- Monoid: Associative +++ OK, passed 100 tests.
    -- Monoid: Left Identity +++ OK, passed 100 tests.
    -- Monoid: Right Identity +++ OK, passed 100 tests.
    -- Monoid: Concatenation +++ OK, passed 100 tests.
    --
    -- -----------------
    -- -- Map Int Int --
    -- -----------------
    --
    -- Eq: Transitive +++ OK, passed 100 tests.
    -- Eq: Symmetric +++ OK, passed 100 tests.
    -- Eq: Reflexive +++ OK, passed 100 tests.
    -- Monoid: Associative +++ OK, passed 100 tests.
    -- Monoid: Left Identity +++ OK, passed 100 tests.
    -- Monoid: Right Identity +++ OK, passed 100 tests.
    -- Monoid: Concatenation +++ OK, passed 100 tests.
    -- @
    --
    -- In the case of a failing test, the program terminates with
    -- exit code 1.
    lawsCheckMany ::
         [(String,[Laws])] -- ^ Element is type name paired with typeclass laws
      -> IO ()
    lawsCheckMany :: [(String, [Laws])] -> IO ()
    lawsCheckMany [(String, [Laws])]
    xs = do
      String -> IO ()
    putStrLn String
    "Testing properties for common typeclasses"
      r <- (((String, [Laws]) -> IO Status)
     -> [(String, [Laws])] -> IO Status)
    -> [(String, [Laws])]
    -> ((String, [Laws]) -> IO Status)
    -> IO Status
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((String, [Laws]) -> IO Status) -> [(String, [Laws])] -> IO Status
    forall (t :: * -> *) m (f :: * -> *) a.
    (Foldable t, Monoid m, Semigroup m, Applicative f) =>
    (a -> f m) -> t a -> f m
    foldMapA [(String, [Laws])]
    xs (((String, [Laws]) -> IO Status) -> IO Status)
    -> ((String, [Laws]) -> IO Status) -> IO Status
    forall a b. (a -> b) -> a -> b
    $ \(String
    typeName,[Laws]
    laws) -> do
        String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Char -> String
    forall a. Int -> a -> [a]
    List.replicate (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    typeName Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    6) Char
    '-'
        String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "-- " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    typeName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " --"
        String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Char -> String
    forall a. Int -> a -> [a]
    List.replicate (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    typeName Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    6) Char
    '-'
        ((Laws -> IO Status) -> [Laws] -> IO Status)
    -> [Laws] -> (Laws -> IO Status) -> IO Status
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Laws -> IO Status) -> [Laws] -> IO Status
    forall (t :: * -> *) m (f :: * -> *) a.
    (Foldable t, Monoid m, Semigroup m, Applicative f) =>
    (a -> f m) -> t a -> f m
    foldMapA [Laws]
    laws ((Laws -> IO Status) -> IO Status)
    -> (Laws -> IO Status) -> IO Status
    forall a b. (a -> b) -> a -> b
    $ \(Laws String
    typeClassName [(String, Property)]
    properties) -> do
          (((String, Property) -> IO Status)
     -> [(String, Property)] -> IO Status)
    -> [(String, Property)]
    -> ((String, Property) -> IO Status)
    -> IO Status
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((String, Property) -> IO Status)
    -> [(String, Property)] -> IO Status
    forall (t :: * -> *) m (f :: * -> *) a.
    (Foldable t, Monoid m, Semigroup m, Applicative f) =>
    (a -> f m) -> t a -> f m
    foldMapA [(String, Property)]
    properties (((String, Property) -> IO Status) -> IO Status)
    -> ((String, Property) -> IO Status) -> IO Status
    forall a b. (a -> b) -> a -> b
    $ \(String
    name,Property
    p) -> do
            String -> IO ()
    putStr (String
    typeClassName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ": " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " ")
            r <- Property -> IO Result
    forall prop. Testable prop => prop -> IO Result
    quickCheckResult Property
    p
            return $ case r of
              Success{} -> Status
    Good
              Result
    _ -> Status
    Bad
      putStrLn ""
      case r of
        Status
    Good -> String -> IO ()
    putStrLn String
    "All tests succeeded"
        Status
    Bad -> do
          String -> IO ()
    putStrLn String
    "One or more tests failed"
          IO ()
    forall a. IO a
    exitFailure

    data Status = Bad | Good

    instance Semigroup Status where
      Status
    Good <> :: Status -> Status -> Status
    <> Status
    x = Status
    x
      Status
    Bad <> Status
    _ = Status
    Bad

    instance Monoid Status where
      mempty :: Status
    mempty = Status
    Good
      mappend :: Status -> Status -> Status
    mappend = Status -> Status -> Status
    forall a. Semigroup a => a -> a -> a
    (SG.<>)

    -- | In older versions of GHC, Proxy is not poly-kinded,
    --   so we provide Proxy1.
    data Proxy1 (f :: * -> *) = Proxy1

    -- | In older versions of GHC, Proxy is not poly-kinded,
    --   so we provide Proxy2.
    data Proxy2 (f :: * -> * -> *) = Proxy2

    -- This is used internally to work around a missing Monoid
    -- instance for IO on older GHCs.
    foldlMapM :: (Foldable t, Monoid b, Monad m) => (a -> m b) -> t a -> m b
    foldlMapM :: forall (t :: * -> *) b (m :: * -> *) a.
    (Foldable t, Monoid b, Monad m) =>
    (a -> m b) -> t a -> m b
    foldlMapM a -> m b
    f = (b -> a -> m b) -> b -> t a -> m b
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldlM (\b
    b a
    a -> (b -> b) -> m b -> m b
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (b -> b -> b
    forall a. Monoid a => a -> a -> a
    mappend b
    b) (a -> m b
    f a
    a)) b
    forall a. Monoid a => a
    mempty