content: -- |
  -- 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  =  fmap (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  =  void . 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 n  =  void . checkResultFor 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  =  checkResultFor 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 n p  =  do
    r <- resultIO n p
    putStrLn . showResult n $ r
    return (isOK r)
    where
    isOK (OK _)  =  True
    isOK _       =  False
  
  data Result  =  OK        Int
               |  Falsified Int [String]
               |  Exception Int [String] String
    deriving (Eq, Show)
  
  resultsIO :: Testable a => Int -> a -> [IO Result]
  resultsIO n  =  zipWith torio [1..] . take n . results
    where
    tor i (_,True)  =  OK i
    tor i (as,False)  =  Falsified i as
    torio i r@(as,_)  =  evaluate (tor i r)
       `catch` \e -> let _  =  e :: SomeException
                     in return (Exception i as (show e))
  
  resultIO :: Testable a => Int -> a -> IO Result
  resultIO n  =  computeResult . resultsIO n
    where
    computeResult []  =  return $ OK 0  -- empty Listable enumeration
                                        -- no tests are reported as a "success"
    computeResult [r]  =  r
    computeResult (r:rs)  =  r >>= \r -> case r of
                                         (OK _) -> computeResult rs
                                         _      -> return r
  
  showResult :: Int -> Result -> String
  showResult m (OK n)              =  "+++ OK, passed " ++ show n ++ " tests"
                                   ++ takeWhile (\_ -> n < m) " (exhausted)"
                                   ++ "."
  showResult m (Falsified i ce)    =  "*** Failed! Falsifiable (after "
                                   ++ show i ++ " tests):\n" ++ joinArgs ce
  showResult m (Exception i ce e)  =  "*** Failed! Exception '" ++ e
                                   ++ "' (after " ++ show i ++ " tests):\n"
                                   ++ joinArgs ce
  
  -- joins the counter-example arguments
  joinArgs :: [String] -> String
  joinArgs ce | any ('\n' `elem`) ce  =  unlines $ map (chopBreak . deparenf) ce
              | otherwise             =  unwords ce
  
  -- deparenthises a functional expression if it is parenthized
  deparenf :: String -> String
  deparenf ('(':'\\':cs) | last cs == ')'  =  '\\':init cs
  deparenf cs                              =  cs
  
  -- chops a line break at the end if there is any
  chopBreak :: String -> String
  chopBreak []      =  []
  chopBreak ['\n']  =  []
  chopBreak (x:xs)  =  x:chopBreak xs
  