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

-- | Applicative properties
--
-- You will need @TypeApplications@ to use these.
module Test.Validity.Applicative
  ( applicativeSpec,
    applicativeSpecOnArbitrary,
    applicativeSpecOnGens,
  )
where

import Data.Data
import Data.GenValidity
import Data.Kind
import GHC.Stack
import Test.Hspec
import Test.QuickCheck
import Test.Validity.Functions
import Test.Validity.Utils

{-# ANN module "HLint: ignore Avoid lambda" #-}

pureTypeStr ::
  forall (f :: Type -> Type).
  (Typeable f) =>
  String
pureTypeStr :: forall (f :: * -> *). Typeable f => String
pureTypeStr = [String] -> String
unwords [String
"pure", String
"::", String
"a", String
"->", forall {k} (a :: k). Typeable a => String
nameOf @f, String
"a"]

seqTypeStr ::
  forall (f :: Type -> Type).
  (Typeable f) =>
  String
seqTypeStr :: forall (f :: * -> *). Typeable f => String
seqTypeStr =
  [String] -> String
unwords
    [ String
"(<*>)",
      String
"::",
      forall {k} (a :: k). Typeable a => String
nameOf @f,
      String
"(a",
      String
"->",
      String
"b)",
      String
"->",
      forall {k} (a :: k). Typeable a => String
nameOf @f,
      String
"a",
      String
"->",
      forall {k} (a :: k). Typeable a => String
nameOf @f,
      String
"b"
    ]

seqrTypeStr ::
  forall (f :: Type -> Type).
  (Typeable f) =>
  String
seqrTypeStr :: forall (f :: * -> *). Typeable f => String
seqrTypeStr =
  [String] -> String
unwords
    [ String
"(*>)",
      String
"::",
      forall {k} (a :: k). Typeable a => String
nameOf @f,
      String
"a",
      String
"->",
      forall {k} (a :: k). Typeable a => String
nameOf @f,
      String
"b",
      String
"->",
      forall {k} (a :: k). Typeable a => String
nameOf @f,
      String
"b"
    ]

seqlTypeStr ::
  forall (f :: Type -> Type).
  (Typeable f) =>
  String
seqlTypeStr :: forall (f :: * -> *). Typeable f => String
seqlTypeStr =
  [String] -> String
unwords
    [ String
"(<*)",
      String
"::",
      forall {k} (a :: k). Typeable a => String
nameOf @f,
      String
"a",
      String
"->",
      forall {k} (a :: k). Typeable a => String
nameOf @f,
      String
"b",
      String
"->",
      forall {k} (a :: k). Typeable a => String
nameOf @f,
      String
"a"
    ]

-- | Standard test spec for properties of Applicative instances for values generated with GenValid instances
--
-- Example usage:
--
-- > applicativeSpecOnArbitrary @[]
applicativeSpec ::
  forall (f :: Type -> Type).
  ( HasCallStack,
    Eq (f Int),
    Show (f Int),
    Applicative f,
    Typeable f,
    GenValid (f Int)
  ) =>
  Spec
applicativeSpec :: forall (f :: * -> *).
(HasCallStack, Eq (f Int), Show (f Int), Applicative f, Typeable f,
 GenValid (f Int)) =>
Spec
applicativeSpec = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
(HasCallStack, Show (f Int), Eq (f Int), Applicative f,
 Typeable f) =>
Gen (f Int) -> Spec
applicativeSpecWithInts @f forall a. GenValid a => Gen a
genValid

-- | Standard test spec for properties of Applicative instances for values generated with Arbitrary instances
--
-- Example usage:
--
-- > applicativeSpecOnArbitrary @[]
applicativeSpecOnArbitrary ::
  forall (f :: Type -> Type).
  ( HasCallStack,
    Eq (f Int),
    Show (f Int),
    Applicative f,
    Typeable f,
    Arbitrary (f Int)
  ) =>
  Spec
applicativeSpecOnArbitrary :: forall (f :: * -> *).
(HasCallStack, Eq (f Int), Show (f Int), Applicative f, Typeable f,
 Arbitrary (f Int)) =>
Spec
applicativeSpecOnArbitrary = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
(HasCallStack, Show (f Int), Eq (f Int), Applicative f,
 Typeable f) =>
Gen (f Int) -> Spec
applicativeSpecWithInts @f forall a. Arbitrary a => Gen a
arbitrary

applicativeSpecWithInts ::
  forall (f :: Type -> Type).
  (HasCallStack, Show (f Int), Eq (f Int), Applicative f, Typeable f) =>
  Gen (f Int) ->
  Spec
applicativeSpecWithInts :: forall (f :: * -> *).
(HasCallStack, Show (f Int), Eq (f Int), Applicative f,
 Typeable f) =>
Gen (f Int) -> Spec
applicativeSpecWithInts Gen (f Int)
gen =
  forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b c.
(HasCallStack, Show a, Show (f a), Eq (f a), Show (f b), Eq (f b),
 Show (f c), Eq (f c), Applicative f, Typeable f, Typeable a,
 Typeable b, Typeable c) =>
Gen a
-> String
-> Gen (f a)
-> String
-> Gen (f b)
-> String
-> Gen (a -> b)
-> String
-> Gen (f (a -> b))
-> String
-> Gen (f (b -> c))
-> String
-> Spec
applicativeSpecOnGens
      @f
      @Int
      forall a. GenValid a => Gen a
genValid
      String
"int"
      Gen (f Int)
gen
      ([String] -> String
unwords [forall {k} (a :: k). Typeable a => String
nameOf @f, String
"of ints"])
      Gen (f Int)
gen
      ([String] -> String
unwords [forall {k} (a :: k). Typeable a => String
nameOf @f, String
"of ints"])
      (forall a. Num a => a -> a -> a
(+) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. GenValid a => Gen a
genValid)
      String
"increments"
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Num a => a -> a -> a
(+) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. GenValid a => Gen a
genValid))
      ([String] -> String
unwords [forall {k} (a :: k). Typeable a => String
nameOf @f, String
"of increments"])
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Num a => a -> a -> a
(*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. GenValid a => Gen a
genValid))
      ([String] -> String
unwords [forall {k} (a :: k). Typeable a => String
nameOf @f, String
"of scalings"])

