-- |
-- Module      : Test.LeanCheck.IO
-- Copyright   : (c) 2015-2020 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- This module is part of LeanCheck,
-- a simple enumerative property-based testing library.
--
-- QuickCheck-like interface to "Test.LeanCheck"
{-# LANGUAGE CPP #-}
module Test.LeanCheck.IO
  ( check
  , checkFor
  , checkResult
  , checkResultFor
  )
where

#if __GLASGOW_HASKELL__ <= 704
import Prelude hiding (catch)
#endif

import Test.LeanCheck.Core
#ifdef __GLASGOW_HASKELL__
import Control.Exception (SomeException, catch, evaluate)
#else
-- on Hugs
import Control.Exception (Exception, catch, evaluate)
type SomeException  =  Exception
#endif

-- | Checks a property printing results on 'System.IO.stdout'
--
-- > > check $ \xs -> sort (sort xs) == sort (xs::[Int])
-- > +++ OK, passed 200 tests.
--
-- > > check $ \xs ys -> xs `union` ys == ys `union` (xs::[Int])
-- > *** Failed! Falsifiable (after 4 tests):
-- > [] [0,0]
check :: Testable a => a -> IO ()
check :: forall a. Testable a => a -> IO ()
check a
p  =  forall a. Testable a => a -> IO Bool
checkResult a
p forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Check a property for a given number of tests
--   printing results on 'System.IO.stdout'
--
-- > > checkFor 1000 $ \xs -> sort (sort xs) == sort (xs::[Int])
-- > +++ OK, passed 1000 tests.
--
-- Test exhaustion is reported when the configured number of tests
-- is larger than the number of available test values:
--
-- > > checkFor 3 $ \p -> p == not (not p)
-- > +++ OK, passed 2 tests (exhausted).
checkFor :: Testable a => Int -> a -> IO ()
checkFor :: forall a. Testable a => Int -> a -> IO ()
checkFor Int
n a
p  =  forall a. Testable a => Int -> a -> IO Bool
checkResultFor Int
n a
p forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Check a property
--   printing results on 'System.IO.stdout' and
--   returning 'True' on success.
--
-- > > p <- checkResult $ \xs -> sort (sort xs) == sort (xs::[Int])
-- > +++ OK, passed 200 tests.
-- >
-- > > q <- checkResult $ \xs ys -> xs `union` ys == ys `union` (xs::[Int])
-- > *** Failed! Falsifiable (after 4 tests):
-- > [] [0,0]
-- >
-- > > p && q
-- > False
--
-- There is no option to silence this function:
-- for silence, you should use 'Test.LeanCheck.holds'.
checkResult :: Testable a => a -> IO Bool
checkResult :: forall a. Testable a => a -> IO Bool
checkResult  =  forall a. Testable a => Int -> a -> IO Bool
checkResultFor Int
200

-- | Check a property for a given number of tests
--   printing results on 'System.IO.stdout' and
--   returning 'True' on success.
--
-- > > checkResultFor 1000 $ \xs -> sort (sort xs) == sort (xs::[Int])
-- > +++ OK, passed 1000 tests.
-- > True
--
-- There is no option to silence this function:
-- for silence, you should use 'Test.LeanCheck.holds'.
checkResultFor :: Testable a => Int -> a -> IO Bool
checkResultFor :: forall a. Testable a => Int -> a -> IO Bool
checkResultFor Int
n a
p  =  do
  Result
r <- forall a. Testable a => Int -> a -> IO Result
resultIO Int
n a
p
  String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Result -> String
showResult Int
n forall a b. (a -> b) -> a -> b
$ Result
r
  forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> Bool
isOK Result
r)
  where
  isOK :: Result -> Bool
isOK (OK Int
_)  =  Bool
True
  isOK Result
_       =  Bool
False

data Result  =  OK        Int
             |  Falsified Int [String]
             |  Exception Int [String] String
  deriving (Result -> Result -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: Result -> Result -> Bool
Eq, Int -> Result -> ShowS
[Result] -> ShowS
Result -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result] -> ShowS
$cshowList :: [Result] -> ShowS
show :: Result -> String
$cshow :: Result -> String
showsPrec :: Int -> Result -> ShowS
$cshowsPrec :: Int -> Result -> ShowS
Show)

