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
data Equation a = (:=:) a a
deriving (Eq, Ord, Show)
infix 5 :=:
instance TestEq a => Testable (Equation a) where
property (a :=: b) = a =? b
instance TestEq a => Testable' (Equation a) where
property' = property
instance Eq a => Decidable (Equation a) where
decide (a :=: b) = a == b
data Implication a b = (:==>) a b
infixr 2 :==>
type EqImpl a b = Implication (Equation a) (Equation b)
instance (Decidable a, Testable b) => Testable (Implication a b) where
property (a :==> b) = decide a ==> b
instance (Decidable a, Testable' b) => Testable' (Implication a b) where
property' (a :==> b) = decide a ==> property' b
class Decidable a where
decide :: a -> Bool
quickCheck' :: Testable' prop => prop -> IO ()
quickCheck' = quickCheck . property'
quickCheckWith' :: Testable' prop => Args -> prop -> IO ()
quickCheckWith' args = quickCheckWith args . property'
ok :: Testable' prop => String -> prop -> (String, Property)
ok s prop = (s, property' prop)
ko :: Testable' prop => String -> prop -> (String, Property)
ko s = ok s . expectFailure . property'
quickChecks :: [(String, Property)] -> IO Bool
quickChecks ps =
fmap and . for ps $ \(name, p) -> do
putStrLn ("=== " ++ name ++ " ===")
r <- quickCheckResult p
putStrLn ""
return $ case r of
Success{} -> True
Failure{} -> False
NoExpectedFailure{} -> False
GaveUp{} -> False
instance Decidable Bool where
decide = id