-- | Standard test spec for properties of Applicative instances for values generated by given generators (and names for those generator).
--
-- Unless you are building a specific regression test, you probably want to use the other 'applicativeSpec' functions.
--
-- Example usage:
--
-- > applicativeSpecOnGens
-- >     @Maybe
-- >     @String
-- >     (pure "ABC")
-- >     "ABC"
-- >     (Just <$> pure "ABC")
-- >     "Just an ABC"
-- >     (pure Nothing)
-- >     "purely Nothing"
-- >     ((++) <$> genValid)
-- >     "prepends"
-- >     (pure <$> ((++) <$> genValid))
-- >     "prepends in a Just"
-- >     (pure <$> (flip (++) <$> genValid))
-- >     "appends in a Just"
applicativeSpecOnGens ::
  forall (f :: Type -> Type) (a :: Type) (b :: Type) (c :: Type).
  ( HasCallStack,
    Show a,
    Show (f a),
    Eq (f a),
    Show (f b),
    Eq (f b),
    Show (f c),
    Eq (f c),
    Applicative f,
    Typeable f,
    Typeable a,
    Typeable b,
    Typeable c
  ) =>
  Gen a ->
  String ->
  Gen (f a) ->
  String ->
  Gen (f b) ->
  String ->
  Gen (a -> b) ->
  String ->
  Gen (f (a -> b)) ->
  String ->
  Gen (f (b -> c)) ->
  String ->
  Spec
applicativeSpecOnGens :: forall (f :: * -> *) a b c.
(HasCallStack, Show a, Show (f a), Eq (f a), Show (f b), Eq (f b),
 Show (f c), Eq (f c), Applicative f, Typeable f, Typeable a,
 Typeable b, Typeable c) =>
