-- | An alternative to Testable

module Test.QuickCheck.HigherOrder.Internal.Testable where

import Data.Traversable (for)
import Test.QuickCheck

import Test.QuickCheck.HigherOrder.Internal.Testable.Class
import Test.QuickCheck.HigherOrder.Internal.TestEq


-- * Syntax for properties


-- | Equation: an equals sign between two values.
data Equation a = (:=:) a a
  deriving (Equation a -> Equation a -> Bool
(Equation a -> Equation a -> Bool)
-> (Equation a -> Equation a -> Bool) -> Eq (Equation a)
forall a. Eq a => Equation a -> Equation a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Equation a -> Equation a -> Bool
$c/= :: forall a. Eq a => Equation a -> Equation a -> Bool
== :: Equation a -> Equation a -> Bool
$c== :: forall a. Eq a => Equation a -> Equation a -> Bool
Eq, Eq (Equation a)
Eq (Equation a)
-> (Equation a -> Equation a -> Ordering)
-> (Equation a -> Equation a -> Bool)
-> (Equation a -> Equation a -> Bool)
-> (Equation a -> Equation a -> Bool)
-> (Equation a -> Equation a -> Bool)
-> (Equation a -> Equation a -> Equation a)
-> (Equation a -> Equation a -> Equation a)
-> Ord (Equation a)
Equation a -> Equation a -> Bool
Equation a -> Equation a -> Ordering
Equation a -> Equation a -> Equation a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Equation a)
forall a. Ord a => Equation a -> Equation a -> Bool
forall a. Ord a => Equation a -> Equation a -> Ordering
forall a. Ord a => Equation a -> Equation a -> Equation a
min :: Equation a -> Equation a -> Equation a
$cmin :: forall a. Ord a => Equation a -> Equation a -> Equation a
max :: Equation a -> Equation a -> Equation a
$cmax :: forall a. Ord a => Equation a -> Equation a -> Equation a
>= :: Equation a -> Equation a -> Bool
$c>= :: forall a. Ord a => Equation a -> Equation a -> Bool
> :: Equation a -> Equation a -> Bool
$c> :: forall a. Ord a => Equation a -> Equation a -> Bool
<= :: Equation a -> Equation a -> Bool
$c<= :: forall a. Ord a => Equation a -> Equation a -> Bool
< :: Equation a -> Equation a -> Bool
$c< :: forall a. Ord a => Equation a -> Equation a -> Bool
compare :: Equation a -> Equation a -> Ordering
$ccompare :: forall a. Ord a => Equation a -> Equation a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Equation a)
Ord, Int -> Equation a -> ShowS
[Equation a] -> ShowS
Equation a -> String
(Int -> Equation a -> ShowS)
-> (Equation a -> String)
-> ([Equation a] -> ShowS)
-> Show (Equation a)
forall a. Show a => Int -> Equation a -> ShowS
forall a. Show a => [Equation a] -> ShowS
forall a. Show a => Equation a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Equation a] -> ShowS
$cshowList :: forall a. Show a => [Equation a] -> ShowS
show :: Equation a -> String
$cshow :: forall a. Show a => Equation a -> String
showsPrec :: Int -> Equation a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Equation a -> ShowS
Show)

infix 5 :=:

instance TestEq a => Testable (Equation a) where
  property :: Equation a -> Property
property (a
a :=: a
b) = a
a a -> a -> Property
forall a. TestEq a => a -> a -> Property
=? a
b

instance TestEq a => Testable' (Equation a) where
  property' :: Equation a -> Property
property' = Equation a -> Property
forall prop. Testable prop => prop -> Property
property  -- the one defined just up there

instance Eq a => Decidable (Equation a) where
  decide :: Equation a -> Bool
decide (a
a :=: a
b) = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b


-- | Expressions denoting a logical implication.
data Implication a b = (:==>) a b

infixr 2 :==>

-- | Implication between two equations.
type EqImpl a b = Implication (Equation a) (Equation b)

