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

-- | Functor properties
--
-- You will need @TypeApplications@ to use these.
module Test.Syd.Validity.Functor
    ( functorSpecOnValid
    , functorSpec
    , functorSpecOnArbitrary
    , functorSpecOnGens
    ) where

import Data.Data

import Data.GenValidity
import Data.Kind

import Test.Syd
import Test.QuickCheck

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

{-# ANN module "HLint: ignore Functor law" #-}

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

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

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

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

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

functorSpecWithInts ::
       forall (f :: Type -> Type). (Eq (f Int), Show (f Int), Functor f, Typeable f)
    => Gen (f Int)
    -> Spec
functorSpecWithInts :: Gen (f Int) -> Spec
functorSpecWithInts Gen (f Int)
gen =
    Gen Int
-> String
-> Gen (f Int)
-> String
-> Gen (Int -> Int)
-> String
-> Gen (Int -> Int)
-> String
-> Spec
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
        @f
        @Int
        Gen Int
forall a. GenUnchecked a => Gen a
genUnchecked
        String
"int"
        Gen (f Int)
gen
        ([String] -> String
unwords [Typeable f => String
forall k (a :: k). Typeable a => String
nameOf @f, String
"of ints"])
        (Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int) -> Gen Int -> Gen (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
forall a. GenUnchecked a => Gen a
genUnchecked)
        String
"increments"
        (Int -> Int -> Int
forall a. Num a => a -> a -> a
(*) (Int -> Int -> Int) -> Gen Int -> Gen (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
forall a. GenUnchecked a => Gen a
genUnchecked)
        String
"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 :: Type -> Type) (a :: Type) (b :: Type) (c :: Type).
       ( 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 :: Gen a
-> String
-> Gen (f a)
-> String
-> Gen (b -> c)
-> String
-> Gen (a -> b)
-> String
-> Spec
functorSpecOnGens Gen a
gena String
genaname Gen (f a)
gen String
genname Gen (b -> c)
genf String
genfname Gen (a -> b)
geng String
gengname =
    Spec -> Spec
forall (a :: [*]) b c. TestDefM a b c -> TestDefM a b c
parallel (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
    String -> Spec -> Spec
forall (outers :: [*]) inner.
String -> TestDefM outers inner () -> TestDefM outers inner ()
describe (String
"Functor " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Typeable f => String
forall k (a :: k). Typeable a => String
nameOf @f) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
        String -> Spec -> Spec
forall (outers :: [*]) inner.
String -> TestDefM outers inner () -> TestDefM outers inner ()
describe (Typeable f => String
forall (f :: * -> *). Typeable f => String
fmapTypeStr @f) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
            String -> Property -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it
                ([String] -> String
unwords
                     [ String
"satisfies the first Fuctor law: 'fmap id == id' for"
                     , String -> String
forall k (a :: k). Typeable a => String -> String
genDescr @(f a) String
genname
                     ]) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
                (f a -> f a)
-> (f a -> f a) -> Gen (f a) -> (f a -> [f a]) -> Property
forall a b.
(Show a, Show b, Eq b) =>
(a -> b) -> (a -> b) -> Gen a -> (a -> [a]) -> Property
equivalentOnGen ((a -> a) -> f a -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap @f a -> a
forall a. a -> a
id) (f a -> f a
forall a. a -> a
id @(f a)) Gen (f a)
gen f a -> [f a]
forall a. a -> [a]
shrinkNothing
            String -> Property -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it
                ([String] -> String
unwords
                     [ String
"satisfieds the second Functor law: 'fmap (f . g) == fmap f . fmap g' for"
                     , String -> String
forall k (a :: k). Typeable a => String -> String
genDescr @(f a) String
genname
                     , String
"'s"
                     , String
"given to"
                     , String -> String
forall k (a :: k). Typeable a => String -> String
genDescr @(b -> c) String
genfname
                     , String
"and"
                     , String -> String
forall k (a :: k). Typeable a => String -> String
genDescr @(a -> b) String
gengname
                     ]) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
                Gen (Anon (b -> c)) -> (Anon (b -> c) -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll ((b -> c) -> Anon (b -> c)
forall a. a -> Anon a
Anon ((b -> c) -> Anon (b -> c)) -> Gen (b -> c) -> Gen (Anon (b -> c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (b -> c)
genf) ((Anon (b -> c) -> Property) -> Property)
-> (Anon (b -> c) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(Anon b -> c
f) ->
                    Gen (Anon (a -> b)) -> (Anon (a -> b) -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll ((a -> b) -> Anon (a -> b)
forall a. a -> Anon a
Anon ((a -> b) -> Anon (a -> b)) -> Gen (a -> b) -> Gen (Anon (a -> b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (a -> b)
geng) ((Anon (a -> b) -> Property) -> Property)
-> (Anon (a -> b) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(Anon a -> b
g) ->
                        (f a -> f c)
-> (f a -> f c) -> Gen (f a) -> (f a -> [f a]) -> Property
forall a b.
(Show a, Show b, Eq b) =>
(a -> b) -> (a -> b) -> Gen a -> (a -> [a]) -> Property
equivalentOnGen
                            ((a -> c) -> f a -> f c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> c
f (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
g))
                            ((b -> c) -> f b -> f c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
f (f b -> f c) -> (f a -> f b) -> f a -> f c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
g)
                            Gen (f a)
gen
                            f a -> [f a]
forall a. a -> [a]
shrinkNothing
        String -> Spec -> Spec
forall (outers :: [*]) inner.
String -> TestDefM outers inner () -> TestDefM outers inner ()
describe (Typeable f => String
forall (f :: * -> *). Typeable f => String
flTypeStr @f) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
            String -> Property -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it
                ([String] -> String
unwords
                     [ String
"is equivalent to its default implementation for"
                     , String -> String
forall k (a :: k). Typeable a => String -> String
genDescr @a String
genaname
                     , String
"and"
                     , String -> String
forall k (a :: k). Typeable a => String -> String
genDescr @(f a) String
genname
                     ]) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
            Gen a -> (a -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
gena ((a -> Property) -> Property) -> (a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \a
a ->
                (f a -> f a)
-> (f a -> f a) -> Gen (f a) -> (f a -> [f a]) -> Property
forall a b.
(Show a, Show b, Eq b) =>
(a -> b) -> (a -> b) -> Gen a -> (a -> [a]) -> Property
equivalentOnGen (a
a a -> f a -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) ((a -> a) -> f a -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> f a -> f a) -> (a -> a) -> f a -> f a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a b. a -> b -> a
const a
a) Gen (f a)
gen f a -> [f a]
forall a. a -> [a]
shrinkNothing