Gen a
-> String
-> Gen (f a)
-> String
-> Gen (f b)
-> String
-> Gen (a -> b)
-> String
-> Gen (f (a -> b))
-> String
-> Gen (f (b -> c))
-> String
-> Spec
applicativeSpecOnGens Gen a
gena String
genaname Gen (f a)
gen String
genname Gen (f b)
genb String
genbname Gen (a -> b)
genfa String
genfaname Gen (f (a -> b))
genffa String
genffaname Gen (f (b -> c))
genffb String
genffbname =
  forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$
    forall a. SpecWith a -> SpecWith a
parallel forall a b. (a -> b) -> a -> b
$
      forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String
"Applicative " forall a. [a] -> [a] -> [a]
++ forall {k} (a :: k). Typeable a => String
nameOf @f) forall a b. (a -> b) -> a -> b
$ do
        forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe ([String] -> String
unwords [forall (f :: * -> *). Typeable f => String
pureTypeStr @f, String
"and", forall (f :: * -> *). Typeable f => String
seqTypeStr @f]) forall a b. (a -> b) -> a -> b
$ do
          forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
            ( [String] -> String
unwords
                [ String
"satisfy the identity law: 'pure id <*> v = v' for",
                  forall {k} (a :: k). Typeable a => String -> String
genDescr @(f a) String
genname
                ]
            )
            forall a b. (a -> b) -> a -> b
$ forall a b.
(Show a, Show b, Eq b) =>
(a -> b) -> (a -> b) -> Gen a -> (a -> [a]) -> Property
equivalentOnGen (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>) forall a. a -> a
id Gen (f a)
gen forall a. a -> [a]
shrinkNothing
          forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
            ( [String] -> String
unwords
                [ String
"satisfy the composition law: 'pure (.) <*> u <*> v <*> w = u <*> (v <*> w)' for",
                  forall {k} (a :: k). Typeable a => String -> String
genDescr @(f (b -> c)) String
genffbname,
                  String
"composed with",
                  forall {k} (a :: k). Typeable a => String -> String
genDescr @(f (a -> b)) String
genffaname,
                  String
"and applied to",
                  forall {k} (a :: k). Typeable a => String -> String
genDescr @(f a) String
genname
                ]
            )
            forall a b. (a -> b) -> a -> b
$ forall a b c d.
(Show a, Show b, Show c, Show d, Eq d) =>
(a -> b -> c -> d)
-> (a -> b -> c -> d)
-> Gen (a, b, c)
-> ((a, b, c) -> [(a, b, c)])
-> Property
equivalentOnGens3
              ( \(Anon f (b -> c)
u) (Anon f (a -> b)
v) f a
w ->
                  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (f (b -> c)
u :: f (b -> c))
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (f (a -> b)
v :: f (a -> b))
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (f a
w :: f a) ::
                    f c
              )
              (\(Anon f (b -> c)
u) (Anon f (a -> b)
v) f a
w -> f (b -> c)
u forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (f (a -> b)
v forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
w) :: f c)
              ((,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Anon a
Anon forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (f (b -> c))
genffb) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. a -> Anon a
Anon forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (f (a -> b))
genffa) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (f a)
gen)
              forall a. a -> [a]
shrinkNothing
          forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
            ( [String] -> String
unwords
                [ String
"satisfy the homomorphism law: 'pure f <*> pure x = pure (f x)' for",
                  forall {k} (a :: k). Typeable a => String -> String
genDescr @(a -> b) String
genfaname,
                  String
"sequenced with",
                  forall {k} (a :: k). Typeable a => String -> String
genDescr @a String
genaname
                ]
            )
            forall a b. (a -> b) -> a -> b
