-- |
-- Copyright: © 2022–2023 Jonathan Knowles
-- License: Apache-2.0
--
module Internal
    ( cover
    , makeLaw0
    , makeLaw1
    , makeLaw2
    , makeLaw3
    , makeProperty
    , report
    , (==>)
    )
    where

import Data.Function
    ( (&) )
import Data.Proxy
    ( Proxy (..) )
import Internal.Semigroup.Eq
    ( allNonNull, allUnique, allUniqueNonNull )
import Internal.Semigroup.Tuple
    ( Tuple1, Tuple2, Tuple3, evalTuple1, evalTuple2, evalTuple3 )
import Test.QuickCheck
    ( Arbitrary (..)
    , Property
    , Testable
    , checkCoverage
    , counterexample
    , property
    )

import qualified Test.QuickCheck as QC

infixr 0 ==>
(==>) :: Bool -> Bool -> Bool
Bool
a ==> :: Bool -> Bool -> Bool
==> Bool
b = Bool -> Bool
not Bool
a Bool -> Bool -> Bool
|| Bool
b

cover :: Testable t => String -> Bool -> t -> Property
cover :: forall t. Testable t => String -> Bool -> t -> Property
cover String
name = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall prop.
Testable prop =>
Double -> Bool -> String -> prop -> Property
QC.cover Double
0.1) (Char -> Char
replaceSpecialChars forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
name)

makeLaw :: Testable t => String -> t -> (String, Property)
makeLaw :: forall t. Testable t => String -> t -> (String, Property)
makeLaw String
title t
t = (String
title, forall prop. Testable prop => prop -> Property
checkCoverage forall a b. (a -> b) -> a -> b
$ forall prop. Testable prop => prop -> Property
property t
t)

makeLaw0
    :: String
    -> (Proxy a -> Property)
    -> (String, Property)
makeLaw0 :: forall {k} (a :: k).
String -> (Proxy a -> Property) -> (String, Property)
makeLaw0 String
s = forall t. Testable t => String -> t -> (String, Property)
makeLaw String
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (a :: k) t. Testable t => (Proxy a -> t) -> Property
makeProperty0

makeLaw1
    :: (Arbitrary a, Show a, Eq a, Semigroup a, Testable t)
    => String
    -> (a -> t)
    -> (String, Property)
makeLaw1 :: forall a t.
(Arbitrary a, Show a, Eq a, Semigroup a, Testable t) =>
String -> (a -> t) -> (String, Property)
makeLaw1 String
s = forall t. Testable t => String -> t -> (String, Property)
makeLaw String
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a t.
(Eq a, Semigroup a, Testable t) =>
(a -> t) -> Tuple1 a -> Property
makeProperty1

makeLaw2
    :: (Arbitrary a, Show a, Eq a, Semigroup a, Testable t)
    => String
    -> (a -> a -> t)
    -> (String, Property)
makeLaw2 :: forall a t.
(Arbitrary a, Show a, Eq a, Semigroup a, Testable t) =>
String -> (a -> a -> t) -> (String, Property)
makeLaw2 String
s = forall t. Testable t => String -> t -> (String, Property)
makeLaw String
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a t.
(Eq a, Semigroup a, Testable t) =>
(a -> a -> t) -> Tuple2 a -> Property
makeProperty2

makeLaw3
    :: (Arbitrary a, Show a, Eq a, Semigroup a, Testable t)
    => String
    -> (a -> a -> a -> t)
    -> (String, Property)
makeLaw3 :: forall a t.
(Arbitrary a, Show a, Eq a, Semigroup a, Testable t) =>
String -> (a -> a -> a -> t) -> (String, Property)
makeLaw3 String
s = forall t. Testable t => String -> t -> (String, Property)
makeLaw String
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a t.
(Eq a, Semigroup a, Testable t) =>
(a -> a -> a -> t) -> Tuple3 a -> Property
makeProperty3

makeProperty :: Testable t => String -> t -> Property
makeProperty :: forall t. Testable t => String -> t -> Property
makeProperty String
propertyDescription t
t =
    forall prop. Testable prop => prop -> Property
property t
t forall a b. a -> (a -> b) -> b
& forall t. Testable t => String -> t -> Property
counterexample String
counterexampleText
  where
    counterexampleText :: String
counterexampleText = [String] -> String
unlines
        [ String
"Property not satisfied:"
        , String
propertyDescription
            forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
replaceSpecialChars
        ]
      where

