Added All and Any monoids

`All` is a monoid build around `.&&.`. It is useful when writing
complex properties which check multiple conditions.  Since it is
a monoid it allows one to use `foldMap` which is often much more
ergonomic than using `conjoin`.

`All` satisfies `monoid` laws up to `isSuccess`, unless one is using
`checkCoverage` & `cover`.  I'd argue this is not a problem since
`checkCoverage` and `cover` are most often added at the top of the
property.

This patch also adds `Any` monoid build around `.||.`.

Tests are also included.

QuickCheck.cabal

@@ -105,6 +105,7 @@ library
     Test.QuickCheck.Gen,
     Test.QuickCheck.Gen.Unsafe,
     Test.QuickCheck.Monadic,
+    Test.QuickCheck.Monoids,
     Test.QuickCheck.Modifiers,
     Test.QuickCheck.Property,
     Test.QuickCheck.Test,
@@ -278,3 +279,10 @@ Test-Suite test-quickcheck-discard
     hs-source-dirs: tests
     main-is: DiscardRatio.hs
     build-depends: base, QuickCheck
+
+Test-Suite test-quickcheck-monoids
+    type: exitcode-stdio-1.0
+    Default-language: Haskell2010
+    hs-source-dirs: tests
+    main-is: Monoids.hs
+    build-depends: base, QuickCheck

src/Test/QuickCheck.hs

@@ -315,8 +315,10 @@ module Test.QuickCheck
   , (.&.)
   , (.&&.)
   , conjoin
+  , Every (..)
   , (.||.)
   , disjoin
+  , Some (..)
     -- ** What to do on failure
 #ifndef NO_TYPEABLE
   , Witness(..)
@@ -355,6 +357,7 @@ module Test.QuickCheck
 import Test.QuickCheck.Gen
 import Test.QuickCheck.Arbitrary
 import Test.QuickCheck.Modifiers
+import Test.QuickCheck.Monoids
 import Test.QuickCheck.Property hiding ( Result(..) )
 import Test.QuickCheck.Test
 import Test.QuickCheck.Exception

src/Test/QuickCheck/Monoids.hs

@@ -0,0 +1,54 @@
+{-# LANGUAGE ExistentialQuantification #-}
+
+module Test.QuickCheck.Monoids
+  ( Every (..)
+  , Some (..)
+  ) where
+
+import Data.List.NonEmpty as NonEmpty
+import Data.Semigroup (Semigroup (..))
+import Test.QuickCheck.Property
+
+-- | Conjunction monoid built with `.&&.`.
+--
+-- Use `property @Every` as an accessor which doesn't leak
+-- existential variables.
+--
+-- Note: monoid laws are satisfied up to `isSuccess` unless one is using
+-- `checkCoverage`.
+--
+data Every = forall p. Testable p => Every { getEvery :: p }
+
+instance Testable Every where
+    property (Every p) = property p
+
+instance Semigroup Every where
+    Every p <> Every p' = Every (p .&&. p')
+    sconcat = Every . conjoin . NonEmpty.toList
+
+instance Monoid Every where
+    mempty = Every True
+    mconcat = Every . conjoin
+
+
+-- | Disjunction monoid built with `.||.`.
+--
+-- Use `property @Some` as an accessor which doesn't leak
+-- existential variables.
+--
+-- Note: monoid laws are satisfied up to `isSuccess` unless one is using
+-- `checkCoverage`.
+--
+data Some = forall p. Testable p => Some { getSome :: p }
+
+instance Testable Some where
+    property (Some p) = property p
+
+instance Semigroup Some where
+    Some p <> Some p' = Some (p .||. p')
+    sconcat = Some . disjoin . NonEmpty.toList
+
+instance Monoid Some where
+    mempty = Some False
+    mconcat = Some . disjoin
+

tests/Monoids.hs

