fix bug which caused bad foldMap/fold to pass if they evaluated thing…

…s in a weird order

src/Hedgehog/Classes/Common/Gen.hs

@@ -2,6 +2,7 @@
 
 module Hedgehog.Classes.Common.Gen
   ( genSmallList
+  , genVerySmallList 
   , genSmallNonEmptyList
   , genShowReadPrecedence
   , genSmallString
@@ -37,6 +38,9 @@ genSmallNonEmptyList gen = Gen.list (Range.linear 1 7) gen
 genSmallList :: Gen a -> Gen [a]
 genSmallList gen = Gen.list (Range.linear 0 6) gen
 
+genVerySmallList :: Gen a -> Gen [a]
+genVerySmallList gen = Gen.list (Range.linear 0 2) gen
+
 genSmallString :: Gen String
 genSmallString = Gen.string (Range.linear 0 6) Gen.ascii
 

src/Hedgehog/Classes/Foldable.hs

@@ -51,7 +51,7 @@ foldableFold ::
   , forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
   ) => (forall x. Gen x -> Gen (f x)) -> Property
 foldableFold fgen = property $ do
-  a <- forAll $ fgen genSmallSum
+  a <- forAll $ fgen $ genVerySmallList genSmallInteger
   let lhs = Foldable.fold a
   let rhs = Foldable.foldMap id a
   let ctx = contextualise $ LawContext
@@ -76,7 +76,7 @@ foldableFoldMap ::
 foldableFoldMap fgen = property $ do
   a <- forAll $ fgen genSmallInteger
   e <- forAll genQuadraticEquation
-  let f = Sum . runQuadraticEquation e
+  let f = (:[]) . runQuadraticEquation e
   let lhs = Foldable.foldMap f a
   let rhs = Foldable.foldr (mappend . f) mempty a
   let ctx = contextualise $ LawContext
@@ -85,7 +85,7 @@ foldableFoldMap fgen = property $ do
         , lawContextTcName = "Foldable"
         , lawContextTcProp =
             let showA = show a
-                showF = "Sum $ " ++ show e
+                showF = "(:[]) $ " ++ show e
             in lawWhere
               [ "foldMap f a" `congruency` "foldr (mappend . f) mempty  a, where"
               , "f = " ++ showF