$ forall a b c.
(Show a, Show b, Show c, Eq c) =>
(a -> b -> c)
-> (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
equivalentOnGens2
              (\(Anon a -> b
f) a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> b
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x :: f b)
              (\(Anon a -> b
f) a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ a -> b
f a
x :: f b)
              ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Anon a
Anon forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (a -> b)
genfa) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
gena)
              forall a. a -> [a]
shrinkNothing
          forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
            ( [String] -> String
unwords
                [ String
"satisfy the interchange law: 'u <*> pure y = pure ($ y) <*> u' for",
                  forall {k} (a :: k). Typeable a => String -> String
genDescr @(f (a -> b)) String
genffaname,
                  String
"sequenced with",
                  forall {k} (a :: k). Typeable a => String -> String
genDescr @a String
genaname
                ]
            )
            forall a b. (a -> b) -> a -> b
$ forall a b c.
(Show a, Show b, Show c, Eq c) =>
(a -> b -> c)
-> (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
equivalentOnGens2
              (\(Anon f (a -> b)
u) a
y -> f (a -> b)
u forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
y :: f b)
              (\(Anon f (a -> b)
u) a
y -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (a -> b) -> a -> b
$ a
y) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (a -> b)
u :: f b)
              ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Anon a
Anon forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (f (a -> b))
genffa) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
gena)
              forall a. a -> [a]
shrinkNothing
          forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
            ( [String] -> String
unwords
                [ String
"satisfy the law about the functor instance: fmap f x = pure f <*> x for",
                  forall {k} (a :: k). Typeable a => String -> String
genDescr @(a -> b) String
genfaname,
                  String
"mapped over",
                  forall {k} (a :: k). Typeable a => String -> String
genDescr @(f a) String
genname
                ]
            )
            forall a b. (a -> b) -> a -> b
$ forall a b c.
(Show a, Show b, Show c, Eq c) =>
(a -> b -> c)
-> (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
equivalentOnGens2
              (\(Anon a -> b
f) f a
x -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
x)
              (\(Anon a -> b
f) f a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> b
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
x)
              ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Anon a
Anon forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (a -> b)
genfa) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (f a)
gen)
              forall a. a -> [a]
shrinkNothing
        forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (forall (f :: * -> *). Typeable f => String
seqrTypeStr @f)
          forall a b. (a -> b) -> a -> b
$ forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
            ( [String] -> String
unwords
                [ String
"is equivalent to its default implementation 'u Type> v = pure (const id) <*> u <*> v' for",
                  forall {k} (a :: k). Typeable a => String -> String
genDescr @(f a) String
genname,
                  String
"in front of",
                  forall {k} (a :: k). Typeable a => String -> String
genDescr @b String
genbname
                ]
            )
          forall a b. (a -> b) -> a -> b
$ forall a b c.
(Show a, Show b, Show c, Eq c) =>
(a -> b -> c)
-> (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
equivalentOnGens2
            (\f a
u f b
v -> f a
u forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f b
v)
            (\f a
u f b
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> b -> a
const forall a. a -> a
id) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
u forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f b
v)
            ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (f a)
gen forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (f b)
genb)
            forall a. a -> [a]
shrinkNothing
        forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (forall (f :: * -> *). Typeable f => String
seqlTypeStr @f)
          forall a b. (a -> b) -> a -> b
$ forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
            ( [String] -> String
unwords
                [ String
"is equivalent to its default implementation 'u <* v = pure const <*> u <*> v' for",
                  forall {k} (a :: k). Typeable a => String -> String
genDescr @b String
genbname,
                  String
"behind",
                  forall {k} (a :: k). Typeable a => String -> String
genDescr @(f a) String
genname
                ]
            )
          forall a b. (a -> b) -> a -> b
$ forall a b c.
(Show a, Show b, Show c, Eq c) =>
(a -> b -> c)
-> (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
equivalentOnGens2
            (\f a
u f b
v -> f a
u forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* f b
v)
            (\f a
u f b
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. a -> b -> a
const forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
u forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f b
v)
            ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (f a)
gen forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (f b)
genb)
            forall a. a -> [a]
shrinkNothing