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

-- | Monoid properties
--
-- You will need @TypeApplications@ to use these.
module Test.Validity.Monoid
  ( monoidSpecOnValid,
    monoidSpec,
    monoidSpecOnArbitrary,
    monoidSpecOnGen,
  )
where

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

memptyTypeStr ::
  forall a.
  Typeable a =>
  String
memptyTypeStr :: forall a. Typeable a => String
memptyTypeStr = [String] -> String
unwords [String
"mempty", String
"::", forall {k} (a :: k). Typeable a => String
nameOf @a]

mappendTypeStr ::
  forall a.
  Typeable a =>
  String
mappendTypeStr :: forall a. Typeable a => String
mappendTypeStr = [String] -> String
unwords [String
"mappend", String
"::", String
an, String
"->", String
an, String
"->", String
an]
  where
    an :: String
an = forall {k} (a :: k). Typeable a => String
nameOf @a

mconcatTypeStr ::
  forall a.
  Typeable a =>
  String
mconcatTypeStr :: forall a. Typeable a => String
mconcatTypeStr = [String] -> String
unwords [String
"mconcat", String
"::", String
"[" forall a. [a] -> [a] -> [a]
++ String
an forall a. [a] -> [a] -> [a]
++ String
"]", String
"->", String
an]
  where
    an :: String
an = forall {k} (a :: k). Typeable a => String
nameOf @a

-- | Standard test spec for properties of 'Monoid' instances for valid values
--
-- Example usage:
--
-- > monoidSpecOnValid @[Double]
monoidSpecOnValid ::
  forall a.
  (Show a, Eq a, Monoid a, Typeable a, GenValid a) =>
  Spec
monoidSpecOnValid :: forall a. (Show a, Eq a, Monoid a, Typeable a, GenValid a) => Spec
monoidSpecOnValid = forall a.
(Show a, Eq a, Monoid a, Typeable a) =>
Gen a -> String -> (a -> [a]) -> Spec
monoidSpecOnGen @a forall a. GenValid a => Gen a
genValid String
"valid" forall a. GenValid a => a -> [a]
shrinkValid

-- | Standard test spec for properties of 'Monoid' instances for valid values
--
-- Example usage:
--
-- > monoidSpec @[Int]
monoidSpec ::
  forall a.
  (Show a, Eq a, Monoid a, Typeable a, GenValid a) =>
  Spec
monoidSpec :: forall a. (Show a, Eq a, Monoid a, Typeable a, GenValid a) => Spec
monoidSpec = forall a.
(Show a, Eq a, Monoid a, Typeable a) =>
Gen a -> String -> (a -> [a]) -> Spec
monoidSpecOnGen @a forall a. GenValid a => Gen a
genValid String
"valid" forall a. GenValid a => a -> [a]
shrinkValid

-- | Standard test spec for properties of 'Monoid' instances for arbitrary values
--
-- Example usage:
--
-- > monoidSpecOnArbitrary @[Int]
monoidSpecOnArbitrary ::
  forall a.
  (Show a, Eq a, Monoid a, Typeable a, Arbitrary a) =>
  Spec
monoidSpecOnArbitrary :: forall a. (Show a, Eq a, Monoid a, Typeable a, Arbitrary a) => Spec
monoidSpecOnArbitrary = forall a.
(Show a, Eq a, Monoid a, Typeable a) =>
Gen a -> String -> (a -> [a]) -> Spec
monoidSpecOnGen @a forall a. Arbitrary a => Gen a
arbitrary String
"arbitrary" forall a. Arbitrary a => a -> [a]
shrink

-- | Standard test spec for properties of Monoid instances for values generated by a given generator (and name for that generator).
--
-- Example usage:
--
-- > monoidSpecOnGen (pure "a") "singleton list of 'a'"
monoidSpecOnGen ::
  forall a.
  (Show a, Eq a, Monoid a, Typeable a) =>
  Gen a ->
  String ->
  (a -> [a]) ->
  Spec
monoidSpecOnGen :: forall a.
(Show a, Eq a, Monoid a, Typeable a) =>
Gen a -> String -> (a -> [a]) -> Spec
monoidSpecOnGen Gen a
gen String
genname a -> [a]
s =
  forall a. SpecWith a -> SpecWith a
parallel forall a b. (a -> b) -> a -> b
$ do
    let name :: String
name = forall {k} (a :: k). Typeable a => String
nameOf @a
        memptystr :: String
memptystr = forall a. Typeable a => String
memptyTypeStr @a
        mappendstr :: String
mappendstr = forall a. Typeable a => String
mappendTypeStr @a
        mconcatstr :: String
mconcatstr = forall a. Typeable a => String
mconcatTypeStr @a
        gen3 :: Gen (a, a, a)
gen3 = (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
gen forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
gen forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
gen
        s3 :: (a, a, a) -> [(a, a, a)]
s3 (a
a, a
b, a
c) = (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
s a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> [a]
s a
b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> [a]
s a
c
        genl :: Gen [a]
genl = forall a. Gen a -> Gen [a]
genListOf Gen a
gen
        sl :: [a] -> [[a]]
sl = forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList a -> [a]
s
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String
"Monoid " forall a. [a] -> [a] -> [a]
++ String
name) forall a b. (a -> b) -> a -> b
$ do
      let mem :: a
mem = forall a. Monoid a => a
mempty @a
          mapp :: a -> a -> a
mapp = forall a. Monoid a => a -> a -> a
mappend @a
          mcon :: [a] -> a
mcon = forall a. Monoid a => [a] -> a
mconcat @a
      forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
memptystr
        forall a b. (a -> b) -> a -> b
$ forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
          ( [String] -> String
unwords
              [ String
"is the identity for",
                String
mappendstr,
                String
"for",
                forall {k} (a :: k). Typeable a => String -> String
genDescr @a String
genname
              ]
          )
        forall a b. (a -> b) -> a -> b
$ forall a.
(Show a, Eq a) =>
(a -> a -> a) -> a -> Gen a -> (a -> [a]) -> Property
identityOnGen a -> a -> a
mapp a
mem Gen a
gen a -> [a]
s
      forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
mappendstr
        forall a b. (a -> b) -> a -> b
$ forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
          ( [String] -> String
unwords
              [ String
"is an associative operation for",
                forall {k} (a :: k). Typeable a => String -> String
genDescr @(a, a, a) String
genname
              ]
          )
        forall a b. (a -> b) -> a -> b
$ forall a.
(Show a, Eq a) =>
(a -> a -> a)
-> Gen (a, a, a) -> ((a, a, a) -> [(a, a, a)]) -> Property
associativeOnGens a -> a -> a
mapp Gen (a, a, a)
gen3 (a, a, a) -> [(a, a, a)]
s3
      forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
mconcatstr
        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
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 [a] -> a
mcon (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
mapp a
mem) Gen [a]
genl [a] -> [[a]]
sl