Monoid.hs

{-# 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 = 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 valid values
--
-- Example usage:
--
-- > monoidSpec @[Int]
monoidSpec ::
  forall a.
  (Show a, Eq a, Monoid a, Typeable a, GenValid a) =>
  Spec
monoidSpec = monoidSpecOnGen @a genValid "valid" 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 = 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