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

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

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

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

fmapTypeStr ::
  forall (f :: Type -> Type).
  (Typeable f) =>
  String
fmapTypeStr :: forall (f :: * -> *). Typeable f => String
fmapTypeStr =
  [String] -> String
unwords
    [ String
"fmap",
      String
"::",
      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"
    ]

flTypeStr ::
  forall (f :: Type -> Type).
  (Typeable f) =>
  String
flTypeStr :: forall (f :: * -> *). Typeable f => String
flTypeStr =
  [String] -> String
unwords [String
"(<$)", String
"::", 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 Functor instances for values generated with GenValid instances
--
-- Example usage:
--
-- > functorSpecOnArbitrary @[]
functorSpec ::
  forall (f :: Type -> Type).
  (Eq (f Int), Show (f Int), Functor f, Typeable f, GenValid (f Int)) =>
  Spec
functorSpec :: forall (f :: * -> *).
(Eq (f Int), Show (f Int), Functor f, Typeable f,
 GenValid (f Int)) =>
Spec
functorSpec = forall (f :: * -> *).
(Eq (f Int), Show (f Int), Functor f, Typeable f) =>
Gen (f Int) -> Spec
functorSpecWithInts @f forall a. GenValid a => Gen a
genValid

-- | 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 :: forall (f :: * -> *).
(Eq (f Int), Show (f Int), Functor f, Typeable f,
 Arbitrary (f Int)) =>
Spec
functorSpecOnArbitrary = forall (f :: * -> *).
(Eq (f Int), Show (f Int), Functor f, Typeable f) =>
Gen (f Int) -> Spec
functorSpecWithInts @f 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 :: forall (f :: * -> *).
(Eq (f Int), Show (f Int), Functor f, Typeable f) =>
Gen (f Int) -> Spec
functorSpecWithInts Gen (f Int)
gen =
  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
    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"])
    (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 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
"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 :: 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 Gen a
gena String
genaname Gen (f a)
gen String
genname Gen (b -> c)
genf String
genfname Gen (a -> b)
geng String
gengname =
  forall a. SpecWith a -> SpecWith a
parallel forall a b. (a -> b) -> a -> b
$
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String
"Functor " 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 (forall (f :: * -> *). Typeable f => String
fmapTypeStr @f) forall a b. (a -> b) -> a -> b
$ do
        forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
          ( [String] -> String
unwords
              [ String
"satisfies the first Fuctor law: 'fmap id == id' 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 b. Functor f => (a -> b) -> f a -> f b
fmap @f forall a. a -> a
id) (forall a. a -> a
id @(f a)) Gen (f a)
gen forall a. a -> [a]
shrinkNothing
        forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
          ( [String] -> String
unwords
              [ String
"satisfieds the second Functor law: 'fmap (f . g) == fmap f . fmap g' for",
                forall {k} (a :: k). Typeable a => String -> String
genDescr @(f a) String
genname,
                String
"'s",
                String
"given to",
                forall {k} (a :: k). Typeable a => String -> String
genDescr @(b -> c) String
genfname,
                String
"and",
                forall {k} (a :: k). Typeable a => String -> String
genDescr @(a -> b) String
gengname
              ]
          )
          forall a b. (a -> b) -> a -> b
$ forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (forall a. a -> Anon a
Anon forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (b -> c)
genf)
          forall a b. (a -> b) -> a -> b
$ \(Anon b -> c
f) ->
            forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (forall a. a -> Anon a
Anon forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (a -> b)
geng) forall a b. (a -> b) -> a -> b
$ \(Anon a -> b
g) ->
              forall a b.
(Show a, Show b, Eq b) =>
(a -> b) -> (a -> b) -> Gen a -> (a -> [a]) -> Property
equivalentOnGen
                (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
g))
                (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
g)
                Gen (f a)
gen
                forall a. a -> [a]
shrinkNothing
      forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (forall (f :: * -> *). Typeable f => String
flTypeStr @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 for",
                forall {k} (a :: k). Typeable a => String -> String
genDescr @a String
genaname,
                String
"and",
                forall {k} (a :: k). Typeable a => String -> String
genDescr @(f a) String
genname
              ]
          )
        forall a b. (a -> b) -> a -> b
$ forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
gena
        forall a b. (a -> b) -> a -> b
$ \a
a ->
          forall a b.
(Show a, Show b, Eq b) =>
(a -> b) -> (a -> b) -> Gen a -> (a -> [a]) -> Property
equivalentOnGen (a
a forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const a
a) Gen (f a)
gen forall a. a -> [a]
shrinkNothing