-- | Just use @('==>')@.
instance (Decidable a, Testable b) => Testable (Implication a b) where
  property :: Implication a b -> Property
property (a
a :==> b
b) = a -> Bool
forall a. Decidable a => a -> Bool
decide a
a Bool -> b -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> b
b

-- | Just use @('==>')@.
instance (Decidable a, Testable' b) => Testable' (Implication a b) where
  property' :: Implication a b -> Property
property' (a
a :==> b
b) = a -> Bool
forall a. Decidable a => a -> Bool
decide a
a Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> b -> Property
forall prop. Testable' prop => prop -> Property
property' b
b


-- | Decidable property.
class Decidable a where
  -- | The definition of decidability: we can compute whether a property is
  -- true.
  decide :: a -> Bool


-- * Auxiliary functions

-- | Variant of 'quickCheck' using the alternative 'Testable''.
quickCheck' :: Testable' prop => prop -> IO ()
quickCheck' :: prop -> IO ()
quickCheck' = Property -> IO ()
forall prop. Testable prop => prop -> IO ()
quickCheck (Property -> IO ()) -> (prop -> Property) -> prop -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. prop -> Property
forall prop. Testable' prop => prop -> Property
property'

-- | Variant of 'quickCheckWith' using the alternative 'Testable''.
quickCheckWith' :: Testable' prop => Args -> prop -> IO ()
quickCheckWith' :: Args -> prop -> IO ()
quickCheckWith' Args
args = Args -> Property -> IO ()
forall prop. Testable prop => Args -> prop -> IO ()
quickCheckWith Args
args (Property -> IO ()) -> (prop -> Property) -> prop -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. prop -> Property
forall prop. Testable' prop => prop -> Property
property'

-- | A named property that should __pass__.
--
-- Use 'ok' and 'ko' to construct lists of named properties
-- @[('String', 'Property')]@, which can be run using 'quickChecks',
-- or @testProperties@ from tasty-quickcheck.
ok :: Testable' prop => String -> prop -> (String, Property)
ok :: String -> prop -> (String, Property)
ok String
s prop
prop = (String
s, prop -> Property
forall prop. Testable' prop => prop -> Property
property' prop
prop)

-- | A named property that should __fail__.
--
-- See also 'ok'.
ko :: Testable' prop => String -> prop -> (String, Property)
ko :: String -> prop -> (String, Property)
ko String
s = String -> Property -> (String, Property)
forall prop. Testable' prop => String -> prop -> (String, Property)
ok String
s (Property -> (String, Property))
-> (prop -> Property) -> prop -> (String, Property)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> Property
forall prop. Testable prop => prop -> Property
expectFailure (Property -> Property) -> (prop -> Property) -> prop -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. prop -> Property
forall prop. Testable' prop => prop -> Property
property'

-- | Execute a list of named properties.
quickChecks :: [(String, Property)] -> IO Bool
quickChecks :: [(String, Property)] -> IO Bool
quickChecks [(String, Property)]
ps =
  ([Bool] -> Bool) -> IO [Bool] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (IO [Bool] -> IO Bool)
-> (((String, Property) -> IO Bool) -> IO [Bool])
-> ((String, Property) -> IO Bool)
-> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, Property)]
-> ((String, Property) -> IO Bool) -> IO [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(String, Property)]
ps (((String, Property) -> IO Bool) -> IO Bool)
-> ((String, Property) -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \(String
name, Property
p) -> do
    String -> IO ()
putStrLn (String
"=== " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ===")
    Result
r <- Property -> IO Result
forall prop. Testable prop => prop -> IO Result
quickCheckResult Property
p
    String -> IO ()
putStrLn String
""
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ case Result
r of
      Success{} -> Bool
True
      Failure{} -> Bool
False
      NoExpectedFailure{} -> Bool
False
      GaveUp{} -> Bool
False

-- Decidable instances

instance Decidable Bool where
  decide :: Bool -> Bool
decide = Bool -> Bool
forall a. a -> a
id