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

-- | Tests for RelativeValidity instances
--
-- You will need @TypeApplications@ to use these.
module Test.Syd.Validity.RelativeValidity
    ( relativeValiditySpec
    , relativeValidityImpliesValidA
    , relativeValidityImpliesValidB
    ) 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 @isValidFor@ implies @isValid@
--
-- In general it is a good idea to add this spec to your test suite if
-- the @a@ and @b@ in @RelativeValidity a b@ also have a @Validity@ instance.
--
-- Example usage:
--
-- > relativeValiditySpec @MyDataFor @MyOtherData
relativeValiditySpec ::
       forall a b.
       ( Typeable a
       , Typeable b
       , Show a
       , Show b
       , Validity a
       , Validity b
       , GenUnchecked a
       , GenUnchecked b
       , RelativeValidity a b
       )
    => Spec
relativeValiditySpec :: Spec
relativeValiditySpec =
    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
            nameTwo :: String
nameTwo = Typeable b => String
forall k (a :: k). Typeable a => String
nameOf @b
        String -> Spec -> Spec
forall (outers :: [*]) inner.
String -> TestDefM outers inner () -> TestDefM outers inner ()
describe (String
"RelativeValidity " 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
"isValidFor :: " 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 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> Bool") (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
                String -> Property -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it (String
"implies isValid " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nameOne String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for any " 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, Validity a, GenUnchecked a, GenUnchecked b,
 RelativeValidity a b) =>
Property
forall a b.
(Show a, Show b, Validity a, GenUnchecked a, GenUnchecked b,
 RelativeValidity a b) =>
Property
relativeValidityImpliesValidA @a @b
                String -> Property -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it (String
"implies isValid " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nameTwo String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for any " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nameOne) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
                    (Show a, Show b, Validity b, GenUnchecked a, GenUnchecked b,
 RelativeValidity a b) =>
Property
forall a b.
(Show a, Show b, Validity b, GenUnchecked a, GenUnchecked b,
 RelativeValidity a b) =>
Property
relativeValidityImpliesValidB @a @b

-- | @isValidFor a b@ implies @isValid a@ for all @b@
relativeValidityImpliesValidA ::
       forall a b.
       ( Show a
       , Show b
       , Validity a
       , GenUnchecked a
       , GenUnchecked b
       , RelativeValidity a b
       )
    => Property
relativeValidityImpliesValidA :: Property
relativeValidityImpliesValidA =
    (a -> Property) -> Property
forall a prop.
(Show a, GenUnchecked a, Testable prop) =>
(a -> prop) -> Property
forAllUnchecked ((a -> Property) -> Property) -> (a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) ->
        (b -> Bool) -> Property
forall a prop.
(Show a, GenUnchecked a, Testable prop) =>
(a -> prop) -> Property
forAllUnchecked ((b -> Bool) -> Property) -> (b -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(b
b :: b) -> (a
a a -> b -> Bool
forall a b. RelativeValidity a b => a -> b -> Bool
`isValidFor` b
b) Bool -> Bool -> Bool
===> a -> Bool
forall a. Validity a => a -> Bool
isValid a
a

-- | @isValidFor a b@ implies @isValid b@ for all @a@
relativeValidityImpliesValidB ::
       forall a b.
       ( Show a
       , Show b
       , Validity b
       , GenUnchecked a
       , GenUnchecked b
       , RelativeValidity a b
       )
    => Property
relativeValidityImpliesValidB :: Property
relativeValidityImpliesValidB =
    (a -> Property) -> Property
forall a prop.
(Show a, GenUnchecked a, Testable prop) =>
(a -> prop) -> Property
forAllUnchecked ((a -> Property) -> Property) -> (a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) ->
        (b -> Bool) -> Property
forall a prop.
(Show a, GenUnchecked a, Testable prop) =>
(a -> prop) -> Property
forAllUnchecked ((b -> Bool) -> Property) -> (b -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(b
b :: b) -> (a
a a -> b -> Bool
forall a b. RelativeValidity a b => a -> b -> Bool
`isValidFor` b
b) Bool -> Bool -> Bool
===> b -> Bool
forall a. Validity a => a -> Bool
isValid b
b