{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}
module Test.Massiv.Utils
  ( showsType
  , showsArrayType
  , assertException
  , assertExceptionIO
  , assertSomeException
  , assertSomeExceptionIO
  , toStringException
  , selectErrorCall
  , ExpectedException(..)
  , applyFun2Compat
  , expectProp
  , propIO
  -- * Epsilon comparison
  , epsilonExpect
  , epsilonFoldableExpect
  , epsilonMaybeEq
  , epsilonEq
  , epsilonEqDouble
  , epsilonEqFloat
  , module X
  ) where

import qualified Data.Foldable as F
import Control.Monad as X
import Control.Monad.ST as X
import Data.Maybe as X (fromMaybe, isJust, isNothing)
import Data.Typeable as X
import Test.QuickCheck as X hiding ((.&.))
import Test.QuickCheck.Monadic as X
import Test.Hspec as X
import Test.Hspec.QuickCheck as X
import Test.QuickCheck.Function as X
import Control.DeepSeq as X (NFData, deepseq)
import Control.Exception (ErrorCall (..))
import UnliftIO.Exception (Exception(..), SomeException, catch, catchAny)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup as X ((<>))
#endif


-- | Use Typeable to show the type.
showsType :: forall t . Typeable t => ShowS
showsType :: ShowS
showsType = TypeRep -> ShowS
showsTypeRep (Proxy t -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy t
forall k (t :: k). Proxy t
Proxy :: Proxy t))

-- | Use Typeable to show the array type
showsArrayType :: forall r ix e . (Typeable r, Typeable ix, Typeable e) => ShowS
showsArrayType :: ShowS
showsArrayType =
  ([Char]
"Array " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Typeable r => ShowS
forall t. Typeable t => ShowS
showsType @r ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
" (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Typeable ix => ShowS
forall t. Typeable t => ShowS
showsType @ix ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
") " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Typeable e => ShowS
forall t. Typeable t => ShowS
showsType @e


assertException ::
     (Testable b, NFData a, Exception exc)
  => (exc -> b) -- ^ Return True if that is the exception that was expected
  -> a -- ^ Value that should throw an exception, when fully evaluated
  -> Property
assertException :: (exc -> b) -> a -> Property
assertException exc -> b
isExc = (exc -> b) -> IO a -> Property
forall b a exc.
(Testable b, NFData a, Exception exc) =>
(exc -> b) -> IO a -> Property
assertExceptionIO exc -> b
isExc (IO a -> Property) -> (a -> IO a) -> a -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure


assertSomeException :: NFData a => a -> Property
assertSomeException :: a -> Property
assertSomeException = IO a -> Property
forall a. NFData a => IO a -> Property
assertSomeExceptionIO (IO a -> Property) -> (a -> IO a) -> a -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure


assertExceptionIO ::
     (Testable b, NFData a, Exception exc)
  => (exc -> b) -- ^ Return True if that is the exception that was expected
  -> IO a -- ^ IO Action that should throw an exception
  -> Property
assertExceptionIO :: (exc -> b) -> IO a -> Property
assertExceptionIO exc -> b
isExc IO a
action =
  PropertyM IO Property -> Property
forall a. Testable a => PropertyM IO a -> Property
monadicIO (PropertyM IO Property -> Property)
-> PropertyM IO Property -> Property
forall a b. (a -> b) -> a -> b
$
  IO Property -> PropertyM IO Property
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run (IO Property -> PropertyM IO Property)
-> IO Property -> PropertyM IO Property
forall a b. (a -> b) -> a -> b
$
  IO Property -> (exc -> IO Property) -> IO Property
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
    (do a
res <- IO a
action
        a
res a -> IO Property -> IO Property
forall a b. NFData a => a -> b -> b
`deepseq` Property -> IO Property
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample [Char]
"Did not receive an exception" Bool
False))
    (\exc
exc -> exc -> [Char]
forall e. Exception e => e -> [Char]
displayException exc
exc [Char] -> IO Property -> IO Property
forall a b. NFData a => a -> b -> b
`deepseq` Property -> IO Property
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Property
forall prop. Testable prop => prop -> Property
property (exc -> b
isExc exc
exc)))

assertSomeExceptionIO :: NFData a => IO a -> Property
assertSomeExceptionIO :: IO a -> Property
assertSomeExceptionIO IO a
action =
  PropertyM IO Property -> Property
forall a. Testable a => PropertyM IO a -> Property
monadicIO (PropertyM IO Property -> Property)
-> PropertyM IO Property -> Property
forall a b. (a -> b) -> a -> b
$
  IO Property -> PropertyM IO Property
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run (IO Property -> PropertyM IO Property)
-> IO Property -> PropertyM IO Property
forall a b. (a -> b) -> a -> b
$
  IO Property -> (SomeException -> IO Property) -> IO Property
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
catchAny
    (do a
res <- IO a
action
        a
res a -> IO Property -> IO Property
forall a b. NFData a => a -> b -> b
`deepseq` Property -> IO Property
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample [Char]
"Did not receive an exception" Bool
False))
    (\SomeException
exc -> SomeException -> [Char]
forall e. Exception e => e -> [Char]
displayException SomeException
exc [Char] -> IO Property -> IO Property
forall a b. NFData a => a -> b -> b
`deepseq` Property -> IO Property
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True))


