{-# 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 :: String
memptyTypeStr = [String] -> String
unwords [String
"mempty", String
"::", Typeable a => String
forall k (a :: k). Typeable a => String
nameOf @a]

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

mconcatTypeStr ::
  forall a.
  Typeable a =>
  String
mconcatTypeStr :: String
mconcatTypeStr = [String] -> String
unwords [String
"mconcat", String
"::", String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
an String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]", String
"->", String
an]
  where
    an :: String
an = Typeable a => String
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 :: Spec
monoidSpecOnValid = Gen a -> String -> (a -> [a]) -> Spec
forall a.
(Show a, Eq a, Monoid a, Typeable a) =>
Gen a -> String -> (a -> [a]) -> Spec
monoidSpecOnGen @a Gen a
forall a. GenValid a => Gen a
genValid String
"valid" a -> [a]
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 :: Spec
monoidSpec = Gen a -> String -> (a -> [a]) -> Spec
forall a.
(Show a, Eq a, Monoid a, Typeable a) =>
Gen a -> String -> (a -> [a]) -> Spec
monoidSpecOnGen @a Gen a
forall a. GenValid a => Gen a
genValid String
"valid" a -> [a]
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 :: Spec
monoidSpecOnArbitrary = Gen a -> String -> (a -> [a]) -> Spec
forall a.
(Show a, Eq a, Monoid a, Typeable a) =>
Gen a -> String -> (a -> [a]) -> Spec
monoidSpecOnGen @a Gen a
forall a. Arbitrary a => Gen a
arbitrary String
"arbitrary" a -> [a]
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 :: Gen a -> String -> (a -> [a]) -> Spec
monoidSpecOnGen Gen a
gen String
genname a -> [a]
s =
  Spec -> Spec
forall a. SpecWith a -> SpecWith a
parallel (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    let name :: String
name = Typeable a => String
forall k (a :: k). Typeable a => String
nameOf @a
        memptystr :: String
memptystr = Typeable a => String
forall a. Typeable a => String
memptyTypeStr @a
        mappendstr :: String
mappendstr = Typeable a => String
forall a. Typeable a => String
mappendTypeStr @a
        mconcatstr :: String
mconcatstr = Typeable a => String
forall a. Typeable a => String
mconcatTypeStr @a
        gen3 :: Gen (a, a, a)
gen3 = (,,) (a -> a -> a -> (a, a, a)) -> Gen a -> Gen (a -> a -> (a, a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
gen Gen (a -> a -> (a, a, a)) -> Gen a -> Gen (a -> (a, a, a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
gen Gen (a -> (a, a, a)) -> Gen a -> Gen (a, a, a)
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) = (,,) (a -> a -> a -> (a, a, a)) -> [a] -> [a -> a -> (a, a, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
s a
a [a -> a -> (a, a, a)] -> [a] -> [a -> (a, a, a)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> [a]
s a
b [a -> (a, a, a)] -> [a] -> [(a, a, a)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> [a]
s a
c
        genl :: Gen [a]
genl = Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
genListOf Gen a
gen
        sl :: [a] -> [[a]]
sl = (a -> [a]) -> [a] -> [[a]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList a -> [a]
s
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String
"Monoid " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      let mem :: a
mem = Monoid a => a
forall a. Monoid a => a
mempty @a
          mapp :: a -> a -> a
mapp = Monoid a => a -> a -> a
forall a. Monoid a => a -> a -> a
mappend @a
          mcon :: [a] -> a
mcon = Monoid a => [a] -> a
forall a. Monoid a => [a] -> a
mconcat @a
      String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
memptystr (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
        String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
          ( [String] -> String
unwords
              [ String
"is the identity for",
                String
mappendstr,
                String
"for",
                String -> String
forall k (a :: k). Typeable a => String -> String
genDescr @a String
genname
              ]
          )
          (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> a -> Gen a -> (a -> [a]) -> Property
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
      String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
mappendstr (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
        String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
          ( [String] -> String
unwords
              [ String
"is an associative operation for",
                String -> String
forall k (a :: k). Typeable a => String -> String
genDescr @(a, a, a) String
genname
              ]
          )
          (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ (a -> a -> a)
-> Gen (a, a, a) -> ((a, a, a) -> [(a, a, a)]) -> Property
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
      String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
mconcatstr (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
        String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
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
genname
              ]
          )
          (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ ([a] -> a) -> ([a] -> a) -> Gen [a] -> ([a] -> [[a]]) -> Property
forall a b.
(Show a, Show b, Eq b) =>
(a -> b) -> (a -> b) -> Gen a -> (a -> [a]) -> Property
equivalentOnGen [a] -> a
mcon ((a -> a -> a) -> a -> [a] -> a
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