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

module Test.Validity.Functions.CanFail
  ( succeedsOnGen,
    succeeds,
    succeedsOnArbitrary,
    succeedsOnGens2,
    succeeds2,
    succeedsOnArbitrary2,
    failsOnGen,
    failsOnGens2,
    validIfSucceedsOnGen,
    validIfSucceedsOnArbitrary,
    validIfSucceeds,
    validIfSucceedsOnGens2,
    validIfSucceeds2,
    validIfSucceedsOnArbitrary2,
    validIfSucceedsOnGens3,
    validIfSucceeds3,
    validIfSucceedsOnArbitrary3,
  )
where

import Data.GenValidity
import Test.Hspec
import Test.QuickCheck
import Test.Validity.Property.Utils
import Test.Validity.Types

-- | The function succeeds if the input is generated by the given generator
succeedsOnGen ::
  (Show a, Show (f b), CanFail f) => (a -> f b) -> Gen a -> (a -> [a]) -> Property
succeedsOnGen :: (a -> f b) -> Gen a -> (a -> [a]) -> Property
succeedsOnGen a -> f b
func Gen a
gen a -> [a]
s = Gen a -> (a -> [a]) -> (a -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen a
gen a -> [a]
s ((a -> Expectation) -> Property) -> (a -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \a
a -> a -> f b
func a
a f b -> (f b -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (Bool -> Bool
not (Bool -> Bool) -> (f b -> Bool) -> f b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f b -> Bool
forall (f :: * -> *) a. CanFail f => f a -> Bool
hasFailed)

-- | The function succeeds if the input is generated by @genValid@
succeeds :: (Show a, Show (f b), GenValid a, CanFail f) => (a -> f b) -> Property
succeeds :: (a -> f b) -> Property
succeeds a -> f b
f = (a -> f b) -> Gen a -> (a -> [a]) -> Property
forall a (f :: * -> *) b.
(Show a, Show (f b), CanFail f) =>
(a -> f b) -> Gen a -> (a -> [a]) -> Property
succeedsOnGen a -> f b
f Gen a
forall a. GenValid a => Gen a
genValid a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid

-- | The function succeeds if the input is generated by @arbitrary@
succeedsOnArbitrary ::
  (Show a, Show (f b), Arbitrary a, CanFail f) => (a -> f b) -> Property
succeedsOnArbitrary :: (a -> f b) -> Property
succeedsOnArbitrary a -> f b
f = (a -> f b) -> Gen a -> (a -> [a]) -> Property
forall a (f :: * -> *) b.
(Show a, Show (f b), CanFail f) =>
(a -> f b) -> Gen a -> (a -> [a]) -> Property
succeedsOnGen a -> f b
f Gen a
forall a. Arbitrary a => Gen a
arbitrary a -> [a]
forall a. Arbitrary a => a -> [a]
shrink

-- | The function fails if the input is generated by the given generator
failsOnGen ::
  (Show a, Show (f b), CanFail f) => (a -> f b) -> Gen a -> (a -> [a]) -> Property
failsOnGen :: (a -> f b) -> Gen a -> (a -> [a]) -> Property
failsOnGen a -> f b
func Gen a
gen a -> [a]
s = Gen a -> (a -> [a]) -> (a -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen a
gen a -> [a]
s ((a -> Expectation) -> Property) -> (a -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \a
a -> a -> f b
func a
a f b -> (f b -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` f b -> Bool
forall (f :: * -> *) a. CanFail f => f a -> Bool
hasFailed

-- | The function produces output that satisfies @isValid@ if it is given input
-- that is generated by the given generator.
validIfSucceedsOnGen ::
  (Show a, Show b, Validity b, CanFail f) => (a -> f b) -> Gen a -> (a -> [a]) -> Property
validIfSucceedsOnGen :: (a -> f b) -> Gen a -> (a -> [a]) -> Property
validIfSucceedsOnGen a -> f b
func Gen a
gen a -> [a]
s =
  Gen a -> (a -> [a]) -> (a -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen a
gen a -> [a]
s ((a -> Expectation) -> Property) -> (a -> Expectation) -> 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
func a
a) of
      Maybe b
Nothing -> () -> Expectation
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Can happen
      Just b
res -> b -> Expectation
forall a. (Show a, Validity a) => a -> Expectation
shouldBeValid b
res

-- | The function produces output that satisfies @isValid@ if it is given input
-- that is generated by @arbitrary@.
validIfSucceedsOnArbitrary ::
  (Show a, Show b, Arbitrary a, Validity b, CanFail f) => (a -> f b) -> Property
validIfSucceedsOnArbitrary :: (a -> f b) -> Property
validIfSucceedsOnArbitrary a -> f b
f = (a -> f b) -> Gen a -> (a -> [a]) -> Property
forall a b (f :: * -> *).
(Show a, Show b, Validity b, CanFail f) =>
(a -> f b) -> Gen a -> (a -> [a]) -> Property
validIfSucceedsOnGen a -> f b
f Gen a
forall a. Arbitrary a => Gen a
arbitrary a -> [a]
forall a. Arbitrary a => a -> [a]
shrink

-- | The function produces output that satisfies @isValid@ if it is given input
-- that is generated by @genValid@.
validIfSucceeds :: (Show a, Show b, GenValid a, Validity b, CanFail f) => (a -> f b) -> Property
validIfSucceeds :: (a -> f b) -> Property
validIfSucceeds a -> f b
f = (a -> f b) -> Gen a -> (a -> [a]) -> Property
forall a b (f :: * -> *).
(Show a, Show b, Validity b, CanFail f) =>
(a -> f b) -> Gen a -> (a -> [a]) -> Property
validIfSucceedsOnGen a -> f b
f Gen a
forall a. GenValid a => Gen a
genValid a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid

succeedsOnGens2 ::
  (Show a, Show b, Show (f c), CanFail f) =>
  (a -> b -> f c) ->
  Gen (a, b) ->
  ((a, b) -> [(a, b)]) ->
  Property
succeedsOnGens2 :: (a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
succeedsOnGens2 a -> b -> f c
func Gen (a, b)
gen (a, b) -> [(a, b)]
s =
  Gen (a, b)
-> ((a, b) -> [(a, b)]) -> ((a, b) -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen (a, b)
gen (a, b) -> [(a, b)]
s (((a, b) -> Expectation) -> Property)
-> ((a, b) -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a, b
b) -> a -> b -> f c
func a
a b
b f c -> (f c -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (Bool -> Bool
not (Bool -> Bool) -> (f c -> Bool) -> f c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f c -> Bool
forall (f :: * -> *) a. CanFail f => f a -> Bool
hasFailed)

succeeds2 ::
  (Show a, Show b, Show (f c), GenValid a, GenValid b, CanFail f) =>
  (a -> b -> f c) ->
  Property
succeeds2 :: (a -> b -> f c) -> Property
succeeds2 a -> b -> f c
func = (a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
forall a b (f :: * -> *) c.
(Show a, Show b, Show (f c), CanFail f) =>
(a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
succeedsOnGens2 a -> b -> f c
func Gen (a, b)
forall a. GenValid a => Gen a
genValid (a, b) -> [(a, b)]
forall a. GenValid a => a -> [a]
shrinkValid

succeedsOnArbitrary2 ::
  (Show a, Show b, Show (f c), Arbitrary a, Arbitrary b, CanFail f) =>
  (a -> b -> f c) ->
  Property
succeedsOnArbitrary2 :: (a -> b -> f c) -> Property
succeedsOnArbitrary2 a -> b -> f c
func = (a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
forall a b (f :: * -> *) c.
(Show a, Show b, Show (f c), CanFail f) =>
(a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
succeedsOnGens2 a -> b -> f c
func Gen (a, b)
forall a. Arbitrary a => Gen a
arbitrary (a, b) -> [(a, b)]
forall a. Arbitrary a => a -> [a]
shrink

failsOnGens2 ::
  (Show a, Show b, Show (f c), CanFail f) =>
  (a -> b -> f c) ->
  Gen a ->
  (a -> [a]) ->
  Gen b ->
  (b -> [b]) ->
  Property
failsOnGens2 :: (a -> b -> f c)
-> Gen a -> (a -> [a]) -> Gen b -> (b -> [b]) -> Property
failsOnGens2 a -> b -> f c
func Gen a
genA a -> [a]
sA Gen b
genB b -> [b]
sB =
  Gen a -> (a -> [a]) -> (a -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen a
genA a -> [a]
sA ((a -> Property) -> Property) -> (a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \a
a -> Gen b -> (b -> [b]) -> (b -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen b
genB b -> [b]
sB ((b -> Expectation) -> Property) -> (b -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \b
b -> a -> b -> f c
func a
a b
b f c -> (f c -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` f c -> Bool
forall (f :: * -> *) a. CanFail f => f a -> Bool
hasFailed

validIfSucceedsOnGens2 ::
  (Show a, Show b, Show c, Validity c, CanFail f) =>
  (a -> b -> f c) ->
  Gen (a, b) ->
  ((a, b) -> [(a, b)]) ->
  Property
validIfSucceedsOnGens2 :: (a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
validIfSucceedsOnGens2 a -> b -> f c
func Gen (a, b)
gen (a, b) -> [(a, b)]
s =
  Gen (a, b)
-> ((a, b) -> [(a, b)]) -> ((a, b) -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen (a, b)
gen (a, b) -> [(a, b)]
s (((a, b) -> Expectation) -> Property)
-> ((a, b) -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a, b
b) ->
    case f c -> Maybe c
forall (f :: * -> *) a. CanFail f => f a -> Maybe a
resultIfSucceeded (a -> b -> f c
func a
a b
b) of
      Maybe c
Nothing -> () -> Expectation
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Can happen
      Just c
res -> c -> Expectation
forall a. (Show a, Validity a) => a -> Expectation
shouldBeValid c
res

validIfSucceeds2 ::
  (Show a, Show b, Show c, GenValid a, GenValid b, Validity c, CanFail f) =>
  (a -> b -> f c) ->
  Property
validIfSucceeds2 :: (a -> b -> f c) -> Property
validIfSucceeds2 a -> b -> f c
func = (a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
forall a b c (f :: * -> *).
(Show a, Show b, Show c, Validity c, CanFail f) =>
(a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
validIfSucceedsOnGens2 a -> b -> f c
func Gen (a, b)
forall a. GenValid a => Gen a
genValid (a, b) -> [(a, b)]
forall a. GenValid a => a -> [a]
shrinkValid

validIfSucceedsOnArbitrary2 ::
  (Show a, Show b, Show c, Arbitrary a, Arbitrary b, Validity c, CanFail f) =>
  (a -> b -> f c) ->
  Property
validIfSucceedsOnArbitrary2 :: (a -> b -> f c) -> Property
validIfSucceedsOnArbitrary2 a -> b -> f c
func = (a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
forall a b c (f :: * -> *).
(Show a, Show b, Show c, Validity c, CanFail f) =>
(a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
validIfSucceedsOnGens2 a -> b -> f c
func Gen (a, b)
forall a. Arbitrary a => Gen a
arbitrary (a, b) -> [(a, b)]
forall a. Arbitrary a => a -> [a]
shrink

validIfSucceedsOnGens3 ::
  (Show a, Show b, Show c, Show d, Validity d, CanFail f) =>
  (a -> b -> c -> f d) ->
  Gen (a, b, c) ->
  ((a, b, c) -> [(a, b, c)]) ->
  Property
validIfSucceedsOnGens3 :: (a -> b -> c -> f d)
-> Gen (a, b, c) -> ((a, b, c) -> [(a, b, c)]) -> Property
validIfSucceedsOnGens3 a -> b -> c -> f d
func Gen (a, b, c)
gen (a, b, c) -> [(a, b, c)]
s =
  Gen (a, b, c)
-> ((a, b, c) -> [(a, b, c)])
-> ((a, b, c) -> Expectation)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen (a, b, c)
gen (a, b, c) -> [(a, b, c)]
s (((a, b, c) -> Expectation) -> Property)
-> ((a, b, c) -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a, b
b, c
c) ->
    case f d -> Maybe d
forall (f :: * -> *) a. CanFail f => f a -> Maybe a
resultIfSucceeded (a -> b -> c -> f d
func a
a b
b c
c) of
      Maybe d
Nothing -> () -> Expectation
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Can happen
      Just d
res -> d -> Expectation
forall a. (Show a, Validity a) => a -> Expectation
shouldBeValid d
res

validIfSucceeds3 ::
  ( Show a,
    Show b,
    Show c,
    Show d,
    GenValid a,
    GenValid b,
    GenValid c,
    Validity d,
    CanFail f
  ) =>
  (a -> b -> c -> f d) ->
  Property
validIfSucceeds3 :: (a -> b -> c -> f d) -> Property
validIfSucceeds3 a -> b -> c -> f d
func = (a -> b -> c -> f d)
-> Gen (a, b, c) -> ((a, b, c) -> [(a, b, c)]) -> Property
forall a b c d (f :: * -> *).
(Show a, Show b, Show c, Show d, Validity d, CanFail f) =>
(a -> b -> c -> f d)
-> Gen (a, b, c) -> ((a, b, c) -> [(a, b, c)]) -> Property
validIfSucceedsOnGens3 a -> b -> c -> f d
func Gen (a, b, c)
forall a. GenValid a => Gen a
genValid (a, b, c) -> [(a, b, c)]
forall a. GenValid a => a -> [a]
shrinkValid

validIfSucceedsOnArbitrary3 ::
  (Show a, Show b, Show c, Show d, Arbitrary a, Arbitrary b, Arbitrary c, Validity d, CanFail f) =>
  (a -> b -> c -> f d) ->
  Property
validIfSucceedsOnArbitrary3 :: (a -> b -> c -> f d) -> Property
validIfSucceedsOnArbitrary3 a -> b -> c -> f d
func = (a -> b -> c -> f d)
-> Gen (a, b, c) -> ((a, b, c) -> [(a, b, c)]) -> Property
forall a b c d (f :: * -> *).
(Show a, Show b, Show c, Show d, Validity d, CanFail f) =>
(a -> b -> c -> f d)
-> Gen (a, b, c) -> ((a, b, c) -> [(a, b, c)]) -> Property
validIfSucceedsOnGens3 a -> b -> c -> f d
func Gen (a, b, c)
forall a. Arbitrary a => Gen a
arbitrary (a, b, c) -> [(a, b, c)]
forall a. Arbitrary a => a -> [a]
shrink