toStringException :: Either SomeException a -> Either String a
toStringException :: Either SomeException a -> Either [Char] a
toStringException = (SomeException -> Either [Char] a)
-> (a -> Either [Char] a)
-> Either SomeException a
-> Either [Char] a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Either [Char] a
forall a b. a -> Either a b
Left ([Char] -> Either [Char] a)
-> (SomeException -> [Char]) -> SomeException -> Either [Char] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> [Char]
forall e. Exception e => e -> [Char]
displayException) a -> Either [Char] a
forall a b. b -> Either a b
Right


selectErrorCall :: ErrorCall -> Bool
selectErrorCall :: ErrorCall -> Bool
selectErrorCall = \case
  ErrorCallWithLocation [Char]
err [Char]
loc -> [Char]
err [Char] -> ShowS
forall a b. NFData a => a -> b -> b
`deepseq` [Char]
loc [Char] -> Bool -> Bool
forall a b. NFData a => a -> b -> b
`deepseq` Bool
True

data ExpectedException = ExpectedException deriving (Int -> ExpectedException -> ShowS
[ExpectedException] -> ShowS
ExpectedException -> [Char]
(Int -> ExpectedException -> ShowS)
-> (ExpectedException -> [Char])
-> ([ExpectedException] -> ShowS)
-> Show ExpectedException
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ExpectedException] -> ShowS
$cshowList :: [ExpectedException] -> ShowS
show :: ExpectedException -> [Char]
$cshow :: ExpectedException -> [Char]
showsPrec :: Int -> ExpectedException -> ShowS
$cshowsPrec :: Int -> ExpectedException -> ShowS
Show, ExpectedException -> ExpectedException -> Bool
(ExpectedException -> ExpectedException -> Bool)
-> (ExpectedException -> ExpectedException -> Bool)
-> Eq ExpectedException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExpectedException -> ExpectedException -> Bool
$c/= :: ExpectedException -> ExpectedException -> Bool
== :: ExpectedException -> ExpectedException -> Bool
$c== :: ExpectedException -> ExpectedException -> Bool
Eq)

instance Exception ExpectedException


applyFun2Compat :: Fun (a, b) c -> (a -> b -> c)
#if MIN_VERSION_QuickCheck(2,10,0)
applyFun2Compat :: Fun (a, b) c -> a -> b -> c
applyFun2Compat = Fun (a, b) c -> a -> b -> c
forall a b c. Fun (a, b) c -> a -> b -> c
applyFun2
#else
applyFun2Compat (Fun _ f) a b = f (a, b)
instance Function Word where
  function = functionMap fromIntegral fromInteger
#endif

-- | Convert an hspec Expectation to a quickcheck Property.
--
-- @since 1.5.0
expectProp :: Expectation -> Property
expectProp :: Expectation -> Property
expectProp = PropertyM IO () -> Property
forall a. Testable a => PropertyM IO a -> Property
monadicIO (PropertyM IO () -> Property)
-> (Expectation -> PropertyM IO ()) -> Expectation -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expectation -> PropertyM IO ()
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run

-- | Convert a Testable to a quickcheck Property. Works well with hspec expectations as well
--
-- @since 1.7.0
propIO :: (Testable a) => IO a -> Property
propIO :: IO a -> Property
propIO IO a
action = PropertyM IO a -> Property
forall a. Testable a => PropertyM IO a -> Property
monadicIO (PropertyM IO a -> Property) -> PropertyM IO a -> Property
forall a b. (a -> b) -> a -> b
$ IO a -> PropertyM IO a
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run IO a
action


epsilonExpect ::
     (HasCallStack, Show a, RealFloat a)
  => a -- ^ Epsilon, a maximum tolerated error. Sign is ignored.
  -> a -- ^ Expected result.
  -> a -- ^ Tested value.
  -> Expectation
