-- |
-- Module      : Test.LeanCheck.Error
-- 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.
--
-- This module re-exports "Test.LeanCheck" but some test functions have been
-- specialized to catch errors (see the explicit export list below).
--
-- This module is unsafe as it uses `unsafePerformIO` to catch errors.
{-# LANGUAGE CPP #-}
module Test.LeanCheck.Error
  ( holds
  , fails
  , exists
  , counterExample
  , counterExamples
  , witness
  , witnesses
  , results

  , fromError
  , errorToNothing
  , errorToFalse
  , errorToTrue
  , errorToLeft
  , anyErrorToNothing
  , anyErrorToLeft
  , (?==?)
  , (!==!)

  , module Test.LeanCheck
  )
where

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

import Test.LeanCheck hiding
  ( holds
  , fails
  , exists
  , counterExample
  , counterExamples
  , witness
  , witnesses
  , results
  )

import qualified Test.LeanCheck as C
  ( holds
  , fails
  , results
  )

import Control.Monad (liftM)
import System.IO.Unsafe (unsafePerformIO)
import Data.Maybe (listToMaybe, fromMaybe)
import Data.Function (on)
import Control.Exception ( evaluate
                         , catch
#if __GLASGOW_HASKELL__
                         , SomeException
                         , ArithException
                         , ArrayException
                         , ErrorCall
                         , PatternMatchFail
                         , catches
                         , Handler (Handler)
#endif
                         )

etom :: Either b a -> Maybe a
etom :: forall b a. Either b a -> Maybe a
etom (Right a
x)  =  forall a. a -> Maybe a
Just a
x
etom (Left b
_)   =  forall a. Maybe a
Nothing

-- | Transforms a value into 'Just' that value or 'Nothing' on some errors:
--
--   * ArithException
--   * ArrayException
--   * ErrorCall
--   * PatternMatchFail
--
-- > > errorToNothing False
-- > Just False
--
-- > > errorToNothing (0 :: Int)
-- > Just 0
--
-- > > errorToNothing (undefined :: ())
-- > Nothing
--
-- This function uses 'unsafePerformIO'.
errorToNothing :: a -> Maybe a
errorToNothing :: forall a. a -> Maybe a
errorToNothing  =  forall b a. Either b a -> Maybe a
etom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Either String a
errorToLeft

-- | Transforms a value into 'Just' that value or 'Nothing' on error.
anyErrorToNothing :: a -> Maybe a
anyErrorToNothing :: forall a. a -> Maybe a
anyErrorToNothing  =  forall b a. Either b a -> Maybe a
etom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Either String a
anyErrorToLeft

-- | Transforms a value into 'Right' that value or 'Left String' on some errors:
--
--   * ArithException
--   * ArrayException
--   * ErrorCall
--   * PatternMatchFail
--
-- > > errorToLeft False
-- > Just False
--
-- > > errorToLeft (0 :: Int)
-- > Just 0
--
-- > > errorToLeft (undefined :: ())
-- > Left "Prelude.undefined"
--
-- > > errorToLeft (error "error message")
-- > Left "error message"
--
-- > > errorToLeft (1 `div` 0 :: Int)
-- > Left "divide by zero"
--
-- Only the first line of the error's string representation is included.
--
-- This function uses 'unsafePerformIO'.
errorToLeft :: a -> Either String a
errorToLeft :: forall a. a -> Either String a
errorToLeft a
x  =  forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
#if __GLASGOW_HASKELL__
  (forall a b. b -> Either a b
Right forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall a. a -> IO a
evaluate a
x) forall a. IO a -> [Handler a] -> IO a
`catches`
    [ forall a e. Exception e => (e -> IO a) -> Handler a
Handler forall a b. (a -> b) -> a -> b
$ \ArithException
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show1st (ArithException
e :: ArithException)
    , forall a e. Exception e => (e -> IO a) -> Handler a
Handler forall a b. (a -> b) -> a -> b
$ \ArrayException
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show1st (ArrayException
e :: ArrayException)
    , forall a e. Exception e => (e -> IO a) -> Handler a
Handler forall a b. (a -> b) -> a -> b
$ \ErrorCall
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show1st (ErrorCall
e :: ErrorCall)
    , forall a e. Exception e => (e -> IO a) -> Handler a
Handler forall a b. (a -> b) -> a -> b
$ \PatternMatchFail
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show1st (PatternMatchFail
e :: PatternMatchFail)
    ]
#else
  (Right `liftM` evaluate x) `catch` (return . Left . show1st)
#endif

-- | Transforms a value into 'Right' that value or 'Left String' on error.
--
-- Only the first line of the error's string representation is included.
--
-- This function uses 'unsafePerformIO'.  See: 'errorToLeft'.
anyErrorToLeft :: a -> Either String a
anyErrorToLeft :: forall a. a -> Either String a
anyErrorToLeft a
x  =  forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
#if __GLASGOW_HASKELL__
  (forall a b. b -> Either a b
Right forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall a. a -> IO a
evaluate a
x)
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\SomeException
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show1st (SomeException
e :: SomeException))
#else
  (Right `liftM` evaluate x) `catch` (return . Left . show1st)
#endif

show1st :: Show a => a -> String
show1st :: forall a. Show a => a -> String
show1st  =  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

-- | Transforms errors into 'False' values.
--
-- > > errorToFalse False
-- > False
--
-- > > errorToFalse True
-- > True
--
-- > > errorToFalse undefined
-- > False
--
-- This functions uses 'unsafePerformIO'.
errorToFalse :: Bool -> Bool
errorToFalse :: Bool -> Bool
errorToFalse  =  forall a. a -> a -> a
fromError Bool
False

