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