{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Tests for GenRelativeValidity instances
--
-- You will need @TypeApplications@ to use these.
module Test.Syd.Validity.GenRelativeValidity
    ( genRelativeValiditySpec
    , genRelativeValidSpec
    , genRelativeInvalidSpec
    , genRelativeValidGeneratesValid
    , genRelativeInvalidGeneratesInvalid
    ) where

import Data.Data

import Data.GenRelativeValidity
import Data.GenValidity

import Test.Syd
import Test.QuickCheck

import Test.Syd.Validity.Property.Utils
import Test.Syd.Validity.Utils

-- | A @Spec@ that specifies that @genValidFor@ and @genInvalidFor@ work as
-- intended.
--
-- In general it is a good idea to add this spec to your test suite if you
-- write a custom implementation of @genValidFor@ or @genInvalidFor@.
--
-- Example usage:
--
-- > relativeGenValiditySpec @MyDataFor @MyOtherData
genRelativeValiditySpec ::
       forall a b.
       ( Typeable a
       , Show a
       , Show b
       , GenUnchecked b
       , GenValid b
       , GenRelativeValid a b
       , GenRelativeInvalid a b
       )
    => Spec
genRelativeValiditySpec :: Spec
genRelativeValiditySpec = do
    (Typeable a, Show a, Show b, GenValid b, GenRelativeValid a b) =>
Spec
forall a b.
(Typeable a, Show a, Show b, GenValid b, GenRelativeValid a b) =>
Spec
genRelativeValidSpec @a @b
    (Typeable a, Show a, Show b, GenUnchecked b,
 GenRelativeInvalid a b) =>
Spec
forall a b.
(Typeable a, Show a, Show b, GenUnchecked b,
 GenRelativeInvalid a b) =>
Spec
genRelativeInvalidSpec @a @b

genRelativeValidSpec ::
       forall a b.
       ( Typeable a
       , Show a
       , Show b
       , GenValid b
       , GenRelativeValid a b
       )
    => Spec
genRelativeValidSpec :: Spec
genRelativeValidSpec =
    Spec -> Spec
forall (a :: [*]) b c. TestDefM a b c -> TestDefM a b c
parallel (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
        let nameOne :: String
nameOne = Typeable a => String
forall k (a :: k). Typeable a => String
nameOf @a
        let nameTwo :: String
nameTwo = Typeable a => String
forall k (a :: k). Typeable a => String
nameOf @a
        String -> Spec -> Spec
forall (outers :: [*]) inner.
String -> TestDefM outers inner () -> TestDefM outers inner ()
describe (String
"GenRelativeValidity " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nameOne String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nameTwo) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
            String -> Spec -> Spec
forall (outers :: [*]) inner.
String -> TestDefM outers inner () -> TestDefM outers inner ()
describe (String
"genValidFor   :: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nameTwo String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> Gen " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nameOne) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
            String -> Property -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it
                (String
"only generates valid \'" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                 String
nameOne String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\'s for the " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nameTwo) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
            (Show a, Show b, GenValid b, GenRelativeValid a b) => Property
forall a b.
(Show a, Show b, GenValid b, GenRelativeValid a b) =>
Property
genRelativeValidGeneratesValid @a @b

genRelativeInvalidSpec ::
       forall a b.
       ( Typeable a
       , Show a
       , Show b
       , GenUnchecked b
       , GenRelativeInvalid a b
       )
    => Spec
genRelativeInvalidSpec :: Spec
genRelativeInvalidSpec =
    Spec -> Spec
forall (a :: [*]) b c. TestDefM a b c -> TestDefM a b c
parallel (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
        let nameOne :: String
nameOne = Typeable a => String
forall k (a :: k). Typeable a => String
nameOf @a
        let nameTwo :: String
nameTwo = Typeable a => String
forall k (a :: k). Typeable a => String
nameOf @a
        String -> Spec -> Spec
forall (outers :: [*]) inner.
String -> TestDefM outers inner () -> TestDefM outers inner ()
describe (String
"GenRelativeInvalid " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nameOne String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nameTwo) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
            String -> Spec -> Spec
forall (outers :: [*]) inner.
String -> TestDefM outers inner () -> TestDefM outers inner ()
describe (String
"genInvalidFor   :: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nameTwo String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> Gen " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nameOne) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
            String -> Property -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it
                (String
"only generates invalid \'" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                 String
nameOne String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\'s for the " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nameTwo) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
            (Show a, Show b, GenUnchecked b, GenRelativeInvalid a b) =>
Property
forall a b.
(Show a, Show b, GenUnchecked b, GenRelativeInvalid a b) =>
Property
genRelativeInvalidGeneratesInvalid @a @b

-- | @genValidFor b@ only generates values that satisfy @isValidFor b@
genRelativeValidGeneratesValid ::
       forall a b.
       (Show a, Show b, GenValid b, GenRelativeValid a b)
    => Property
genRelativeValidGeneratesValid :: Property
genRelativeValidGeneratesValid =
    (b -> Property) -> Property
forall a prop.
(Show a, GenValid a, Testable prop) =>
(a -> prop) -> Property
forAllValid ((b -> Property) -> Property) -> (b -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(b
b :: b) ->
        Gen a -> (a -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (b -> Gen a
forall a b. GenRelativeValid a b => b -> Gen a
genValidFor b
b) ((a -> IO ()) -> Property) -> (a -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) -> a
a a -> (a -> Bool) -> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` (a -> b -> Bool
forall a b. RelativeValidity a b => a -> b -> Bool
`isValidFor` b
b)

-- | @genInvalidFor b@ only generates values that do not satisfy @isValidFor b@
genRelativeInvalidGeneratesInvalid ::
       forall a b.
       ( Show a
       , Show b
       , GenUnchecked b
       , GenRelativeInvalid a b
       )
    => Property
genRelativeInvalidGeneratesInvalid :: Property
genRelativeInvalidGeneratesInvalid =
    (b -> Property) -> Property
forall a prop.
(Show a, GenUnchecked a, Testable prop) =>
(a -> prop) -> Property
forAllUnchecked ((b -> Property) -> Property) -> (b -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(b
b :: b) ->
        Gen a -> (a -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (b -> Gen a
forall a b. GenRelativeInvalid a b => b -> Gen a
genInvalidFor b
b) ((a -> IO ()) -> Property) -> (a -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) ->
            a
a a -> (a -> Bool) -> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldNotSatisfy` (a -> b -> Bool
forall a b. RelativeValidity a b => a -> b -> Bool
`isValidFor` b
b)