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

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

    import Data.Data

    import Data.GenValidity

    import Test.Hspec
    import Test.QuickCheck

    import Test.Validity.Functions
    import Test.Validity.Utils

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

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

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

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

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

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

    -- | Standard test spec for properties of Applicative instances for values generated with GenUnchecked instances
    --
    -- Example usage:
    --
    -- > applicativeSpecOnArbitrary @[]
    applicativeSpec ::
           forall (f :: * -> *).
           ( Eq (f Int)
           , Show (f Int)
           , Applicative f
           , Typeable f
           , GenUnchecked (f Int)
           )
        => Spec
    applicativeSpec = applicativeSpecWithInts @f genUnchecked

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

    applicativeSpecWithInts ::
           forall (f :: * -> *).
           (Show (f Int), Eq (f Int), Applicative f, Typeable f)
        => Gen (f Int)
        -> Spec
    applicativeSpecWithInts gen =
        applicativeSpecOnGens
            @f
            @Int
            genUnchecked
            "int"
            gen
            (unwords [nameOf @f, "of ints"])
            gen
            (unwords [nameOf @f, "of ints"])
            ((+) <$> genUnchecked)
            "increments"
            (pure <$> ((+) <$> genUnchecked))
            (unwords [nameOf @f, "of increments"])
            (pure <$> ((*) <$> genUnchecked))
            (unwords [nameOf @f, "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 :: * -> *) (a :: *) (b :: *) (c :: *).
           ( Show a
           , Eq 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 gena genaname gen genname genb genbname genfa genfaname genffa genffaname genffb genffbname =
        parallel $
        describe ("Applicative " ++ nameOf @f) $ do
            describe (unwords [pureTypeStr @f, "and", seqTypeStr @f]) $ do
                it
                    (unwords
                         [ "satisfy the identity law: 'pure id <*> v = v' for"
                         , genDescr @(f a) genname
                         ]) $
                    equivalentOnGen (pure id <*>) id gen shrinkNothing
                it
                    (unwords
                         [ "satisfy the composition law: 'pure (.) <*> u <*> v <*> w = u <*> (v <*> w)' for"
                         , genDescr @(f (b -> c)) genffbname
                         , "composed with"
                         , genDescr @(f (a -> b)) genffaname
                         , "and applied to"
                         , genDescr @(f a) genname
                         ]) $
                    equivalentOnGens3
                        (\(Anon u) (Anon v) w ->
                             pure (.) <*> (u :: f (b -> c)) <*> (v :: f (a -> b)) <*>
                             (w :: f a) :: f c)
                        (\(Anon u) (Anon v) w -> u <*> (v <*> w) :: f c)
                        ((,,) <$> (Anon <$> genffb) <*> (Anon <$> genffa) <*> gen)
                        shrinkNothing
                it
                    (unwords
                         [ "satisfy the homomorphism law: 'pure f <*> pure x = pure (f x)' for"
                         , genDescr @(a -> b) genfaname
                         , "sequenced with"
                         , genDescr @a genaname
                         ]) $
                    equivalentOnGens2
                        (\(Anon f) x -> pure f <*> pure x :: f b)
                        (\(Anon f) x -> pure $ f x :: f b)
                        ((,) <$> (Anon <$> genfa) <*> gena)
                        shrinkNothing
                it
                    (unwords
                         [ "satisfy the interchange law: 'u <*> pure y = pure ($ y) <*> u' for"
                         , genDescr @(f (a -> b)) genffaname
                         , "sequenced with"
                         , genDescr @a genaname
                         ]) $
                    equivalentOnGens2
                        (\(Anon u) y -> u <*> pure y :: f b)
                        (\(Anon u) y -> pure ($ y) <*> u :: f b)
                        ((,) <$> (Anon <$> genffa) <*> gena)
                        shrinkNothing
                it
                    (unwords
                         [ "satisfy the law about the functor instance: fmap f x = pure f <*> x for"
                         , genDescr @(a -> b) genfaname
                         , "mapped over"
                         , genDescr @(f a) genname
                         ]) $
                    equivalentOnGens2
                        (\(Anon f) x -> fmap f x)
                        (\(Anon f) x -> pure f <*> x)
                        ((,) <$> (Anon <$> genfa) <*> gen)
                        shrinkNothing
            describe (seqrTypeStr @f) $
                it
                    (unwords
                         [ "is equivalent to its default implementation 'u *> v = pure (const id) <*> u <*> v' for"
                         , genDescr @(f a) genname
                         , "in front of"
                         , genDescr @b genbname
                         ]) $
                equivalentOnGens2
                    (\u v -> u *> v)
                    (\u v -> pure (const id) <*> u <*> v)
                    ((,) <$> gen <*> genb)
                    shrinkNothing
            describe (seqlTypeStr @f) $
                it
                    (unwords
                         [ "is equivalent to its default implementation 'u <* v = pure const <*> u <*> v' for"
                         , genDescr @b genbname
                         , "behind"
                         , genDescr @(f a) genname
                         ]) $
                equivalentOnGens2
                    (\u v -> u <* v)
                    (\u v -> pure const <*> u <*> v)
                    ((,) <$> gen <*> genb)
                    shrinkNothing