{-# OPTIONS_GHC -Wall #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Test.QuickCheck.Utils
-- Copyright   :  (c) Andy Gill 2001
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  experimental
-- Portability :  portable
--
-- These are some general purpose utilities for use with QuickCheck.
--
-- Copied from QuickCheck 1.2.0.0.  Doesn't appear in 2.x
-----------------------------------------------------------------------------

module Test.QuickCheck.Utils
  ( isAssociativeBy
  , isAssociative
  , isCommutableBy
  , isCommutable
  , isTotalOrder
  ) where

import Prelude

import Test.QuickCheck

isAssociativeBy :: (Show a,Testable prop)
                => (a -> a -> prop) -> Gen a -> (a -> a -> a) -> Property
isAssociativeBy :: (a -> a -> prop) -> Gen a -> (a -> a -> a) -> Property
isAssociativeBy a -> a -> prop
(=~=) Gen a
src a -> a -> a
(#) =
        Gen a -> (a -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
src ((a -> Property) -> Property) -> (a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ a
a ->
        Gen a -> (a -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
src ((a -> Property) -> Property) -> (a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ a
b ->
        Gen a -> (a -> prop) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
src ((a -> prop) -> Property) -> (a -> prop) -> Property
forall a b. (a -> b) -> a -> b
$ \ a
c ->
        ((a
a a -> a -> a
# a
b) a -> a -> a
# a
c) a -> a -> prop
=~= (a
a a -> a -> a
# (a
b a -> a -> a
# a
c))

isAssociative :: (Arbitrary a,Show a,Eq a) => (a -> a -> a) -> Property
isAssociative :: (a -> a -> a) -> Property
isAssociative = (a -> a -> Bool) -> Gen a -> (a -> a -> a) -> Property
forall a prop.
(Show a, Testable prop) =>
(a -> a -> prop) -> Gen a -> (a -> a -> a) -> Property
isAssociativeBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) Gen a
forall a. Arbitrary a => Gen a
arbitrary

isCommutableBy :: (Show a,Testable prop)
               => (b -> b -> prop) -> Gen a -> (a -> a -> b) -> Property
isCommutableBy :: (b -> b -> prop) -> Gen a -> (a -> a -> b) -> Property
isCommutableBy b -> b -> prop
(=~=) Gen a
src a -> a -> b
(#) =
        Gen a -> (a -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
src ((a -> Property) -> Property) -> (a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ a
a ->
        Gen a -> (a -> prop) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
src ((a -> prop) -> Property) -> (a -> prop) -> Property
forall a b. (a -> b) -> a -> b
$ \ a
b ->
        (a
a a -> a -> b
# a
b) b -> b -> prop
=~= (a
b a -> a -> b
# a
a)

isCommutable :: (Arbitrary a,Show a,Eq b) => (a -> a -> b) -> Property
isCommutable :: (a -> a -> b) -> Property
isCommutable = (b -> b -> Bool) -> Gen a -> (a -> a -> b) -> Property
forall a prop b.
(Show a, Testable prop) =>
(b -> b -> prop) -> Gen a -> (a -> a -> b) -> Property
isCommutableBy b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==) Gen a
forall a. Arbitrary a => Gen a
arbitrary

isTotalOrder :: (Ord a) => a -> a -> Property
isTotalOrder :: a -> a -> Property
isTotalOrder a
x a
y =
    Bool -> String -> Property -> Property
forall prop. Testable prop => Bool -> String -> prop -> Property
classify (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y)  String
"less than" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    Bool -> String -> Property -> Property
forall prop. Testable prop => Bool -> String -> prop -> Property
classify (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y) String
"equals" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    Bool -> String -> Bool -> Property
forall prop. Testable prop => Bool -> String -> prop -> Property
classify (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y)  String
"greater than" (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$
    a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y Bool -> Bool -> Bool
|| a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y Bool -> Bool -> Bool
|| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y