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

    -- | Functor properties
    --
    -- You will need @TypeApplications@ to use these.
    module Test.Validity.Functor
        ( functorSpecOnValid
        , functorSpec
        , functorSpecOnArbitrary
        , functorSpecOnGens
        ) 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 Functor law" #-}

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

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

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

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

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

    functorSpecWithInts ::
           forall (f :: * -> *). (Eq (f Int), Show (f Int), Functor f, Typeable f)
        => Gen (f Int)
        -> Spec
    functorSpecWithInts gen =
        functorSpecOnGens
            @f
            @Int
            genUnchecked
            "int"
            gen
            (unwords [nameOf @f, "of ints"])
            ((+) <$> genUnchecked)
            "increments"
            ((*) <$> genUnchecked)
            "scalings"

    -- | Standard test spec for properties of Functor instances for values generated by given generators (and names for those generator).
    --
    -- Example usage:
    --
    -- > functorSpecOnGens
    -- >     @[]
    -- >     @Int
    -- >     (pure 4) "four"
    -- >     (genListOf $ pure 5) "list of fives"
    -- >     ((+) <$> genValid) "additions"
    -- >     ((*) <$> genValid) "multiplications"
    functorSpecOnGens ::
           forall (f :: * -> *) (a :: *) (b :: *) (c :: *).
           ( Show a
           , Show (f a)
           , Show (f c)
           , Eq (f a)
           , Eq (f c)
           , Functor f
           , Typeable f
           , Typeable a
           , Typeable b
           , Typeable c
           )
        => Gen a
        -> String
        -> Gen (f a)
        -> String
        -> Gen (b -> c)
        -> String
        -> Gen (a -> b)
        -> String
        -> Spec
    functorSpecOnGens gena genaname gen genname genf genfname geng gengname =
        parallel $
        describe ("Functor " ++ nameOf @f) $ do
            describe (fmapTypeStr @f) $ do
                it
                    (unwords
                         [ "satisfies the first Fuctor law: 'fmap id == id' for"
                         , genDescr @(f a) genname
                         ]) $
                    equivalentOnGen (fmap @f id) (id @(f a)) gen shrinkNothing
                it
                    (unwords
                         [ "satisfieds the second Functor law: 'fmap (f . g) == fmap f . fmap g' for"
                         , genDescr @(f a) genname
                         , "'s"
                         , "given to"
                         , genDescr @(b -> c) genfname
                         , "and"
                         , genDescr @(a -> b) gengname
                         ]) $
                    forAll (Anon <$> genf) $ \(Anon f) ->
                        forAll (Anon <$> geng) $ \(Anon g) ->
                            equivalentOnGen
                                (fmap (f . g))
                                (fmap f . fmap g)
                                gen
                                shrinkNothing
            describe (flTypeStr @f) $
                it
                    (unwords
                         [ "is equivalent to its default implementation for"
                         , genDescr @a genaname
                         , "and"
                         , genDescr @(f a) genname
                         ]) $
                forAll gena $ \a ->
                    equivalentOnGen (a <$) (fmap $ const a) gen shrinkNothing