{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -- | Monoid properties -- -- You will need @TypeApplications@ to use these. module Test.Syd.Validity.Monoid ( monoidSpec, monoidSpecOnArbitrary, monoidSpecOnGen, ) where import Data.Data import Data.GenValidity import Test.QuickCheck import Test.Syd import Test.Syd.Validity.Functions import Test.Syd.Validity.Operations import Test.Syd.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: -- -- > 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