-- |
-- Module      : Test.LeanCheck.IO
-- Copyright   : (c) 2015-2024 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

-- we redeclare void for backwards compatibility with old compilers
-- e.g.: hugs
void :: Functor f => f a -> f ()
void :: forall (f :: * -> *) a. Functor f => f a -> f ()
void  =  (a -> ()) -> f a -> f ()
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> a -> ()
forall a b. a -> b -> a
const ())

-- | 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  =  IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> (a -> IO Bool) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO Bool
forall a. Testable a => a -> IO Bool
checkResult

-- | 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  =  IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> (a -> IO Bool) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> IO Bool
forall a. Testable a => Int -> a -> IO Bool
checkResultFor Int
n

-- | 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  =  Int -> a -> IO Bool
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 <- Int -> a -> IO Result
forall a. Testable a => Int -> a -> IO Result
resultIO Int
n a
p
  String -> IO ()
putStrLn (String -> IO ()) -> (Result -> String) -> Result -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Result -> String
showResult Int
n (Result -> IO ()) -> Result -> IO ()
forall a b. (a -> b) -> a -> b
$ Result
r
  Bool -> IO Bool
forall a. a -> IO a
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
(Result -> Result -> Bool)
-> (Result -> Result -> Bool) -> Eq Result
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
/= :: Result -> Result -> Bool
Eq, Int -> Result -> ShowS
[Result] -> ShowS
Result -> String
(Int -> Result -> ShowS)
-> (Result -> String) -> ([Result] -> ShowS) -> Show Result
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Result -> ShowS
showsPrec :: Int -> Result -> ShowS
$cshow :: Result -> String
show :: Result -> String
$cshowList :: [Result] -> ShowS
showList :: [Result] -> ShowS
Show)

resultsIO :: Testable a => Int -> a -> [IO Result]
resultsIO :: forall a. Testable a => Int -> a -> [IO Result]
resultsIO Int
n  =  (Int -> ([String], Bool) -> IO Result)
-> [Int] -> [([String], Bool)] -> [IO Result]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> ([String], Bool) -> IO Result
torio [Int
1..] ([([String], Bool)] -> [IO Result])
-> (a -> [([String], Bool)]) -> a -> [IO Result]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [([String], Bool)] -> [([String], Bool)]
forall a. Int -> [a] -> [a]
take Int
n ([([String], Bool)] -> [([String], Bool)])
-> (a -> [([String], Bool)]) -> a -> [([String], Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [([String], Bool)]
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
_)  =  Result -> IO Result
forall a. a -> IO a
evaluate (Int -> ([String], Bool) -> Result
tor Int
i ([String], Bool)
r)
     IO Result -> (SomeException -> IO Result) -> IO Result
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \SomeException
e -> let SomeException
_  =  SomeException
e :: SomeException
                   in Result -> IO Result
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> [String] -> String -> Result
Exception Int
i [String]
as (SomeException -> String
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  =  [IO Result] -> IO Result
forall {m :: * -> *}. Monad m => [m Result] -> m Result
computeResult ([IO Result] -> IO Result) -> (a -> [IO Result]) -> a -> IO Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> [IO Result]
forall a. Testable a => Int -> a -> [IO Result]
resultsIO Int
n
  where
  computeResult :: [m Result] -> m Result
computeResult []  =  Result -> m Result
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> m Result) -> Result -> m Result
forall a b. (a -> b) -> a -> b
$ Int -> Result
OK Int
0  -- empty Listable enumeration
                                      -- no tests are reported as a "success"
  computeResult [m Result
r]  =  m Result
r
  computeResult (m Result
r:[m Result]
rs)  =  m Result
r m Result -> (Result -> m Result) -> m Result
forall a b. m a -> (a -> m b) -> m b
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
_      -> Result -> m Result
forall a. a -> m a
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 " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" tests"
                                 String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\Char
_ -> Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
m) String
" (exhausted)"
                                 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
showResult Int
m (Falsified Int
i [String]
ce)    =  String
"*** Failed! Falsifiable (after "
                                 String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" tests):\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
joinArgs [String]
ce
showResult Int
m (Exception Int
i [String]
ce String
e)  =  String
"*** Failed! Exception '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e
                                 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' (after " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" tests):\n"
                                 String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
joinArgs [String]
ce

-- joins the counter-example arguments
joinArgs :: [String] -> String
joinArgs :: [String] -> String
joinArgs [String]
ce | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char
'\n' Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) [String]
ce  =  [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS
chopBreak ShowS -> ShowS -> ShowS
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) | String -> Char
forall a. HasCallStack => [a] -> a
last String
cs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')'  =  Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
forall a. HasCallStack => [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
xChar -> ShowS
forall a. a -> [a] -> [a]
:ShowS
chopBreak String
xs