{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
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
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
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
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
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