resultsIO :: Testable a => Int -> a -> [IO Result]
resultsIO :: forall a. Testable a => Int -> a -> [IO Result]
resultsIO Int
n  =  forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> ([String], Bool) -> IO Result
torio [Int
1..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Testable a => a -> [([String], Bool)]
results
  where
  tor :: Int -> ([String], Bool) -> Result
tor Int
i ([String]
_,Bool
True)  =  Int -> Result
OK Int
i
  tor Int
i ([String]
as,Bool
False)  =  Int -> [String] -> Result
Falsified Int
i [String]
as
  torio :: Int -> ([String], Bool) -> IO Result
torio Int
i r :: ([String], Bool)
r@([String]
as,Bool
_)  =  forall a. a -> IO a
evaluate (Int -> ([String], Bool) -> Result
tor Int
i ([String], Bool)
r)
     forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \SomeException
e -> let SomeException
_  =  SomeException
e :: SomeException
                   in forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> [String] -> String -> Result
Exception Int
i [String]
as (forall a. Show a => a -> String
show SomeException
e))

resultIO :: Testable a => Int -> a -> IO Result
resultIO :: forall a. Testable a => Int -> a -> IO Result
resultIO Int
n  =  forall {m :: * -> *}. Monad m => [m Result] -> m Result
computeResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Testable a => Int -> a -> [IO Result]
resultsIO Int
n
  where
  computeResult :: [m Result] -> m Result
computeResult []  =  forall a. HasCallStack => String -> a
error String
"resultIO: no results, empty Listable enumeration?"
  computeResult [m Result
r]  =  m Result
r
  computeResult (m Result
r:[m Result]
rs)  =  m Result
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Result
r -> case Result
r of
                                       (OK Int
_) -> [m Result] -> m Result
computeResult [m Result]
rs
                                       Result
_      -> forall (m :: * -> *) a. Monad m => a -> m a
return Result
r

showResult :: Int -> Result -> String
showResult :: Int -> Result -> String
showResult Int
m (OK Int
n)              =  String
"+++ OK, passed " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
" tests"
                                 forall a. [a] -> [a] -> [a]
++ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\Char
_ -> Int
n forall a. Ord a => a -> a -> Bool
< Int
m) String
" (exhausted)"
                                 forall a. [a] -> [a] -> [a]
++ String
"."
showResult Int
m (Falsified Int
i [String]
ce)    =  String
"*** Failed! Falsifiable (after "
                                 forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
" tests):\n" forall a. [a] -> [a] -> [a]
++ [String] -> String
joinArgs [String]
ce
showResult Int
m (Exception Int
i [String]
ce String
e)  =  String
"*** Failed! Exception '" forall a. [a] -> [a] -> [a]
++ String
e
                                 forall a. [a] -> [a] -> [a]
++ String
"' (after " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
" tests):\n"
                                 forall a. [a] -> [a] -> [a]
++ [String] -> String
joinArgs [String]
ce

-- joins the counter-example arguments
joinArgs :: [String] -> String
joinArgs :: [String] -> String
joinArgs [String]
ce | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char
'\n' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) [String]
ce  =  [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (ShowS
chopBreak forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
deparenf) [String]
ce
            | Bool
otherwise             =  [String] -> String
unwords [String]
ce

-- deparenthises a functional expression if it is parenthized
deparenf :: String -> String
deparenf :: ShowS
deparenf (Char
'(':Char
'\\':String
cs) | forall a. [a] -> a
last String
cs forall a. Eq a => a -> a -> Bool
== Char
')'  =  Char
'\\'forall a. a -> [a] -> [a]
:forall a. [a] -> [a]
init String
cs
deparenf String
cs                              =  String
cs

-- chops a line break at the end if there is any
chopBreak :: String -> String
chopBreak :: ShowS
chopBreak []      =  []
chopBreak [Char
'\n']  =  []
chopBreak (Char
x:String
xs)  =  Char
xforall a. a -> [a] -> [a]
:ShowS
chopBreak String
xs