makeProperty0
    :: forall a t. Testable t
    => (Proxy a -> t)
    -> Property
makeProperty0 :: forall {k} (a :: k) t. Testable t => (Proxy a -> t) -> Property
makeProperty0 Proxy a -> t
p = forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ Proxy a -> t
p forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @a

makeProperty1
    :: (Eq a, Semigroup a, Testable t)
    => (a -> t)
    -> (Tuple1 a -> Property)
makeProperty1 :: forall a t.
(Eq a, Semigroup a, Testable t) =>
(a -> t) -> Tuple1 a -> Property
makeProperty1 a -> t
p (forall s. Semigroup s => Tuple1 s -> s
evalTuple1 -> a
a)
    = forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ a -> t
p a
a

makeProperty2
    :: (Eq a, Semigroup a, Testable t)
    => (a -> a -> t)
    -> (Tuple2 a -> Property)
makeProperty2 :: forall a t.
(Eq a, Semigroup a, Testable t) =>
(a -> a -> t) -> Tuple2 a -> Property
makeProperty2 a -> a -> t
p (forall s. Semigroup s => Tuple2 s -> (s, s)
evalTuple2 -> (a
a, a
b))
    = forall t. Testable t => String -> Bool -> t -> Property
cover
        String
"allUnique [a, b]"
        (forall a (f :: * -> *). (Eq a, Foldable f) => f a -> Bool
allUnique [a
a, a
b])
    forall a b. (a -> b) -> a -> b
$ forall t. Testable t => String -> Bool -> t -> Property
cover
        String
"allNonNull [a, b]"
        (forall a (f :: * -> *).
(Eq a, Semigroup a, Foldable f) =>
f a -> Bool
allNonNull [a
a, a
b])
    forall a b. (a -> b) -> a -> b
$ forall t. Testable t => String -> Bool -> t -> Property
cover
        String
"allUniqueNonNull [a, b]"
        (forall a (f :: * -> *).
(Eq a, Foldable f, Semigroup a) =>
f a -> Bool
allUniqueNonNull [a
a, a
b])
    forall a b. (a -> b) -> a -> b
$ forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ a -> a -> t
p a
a a
b

makeProperty3
    :: (Eq a, Semigroup a, Testable t)
    => (a -> a -> a -> t)
    -> (Tuple3 a -> Property)
makeProperty3 :: forall a t.
(Eq a, Semigroup a, Testable t) =>
(a -> a -> a -> t) -> Tuple3 a -> Property
makeProperty3 a -> a -> a -> t
p (forall s. Semigroup s => Tuple3 s -> (s, s, s)
evalTuple3 -> (a
a, a
b, a
c))
    = forall t. Testable t => String -> Bool -> t -> Property
cover
        String
"allUnique [a, b, c]"
        (forall a (f :: * -> *). (Eq a, Foldable f) => f a -> Bool
allUnique [a
a, a
b, a
c])
    forall a b. (a -> b) -> a -> b
$ forall t. Testable t => String -> Bool -> t -> Property
cover
        String
"allNonNull [a, b, c]"
        (forall a (f :: * -> *).
(Eq a, Semigroup a, Foldable f) =>
f a -> Bool
allNonNull [a
a, a
b, a
c])
    forall a b. (a -> b) -> a -> b
$ forall t. Testable t => String -> Bool -> t -> Property
cover
        String
"allUniqueNonNull [a, b, c]"
        (forall a (f :: * -> *).
(Eq a, Foldable f, Semigroup a) =>
f a -> Bool
allUniqueNonNull [a
a, a
b, a
c])
    forall a b. (a -> b) -> a -> b
$ forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ a -> a -> a -> t
p a
a a
b a
c

report :: (Show a, Testable prop) => String -> a -> prop -> Property
report :: forall a prop.
(Show a, Testable prop) =>
String -> a -> prop -> Property
report String
name a
a = forall t. Testable t => String -> t -> Property
counterexample forall a b. (a -> b) -> a -> b
$
    (Char -> Char
replaceSpecialChars forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
name) forall a. Semigroup a => a -> a -> a
<> String
":\n" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
a forall a. Semigroup a => a -> a -> a
<> String
"\n"

replaceSpecialChars :: Char -> Char
replaceSpecialChars :: Char -> Char
replaceSpecialChars = \case
    Char
'λ'   -> Char
'\\'
    Char
other -> Char
other