epsilonExpect :: a -> a -> a -> Expectation
epsilonExpect a
epsilon a
x a
y =
  Maybe [Char] -> ([Char] -> Expectation) -> Expectation
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
X.forM_ (a -> a -> a -> Maybe [Char]
forall a. (Show a, RealFloat a) => a -> a -> a -> Maybe [Char]
epsilonMaybeEq a
epsilon a
x a
y) (([Char] -> Expectation) -> Expectation)
-> ([Char] -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \[Char]
errMsg ->
    HasCallStack => [Char] -> Expectation
[Char] -> Expectation
expectationFailure ([Char] -> Expectation) -> [Char] -> Expectation
forall a b. (a -> b) -> a -> b
$ [Char]
"Expected: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" but got: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
y [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n   " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
errMsg


epsilonFoldableExpect ::
     (HasCallStack, Foldable f, Show (f e), Show e, RealFloat e) => e -> f e -> f e -> Expectation
epsilonFoldableExpect :: e -> f e -> f e -> Expectation
epsilonFoldableExpect e
epsilon f e
x f e
y = do
  f e -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length f e
x Int -> Int -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` f e -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length f e
y
  Bool -> Expectation -> Expectation
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (f e -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null f e
x) (Expectation -> Expectation) -> Expectation -> Expectation
forall a b. (a -> b) -> a -> b
$
    Maybe [[Char]] -> ([[Char]] -> Expectation) -> Expectation
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
X.forM_ ((e -> e -> Maybe [Char]) -> [e] -> [e] -> Maybe [[Char]]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (e -> e -> e -> Maybe [Char]
forall a. (Show a, RealFloat a) => a -> a -> a -> Maybe [Char]
epsilonMaybeEq e
epsilon) (f e -> [e]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList f e
x) (f e -> [e]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList f e
y)) (([[Char]] -> Expectation) -> Expectation)
-> ([[Char]] -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \[[Char]]
errMsgs ->
      HasCallStack => [Char] -> Expectation
[Char] -> Expectation
expectationFailure ([Char] -> Expectation) -> [Char] -> Expectation
forall a b. (a -> b) -> a -> b
$
      [Char]
"Expected: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ f e -> [Char]
forall a. Show a => a -> [Char]
show f e
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" but got: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ f e -> [Char]
forall a. Show a => a -> [Char]
show f e
y [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unlines (ShowS -> [[Char]] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char]
"    " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) [[Char]]
errMsgs)


epsilonMaybeEq ::
     (Show a, RealFloat a)
  => a -- ^ Epsilon, a maximum tolerated error. Sign is ignored.
  -> a -- ^ Expected result.
  -> a -- ^ Tested value.
  -> Maybe String
epsilonMaybeEq :: a -> a -> a -> Maybe [Char]
epsilonMaybeEq a
epsilon a
x a
y
  | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
&& Bool -> Bool
not (a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
y) = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"Expected NaN, but got: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
y
  | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = Maybe [Char]
forall a. Maybe a
Nothing
  | a
diff a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
n = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [a -> [Char]
forall a. Show a => a -> [Char]
show a
x, [Char]
" /= ", a -> [Char]
forall a. Show a => a -> [Char]
show a
y, [Char]
" (Tolerance: ", a -> [Char]
forall a. Show a => a -> [Char]
show a
diff, [Char]
" > ", a -> [Char]
forall a. Show a => a -> [Char]
show a
n, [Char]
")"]
  | Bool
otherwise = Maybe [Char]
forall a. Maybe a
Nothing
  where
    (a
absx, a
absy) = (a -> a
forall a. Num a => a -> a
abs a
x, a -> a
forall a. Num a => a -> a
abs a
y)
    n :: a
n = a
epsilon a -> a -> a
forall a. Num a => a -> a -> a
* (a
1 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a -> a
forall a. Ord a => a -> a -> a
max a
absx a
absy)
    diff :: a
diff = a -> a
forall a. Num a => a -> a
abs (a
y a -> a -> a
forall a. Num a => a -> a -> a
- a
x)


epsilonEq ::
     (Show a, RealFloat a)
  => a -- ^ Epsilon, a maximum tolerated error. Sign is ignored.
  -> a -- ^ Expected result.
  -> a -- ^ Tested value.
  -> Property
epsilonEq :: a -> a -> a -> Property
epsilonEq a
epsilon a
x a
y = Expectation -> Property
forall prop. Testable prop => prop -> Property
property (Expectation -> Property) -> Expectation -> Property
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Expectation
forall a.
(HasCallStack, Show a, RealFloat a) =>
a -> a -> a -> Expectation
epsilonExpect a
epsilon a
x a
y

epsilonEqDouble ::
     Double -- ^ Expected result.
  -> Double -- ^ Tested value.
  -> Property
epsilonEqDouble :: Double -> Double -> Property
epsilonEqDouble = Double -> Double -> Double -> Property
forall a. (Show a, RealFloat a) => a -> a -> a -> Property
epsilonEq Double
epsilon
  where
    epsilon :: Double
epsilon = Double
1e-12

epsilonEqFloat ::
     Float -- ^ Expected result.
  -> Float -- ^ Tested value.
  -> Property
epsilonEqFloat :: Float -> Float -> Property
epsilonEqFloat = Float -> Float -> Float -> Property
forall a. (Show a, RealFloat a) => a -> a -> a -> Property
epsilonEq Float
epsilon
  where
    epsilon :: Float
epsilon = Float
1e-6