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

-- | 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 = unwords ["mempty", "::", nameOf @a]

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

mconcatTypeStr ::
       forall a. Typeable a
    => String
mconcatTypeStr = unwords ["mconcat", "::", "[" ++ an ++ "]", "->", an]
  where
    an = 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 = monoidSpecOnGen @a genValid "valid" shrinkValid

-- | Standard test spec for properties of 'Monoid' instances for unchecked values
--
-- Example usage:
--
-- > monoidSpec @[Int]
monoidSpec ::
       forall a. (Show a, Eq a, Monoid a, Typeable a, GenUnchecked a)
    => Spec
monoidSpec = monoidSpecOnGen @a genUnchecked "unchecked" shrinkUnchecked

-- | 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 = monoidSpecOnGen @a arbitrary "arbitrary" 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 genname s =
    parallel $ do
        let name = nameOf @a
            memptystr = memptyTypeStr @a
            mappendstr = mappendTypeStr @a
            mconcatstr = mconcatTypeStr @a
            gen3 = (,,) <$> gen <*> gen <*> gen
            s3 (a, b, c) = (,,) <$> s a <*> s b <*> s c
            genl = genListOf gen
            sl = shrinkList s
        describe ("Monoid " ++ name) $ do
            let mem = mempty @a
                mapp = mappend @a
                mcon = mconcat @a
            describe memptystr $
                it
                    (unwords
                         [ "is the identity for"
                         , mappendstr
                         , "for"
                         , genDescr @a genname
                         ]) $
                identityOnGen mapp mem gen s
            describe mappendstr $
                it
                    (unwords
                         [ "is an associative operation for"
                         , genDescr @(a, a, a) genname
                         ]) $
                associativeOnGens mapp gen3 s3
            describe mconcatstr $
                it
                    (unwords
                         [ "is equivalent to its default implementation for"
                         , genDescr @[a] genname
                         ]) $
                equivalentOnGen mcon (foldr mapp mem) genl sl