-- | Transforms errors into 'True' values.
--
-- > > errorToTrue False
-- > False
--
-- > > errorToTrue True
-- > True
--
-- > > errorToTrue undefined
-- > True
--
-- This functions uses 'unsafePerformIO'.
errorToTrue :: Bool -> Bool
errorToTrue :: Bool -> Bool
errorToTrue  =  forall a. a -> a -> a
fromError Bool
True

-- | Transforms errors into a default value.
--
-- > > fromError 0 (15 :: Int)
-- > 15
--
-- > > fromError 0 (undefined :: Int)
-- > 0
fromError :: a -> a -> a
fromError :: forall a. a -> a -> a
fromError a
x  =  forall a. a -> Maybe a -> a
fromMaybe a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
errorToNothing

-- | Equality '==' lifted over 'errorToNothing'
--
-- > > 1 `div` 1  ?==?  2 `div` 2
-- > True
--
-- > > 1 `div` 1  ?==?  1 `div` 2
-- > False
--
-- > > 1 `div` 1  ?==?  1 `div` 0
-- > False
--
-- > > 6 `mod` 0  ?==?  2 `div` 0
-- > True
--
-- > > head []  ?==?  tail []
-- > True
--
-- > > error "a"  ?==?  error "a"
-- > True
--
-- > > error "a"  ?==?  error "b"
-- > True
--
-- This function consider error values equal.
(?==?) :: Eq a => a -> a -> Bool
?==? :: forall a. Eq a => a -> a -> Bool
(?==?)  =  forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. a -> Maybe a
errorToNothing
infix 4 ?==?

-- | Equality '==' lifted over 'errorToLeft'
--
-- > > 1 `div` 1  !==!  2 `div` 2
-- > True
--
-- > > 1 `div` 1  !==!  1 `div` 2
-- > False
--
-- > > 1 `div` 1  !==!  1 `div` 0
-- > False
--
-- > > 6 `mod` 0  !==!  2 `div` 0
-- > True
--
-- > > head []  !==!  tail []
-- > False
--
-- > > error "a"  !==!  error "a"
-- > True
--
-- > > error "a"  !==!  error "b"
-- > False
--
-- On error, this function returns the result
-- of comparing the first line of error values.
(!==!) :: Eq a => a -> a -> Bool
!==! :: forall a. Eq a => a -> a -> Bool
(!==!)  =  forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. a -> Either String a
errorToLeft
infix 4 !==!

-- | An error-catching version of 'Test.LeanCheck.holds'
--   that returns 'False' in case of errors.
--
-- > prop_cannot_be_seven :: Int -> Bool
-- > prop_cannot_be_seven 7  =  error "Argument cannot be seven"
-- > prop_cannot_be_seven _  =  True
--
-- > > import Test.LeanCheck
-- > > holds 100 prop_cannot_be_seven
-- > *** Exception: Argument cannot be seven
--
-- > > import Test.LeanCheck.Error
-- > > holds 100 prop_cannot_be_seven
-- > False
holds :: Testable a => Int -> a -> Bool
holds :: forall a. Testable a => Int -> a -> Bool
holds Int
n  =  Bool -> Bool
errorToFalse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Testable a => Int -> a -> Bool
C.holds Int
n

-- | An error-catching version of 'Test.LeanCheck.fails'
--   that returns 'True' in case of errors.
fails :: Testable a => Int -> a -> Bool
fails :: forall a. Testable a => Int -> a -> Bool
fails Int
n  =  Bool -> Bool
errorToTrue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Testable a => Int -> a -> Bool
C.fails Int
n

-- | An error-catching version of 'Test.LeanCheck.exists'.
exists :: Testable a => Int -> a -> Bool
exists :: forall a. Testable a => Int -> a -> Bool
exists Int
n  =  forall (t :: * -> *). Foldable t => t Bool -> Bool
or 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 b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Testable a => a -> [([String], Bool)]
results

-- | An error-catching version of 'Test.LeanCheck.counterExample'.
counterExample :: Testable a => Int -> a -> Maybe [String]
counterExample :: forall a. Testable a => Int -> a -> Maybe [String]
counterExample Int
n  =  forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Testable a => Int -> a -> [[String]]
counterExamples Int
n

-- | An error-catching version of 'Test.LeanCheck.witness'.
witness :: Testable a => Int -> a -> Maybe [String]
witness :: forall a. Testable a => Int -> a -> Maybe [String]
witness Int
n  =  forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Testable a => Int -> a -> [[String]]
witnesses Int
n

-- | An error-catching version of 'Test.LeanCheck.counterExamples'.
counterExamples :: Testable a => Int -> a -> [[String]]
counterExamples :: forall a. Testable a => Int -> a -> [[String]]
counterExamples Int
n  =  forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) 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

-- | An error-catching version of 'Test.LeanCheck.witnesses'.
witnesses :: Testable a => Int -> a -> [[String]]
witnesses :: forall a. Testable a => Int -> a -> [[String]]
witnesses Int
n  =  forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter forall a b. (a, b) -> b
snd 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

-- | An error-catching version of 'Test.LeanCheck.results'.
results :: Testable a => a -> [([String],Bool)]
results :: forall a. Testable a => a -> [([String], Bool)]
results  =  forall a b. (a -> b) -> [a] -> [b]
map (forall {t} {b} {a}. (t -> b) -> (a, t) -> (a, b)
mapSnd Bool -> Bool
errorToFalse) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Testable a => a -> [([String], Bool)]
C.results
  where
  mapSnd :: (t -> b) -> (a, t) -> (a, b)
mapSnd t -> b
f (a
x,t
y)  =  (a
x,t -> b
f t
y)