{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Standard tests involving inverse functions
module Test.Syd.Validity.Functions.Inverse
    ( inverseFunctionsOnGen
    , inverseFunctionsOnValid
    , inverseFunctions
    , inverseFunctionsOnArbitrary
    , inverseFunctionsIfFirstSucceedsOnGen
    , inverseFunctionsIfFirstSucceedsOnValid
    , inverseFunctionsIfFirstSucceeds
    , inverseFunctionsIfFirstSucceedsOnArbitrary
    , inverseFunctionsIfSecondSucceedsOnGen
    , inverseFunctionsIfSecondSucceedsOnValid
    , inverseFunctionsIfSecondSucceeds
    , inverseFunctionsIfSecondSucceedsOnArbitrary
    , inverseFunctionsIfSucceedOnGen
    , inverseFunctionsIfSucceedOnValid
    , inverseFunctionsIfSucceed
    , inverseFunctionsIfSucceedOnArbitrary
    ) where

import Data.GenValidity

import Test.Syd
import Test.QuickCheck

import Test.Syd.Validity.Types

inverseFunctionsOnGen ::
       (Show a, Eq a) => (a -> b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property
inverseFunctionsOnGen :: (a -> b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property
inverseFunctionsOnGen a -> b
f b -> a
g Gen a
gen a -> [a]
s =
    Gen a -> (a -> [a]) -> (a -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen a
gen a -> [a]
s ((a -> IO ()) -> Property) -> (a -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \a
a -> b -> a
g (a -> b
f a
a) a -> a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` a
a

inverseFunctionsOnValid ::
       (Show a, Eq a, GenValid a) => (a -> b) -> (b -> a) -> Property
inverseFunctionsOnValid :: (a -> b) -> (b -> a) -> Property
inverseFunctionsOnValid a -> b
f b -> a
g = (a -> b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property
forall a b.
(Show a, Eq a) =>
(a -> b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property
inverseFunctionsOnGen a -> b
f b -> a
g Gen a
forall a. GenValid a => Gen a
genValid a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid

inverseFunctions ::
       (Show a, Eq a, GenUnchecked a) => (a -> b) -> (b -> a) -> Property
inverseFunctions :: (a -> b) -> (b -> a) -> Property
inverseFunctions a -> b
f b -> a
g = (a -> b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property
forall a b.
(Show a, Eq a) =>
(a -> b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property
inverseFunctionsOnGen a -> b
f b -> a
g Gen a
forall a. GenUnchecked a => Gen a
genUnchecked a -> [a]
forall a. GenUnchecked a => a -> [a]
shrinkUnchecked

-- |
-- 'id' is its own inverse function for every type:
-- prop> inverseFunctionsOnArbitrary id (id :: Int -> Int)
inverseFunctionsOnArbitrary ::
       (Show a, Eq a, Arbitrary a) => (a -> b) -> (b -> a) -> Property
inverseFunctionsOnArbitrary :: (a -> b) -> (b -> a) -> Property
inverseFunctionsOnArbitrary a -> b
f b -> a
g = (a -> b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property
forall a b.
(Show a, Eq a) =>
(a -> b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property
inverseFunctionsOnGen a -> b
f b -> a
g Gen a
forall a. Arbitrary a => Gen a
arbitrary a -> [a]
forall a. Arbitrary a => a -> [a]
shrink

inverseFunctionsIfFirstSucceedsOnGen ::
       (Show a, Eq a, CanFail f)
    => (a -> f b)
    -> (b -> a)
    -> Gen a
    -> (a -> [a])
    -> Property
inverseFunctionsIfFirstSucceedsOnGen :: (a -> f b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property
inverseFunctionsIfFirstSucceedsOnGen a -> f b
f b -> a
g Gen a
gen a -> [a]
s =
    Gen a -> (a -> [a]) -> (a -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen a
gen a -> [a]
s ((a -> IO ()) -> Property) -> (a -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \a
a ->
        case f b -> Maybe b
forall (f :: * -> *) a. CanFail f => f a -> Maybe a
resultIfSucceeded (a -> f b
f a
a) of
            Maybe b
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- fine
            Just b
b -> b -> a
g b
b a -> a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` a
a

inverseFunctionsIfFirstSucceedsOnValid ::
       (Show a, Eq a, GenValid a, CanFail f)
    => (a -> f b)
    -> (b -> a)
    -> Property
inverseFunctionsIfFirstSucceedsOnValid :: (a -> f b) -> (b -> a) -> Property
inverseFunctionsIfFirstSucceedsOnValid a -> f b
f b -> a
g =
    (a -> f b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property
forall a (f :: * -> *) b.
(Show a, Eq a, CanFail f) =>
(a -> f b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property
inverseFunctionsIfFirstSucceedsOnGen a -> f b
f b -> a
g Gen a
forall a. GenValid a => Gen a
genValid a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid

inverseFunctionsIfFirstSucceeds ::
       (Show a, Eq a, GenUnchecked a, CanFail f)
    => (a -> f b)
    -> (b -> a)
    -> Property
inverseFunctionsIfFirstSucceeds :: (a -> f b) -> (b -> a) -> Property
inverseFunctionsIfFirstSucceeds a -> f b
f b -> a
g =
    (a -> f b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property
forall a (f :: * -> *) b.
(Show a, Eq a, CanFail f) =>
(a -> f b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property
inverseFunctionsIfFirstSucceedsOnGen a -> f b
f b -> a
g Gen a
forall a. GenUnchecked a => Gen a
genUnchecked a -> [a]
forall a. GenUnchecked a => a -> [a]
shrinkUnchecked

inverseFunctionsIfFirstSucceedsOnArbitrary ::
       (Show a, Eq a, Arbitrary a, CanFail f)
    => (a -> f b)
    -> (b -> a)
    -> Property
inverseFunctionsIfFirstSucceedsOnArbitrary :: (a -> f b) -> (b -> a) -> Property
inverseFunctionsIfFirstSucceedsOnArbitrary a -> f b
f b -> a
g =
    (a -> f b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property
forall a (f :: * -> *) b.
(Show a, Eq a, CanFail f) =>
(a -> f b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property
inverseFunctionsIfFirstSucceedsOnGen a -> f b
f b -> a
g Gen a
forall a. Arbitrary a => Gen a
arbitrary a -> [a]
forall a. Arbitrary a => a -> [a]
shrink

inverseFunctionsIfSecondSucceedsOnGen ::
       (Show a, Eq a, CanFail f)
    => (a -> b)
    -> (b -> f a)
    -> Gen a
    -> (a -> [a])
    -> Property
inverseFunctionsIfSecondSucceedsOnGen :: (a -> b) -> (b -> f a) -> Gen a -> (a -> [a]) -> Property
inverseFunctionsIfSecondSucceedsOnGen a -> b
f b -> f a
g Gen a
gen a -> [a]
s =
    Gen a -> (a -> [a]) -> (a -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen a
gen a -> [a]
s ((a -> IO ()) -> Property) -> (a -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \a
a ->
        case f a -> Maybe a
forall (f :: * -> *) a. CanFail f => f a -> Maybe a
resultIfSucceeded (b -> f a
g (a -> b
f a
a)) of
            Maybe a
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- fine
            Just a
r -> a
r a -> a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` a
a

inverseFunctionsIfSecondSucceedsOnValid ::
       (Show a, Eq a, GenValid a, CanFail f)
    => (a -> b)
    -> (b -> f a)
    -> Property
inverseFunctionsIfSecondSucceedsOnValid :: (a -> b) -> (b -> f a) -> Property
inverseFunctionsIfSecondSucceedsOnValid a -> b
f b -> f a
g =
    (a -> b) -> (b -> f a) -> Gen a -> (a -> [a]) -> Property
forall a (f :: * -> *) b.
(Show a, Eq a, CanFail f) =>
(a -> b) -> (b -> f a) -> Gen a -> (a -> [a]) -> Property
inverseFunctionsIfSecondSucceedsOnGen a -> b
f b -> f a
g Gen a
forall a. GenValid a => Gen a
genValid a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid

inverseFunctionsIfSecondSucceeds ::
       (Show a, Eq a, GenUnchecked a, CanFail f)
    => (a -> b)
    -> (b -> f a)
    -> Property
inverseFunctionsIfSecondSucceeds :: (a -> b) -> (b -> f a) -> Property
inverseFunctionsIfSecondSucceeds a -> b
f b -> f a
g =
    (a -> b) -> (b -> f a) -> Gen a -> (a -> [a]) -> Property
forall a (f :: * -> *) b.
(Show a, Eq a, CanFail f) =>
(a -> b) -> (b -> f a) -> Gen a -> (a -> [a]) -> Property
inverseFunctionsIfSecondSucceedsOnGen a -> b
f b -> f a
g Gen a
forall a. GenUnchecked a => Gen a
genUnchecked a -> [a]
forall a. GenUnchecked a => a -> [a]
shrinkUnchecked

inverseFunctionsIfSecondSucceedsOnArbitrary ::
       (Show a, Eq a, Arbitrary a, CanFail f)
    => (a -> b)
    -> (b -> f a)
    -> Property
inverseFunctionsIfSecondSucceedsOnArbitrary :: (a -> b) -> (b -> f a) -> Property
inverseFunctionsIfSecondSucceedsOnArbitrary a -> b
f b -> f a
g =
    (a -> b) -> (b -> f a) -> Gen a -> (a -> [a]) -> Property
forall a (f :: * -> *) b.
(Show a, Eq a, CanFail f) =>
(a -> b) -> (b -> f a) -> Gen a -> (a -> [a]) -> Property
inverseFunctionsIfSecondSucceedsOnGen a -> b
f b -> f a
g Gen a
forall a. Arbitrary a => Gen a
arbitrary a -> [a]
forall a. Arbitrary a => a -> [a]
shrink

inverseFunctionsIfSucceedOnGen ::
       (Show a, Eq a, CanFail f, CanFail g)
    => (a -> f b)
    -> (b -> g a)
    -> Gen a
    -> (a -> [a])
    -> Property
inverseFunctionsIfSucceedOnGen :: (a -> f b) -> (b -> g a) -> Gen a -> (a -> [a]) -> Property
inverseFunctionsIfSucceedOnGen a -> f b
f b -> g a
g Gen a
gen a -> [a]
s =
    Gen a -> (a -> [a]) -> (a -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen a
gen a -> [a]
s ((a -> IO ()) -> Property) -> (a -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \a
a ->
        case do b
fa <- f b -> Maybe b
forall (f :: * -> *) a. CanFail f => f a -> Maybe a
resultIfSucceeded (f b -> Maybe b) -> f b -> Maybe b
forall a b. (a -> b) -> a -> b
$ a -> f b
f a
a
                g a -> Maybe a
forall (f :: * -> *) a. CanFail f => f a -> Maybe a
resultIfSucceeded (g a -> Maybe a) -> g a -> Maybe a
forall a b. (a -> b) -> a -> b
$ b -> g a
g b
fa of
            Maybe a
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- fine
            Just a
r -> a
r a -> a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` a
a

inverseFunctionsIfSucceedOnValid ::
       (Show a, Eq a, GenValid a, CanFail f, CanFail g)
    => (a -> f b)
    -> (b -> g a)
    -> Property
inverseFunctionsIfSucceedOnValid :: (a -> f b) -> (b -> g a) -> Property
inverseFunctionsIfSucceedOnValid a -> f b
f b -> g a
g =
    (a -> f b) -> (b -> g a) -> Gen a -> (a -> [a]) -> Property
forall a (f :: * -> *) (g :: * -> *) b.
(Show a, Eq a, CanFail f, CanFail g) =>
(a -> f b) -> (b -> g a) -> Gen a -> (a -> [a]) -> Property
inverseFunctionsIfSucceedOnGen a -> f b
f b -> g a
g Gen a
forall a. GenValid a => Gen a
genValid a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid

inverseFunctionsIfSucceed ::
       (Show a, Eq a, GenUnchecked a, CanFail f, CanFail g)
    => (a -> f b)
    -> (b -> g a)
    -> Property
inverseFunctionsIfSucceed :: (a -> f b) -> (b -> g a) -> Property
inverseFunctionsIfSucceed a -> f b
f b -> g a
g =
    (a -> f b) -> (b -> g a) -> Gen a -> (a -> [a]) -> Property
forall a (f :: * -> *) (g :: * -> *) b.
(Show a, Eq a, CanFail f, CanFail g) =>
(a -> f b) -> (b -> g a) -> Gen a -> (a -> [a]) -> Property
inverseFunctionsIfSucceedOnGen a -> f b
f b -> g a
g Gen a
forall a. GenUnchecked a => Gen a
genUnchecked a -> [a]
forall a. GenUnchecked a => a -> [a]
shrinkUnchecked

inverseFunctionsIfSucceedOnArbitrary ::
       (Show a, Eq a, Arbitrary a, CanFail f, CanFail g)
    => (a -> f b)
    -> (b -> g a)
    -> Property
inverseFunctionsIfSucceedOnArbitrary :: (a -> f b) -> (b -> g a) -> Property
inverseFunctionsIfSucceedOnArbitrary a -> f b
f b -> g a
g =
    (a -> f b) -> (b -> g a) -> Gen a -> (a -> [a]) -> Property
forall a (f :: * -> *) (g :: * -> *) b.
(Show a, Eq a, CanFail f, CanFail g) =>
(a -> f b) -> (b -> g a) -> Gen a -> (a -> [a]) -> Property
inverseFunctionsIfSucceedOnGen a -> f b
f b -> g a
g Gen a
forall a. Arbitrary a => Gen a
arbitrary a -> [a]
forall a. Arbitrary a => a -> [a]
shrink