{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Safe #-}

module Test.QuickCheck.Monoids
  ( Every (..)
  , Some (..)
  ) where

#ifndef NO_SEMIGROUP
import Data.List.NonEmpty as NonEmpty
import Data.Semigroup (Semigroup (..))
#else
import Data.Monoid (Monoid (..))
#endif
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 'Test.QuickCheck.isSuccess' unless one
-- is using `checkCoverage`.
--
#ifndef NO_EXISTENTIAL_FIELD_SELECTORS
data Every = forall p. Testable p => Every { ()
getEvery :: p }
#else
data Every = forall p. Testable p => Every p
#endif

instance Testable Every where
    property :: Every -> Property
property (Every p
p) = p -> Property
forall prop. Testable prop => prop -> Property
property p
p

#ifndef NO_SEMIGROUP
instance Semigroup Every where
    Every p
p <> :: Every -> Every -> Every
<> Every p
p' = Property -> Every
forall p. Testable p => p -> Every
Every (p
p p -> p -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. p
p')
    sconcat :: NonEmpty Every -> Every
sconcat = Property -> Every
forall p. Testable p => p -> Every
Every (Property -> Every)
-> (NonEmpty Every -> Property) -> NonEmpty Every -> Every
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Every] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin ([Every] -> Property)
-> (NonEmpty Every -> [Every]) -> NonEmpty Every -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Every -> [Every]
forall a. NonEmpty a -> [a]
NonEmpty.toList

instance Monoid Every where
    mempty :: Every
mempty = Bool -> Every
forall p. Testable p => p -> Every
Every Bool
True
    mappend :: Every -> Every -> Every
mappend = Every -> Every -> Every
forall a. Semigroup a => a -> a -> a
(<>)
    mconcat :: [Every] -> Every
mconcat = Property -> Every
forall p. Testable p => p -> Every
Every (Property -> Every) -> ([Every] -> Property) -> [Every] -> Every
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Every] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
#else
instance Monoid Every where
    mempty = Every True
    mappend (Every p) (Every p') = Every (p .&&. p')
    mconcat = Every . conjoin
#endif


-- | Disjunction monoid built with `.||.`.
--
-- Use `property @Some` as an accessor which doesn't leak
-- existential variables.
--
-- Note: monoid laws are satisfied up to 'Test.QuickCheck.isSuccess' unless one
-- is using `checkCoverage`.
--
#ifndef NO_EXISTENTIAL_FIELD_SELECTORS
data Some = forall p. Testable p => Some { ()
getSome :: p }
#else
data Some = forall p. Testable p => Some p
#endif

instance Testable Some where
    property :: Some -> Property
property (Some p
p) = p -> Property
forall prop. Testable prop => prop -> Property
property p
p

#ifndef NO_SEMIGROUP
instance Semigroup Some where
    Some p
p <> :: Some -> Some -> Some
<> Some p
p' = Property -> Some
forall p. Testable p => p -> Some
Some (p
p p -> p -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.||. p
p')
    sconcat :: NonEmpty Some -> Some
sconcat = Property -> Some
forall p. Testable p => p -> Some
Some (Property -> Some)
-> (NonEmpty Some -> Property) -> NonEmpty Some -> Some
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Some] -> Property
forall prop. Testable prop => [prop] -> Property
disjoin ([Some] -> Property)
-> (NonEmpty Some -> [Some]) -> NonEmpty Some -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Some -> [Some]
forall a. NonEmpty a -> [a]
NonEmpty.toList

instance Monoid Some where
    mempty :: Some
mempty = Bool -> Some
forall p. Testable p => p -> Some
Some Bool
False
    mappend :: Some -> Some -> Some
mappend = Some -> Some -> Some
forall a. Semigroup a => a -> a -> a
(<>)
    mconcat :: [Some] -> Some
mconcat = Property -> Some
forall p. Testable p => p -> Some
Some (Property -> Some) -> ([Some] -> Property) -> [Some] -> Some
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Some] -> Property
forall prop. Testable prop => [prop] -> Property
disjoin
#else
instance Monoid Some where
    mempty = Some False
    mappend (Some p) (Some p') = Some (p .||. p')
    mconcat = Some . disjoin
#endif