@@ -0,0 +1,118 @@
+{-# LANGUAGE TemplateHaskell  #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module Main (main) where
+
+import Data.List.NonEmpty
+import Data.Semigroup (Semigroup (..))
+
+import Test.QuickCheck
+
+instance Arbitrary Every where
+    arbitrary = oneof [ pure $ Every True
+                      , pure $ Every False
+                      , pure $ Every (counterexample "False" False)
+                      , pure $ Every (counterexample "True" True)
+                      , pure $ Every (ioProperty (return True))
+                      , pure $ Every (ioProperty (return False))
+                      , pure $ Every (checkCoverage $ cover 100 True "" True)
+                      , pure $ Every (checkCoverage $ cover 100 True "" False)
+                      , pure $ Every (checkCoverage $ cover 100 False "" False)
+                      ]
+
+
+instance Arbitrary Some where
+    arbitrary = oneof [ pure $ Some True
+                      , pure $ Some False
+                      , pure $ Some (counterexample "False" False)
+                      , pure $ Some (counterexample "True" True)
+                      , pure $ Some (ioProperty (return True))
+                      , pure $ Some (ioProperty (return False))
+                      , pure $ Some (checkCoverage $ cover 100 True  "" True)
+                      , pure $ Some (checkCoverage $ cover 100 True  "" False)
+                      , pure $ Some (checkCoverage $ cover 100 False "" True)
+                      , pure $ Some (checkCoverage $ cover 100 False "" False)
+                      ]
+
+
+newtype Fail a = Fail a
+
+instance Arbitrary (Fail Every) where
+    arbitrary = oneof [ Fail <$> (arbitrary :: Gen Every)
+                      , pure $ Fail $ Every (checkCoverage $ cover 100 False "" True)
+                      ]
+
+
+check_associative_law :: (Testable p, Semigroup p) => Blind p -> Blind p -> Blind p -> Property
+check_associative_law (Blind a) (Blind b) (Blind c) = ioProperty $ do
+    x <- isSuccess <$> quickCheckWithResult args (a <> (b <> c))
+    y <- isSuccess <$> quickCheckWithResult args ((a <> b) <> c)
+    return (x === y)
+
+
+check_unit_law :: (Testable p, Monoid p) => Blind p -> Property
+check_unit_law (Blind a) = ioProperty $ do
+    x <- isSuccess <$> quickCheckWithResult args (a <> mempty)
+    y <- isSuccess <$> quickCheckWithResult args (mempty <> a)
+    z <- isSuccess <$> quickCheckWithResult args a
+    return (x === y .&&. y === z)
+
+
+check_sconcat_law :: (Testable p, Semigroup p) => Blind p -> Blind p -> Property
+check_sconcat_law (Blind a) (Blind b) = ioProperty $ do
+    x <- isSuccess <$> quickCheckWithResult args (sconcat $ a :| [b])
+    y <- isSuccess <$> quickCheckWithResult args (a <> b)
+    return (x === y)
+
+
+check_mconcat_law :: (Testable p, Monoid p) => Blind p -> Blind p -> Property
+check_mconcat_law (Blind a) (Blind b) = ioProperty $ do
+    x <- isSuccess <$> quickCheckWithResult args (mconcat [a, b])
+    y <- isSuccess <$> quickCheckWithResult args (a <> b)
+    return (x === y)
+
+
+--
+-- Auxiliary definitions
+--
+
+args :: Args
+args = stdArgs { chatty = False, maxShrinks = 0 }
+
+--
+-- Properties
+--
+
+prop_every_associative :: Blind Every -> Blind Every -> Blind Every -> Property
+prop_every_associative = check_associative_law
+
+prop_every_unit :: Blind Every -> Property
+prop_every_unit = check_unit_law
+
+prop_every_unit_fail :: Blind (Fail Every) -> Property
+prop_every_unit_fail (Blind (Fail a)) =
+    expectFailure $ check_unit_law (Blind a)
+
+prop_every_sconcat_law :: Blind Every -> Blind Every -> Property
+prop_every_sconcat_law = check_sconcat_law
+
+prop_every_mconcat_law :: Blind Every -> Blind Every -> Property
+prop_every_mconcat_law = check_mconcat_law
+
+prop_some_associative :: Blind Some -> Blind Some -> Blind Some -> Property
+prop_some_associative = check_associative_law
+
+prop_some_unit :: Blind Some -> Property
+prop_some_unit = check_unit_law
+
+prop_some_sconcat_law :: Blind Some -> Blind Some -> Property
+prop_some_sconcat_law = check_sconcat_law
+
+prop_some_mconcat_law :: Blind Some -> Blind Some -> Property
+prop_some_mconcat_law = check_mconcat_law
+
+return []
+main = $quickCheckAll
+