Make Bitraversable laws build on older GHC

andrewthad · Jun 18, 2019 · fe65f14 · fe65f14
1 parent 2dbdc7d
commit fe65f14
Show file tree

Hide file tree

Showing 4 changed files with 23 additions and 11 deletions.
diff --git a/build b/build
@@ -3,9 +3,9 @@ set -e
 
 # To use this script on Ubuntu, you will need to first run the following:
 # 
-# sudo apt install ghc-7.4.2 ghc-7.6.3 ghc-7.8.4 ghc-7.10.3 ghc-8.0.2 ghc-8.2.2 ghc-8.4.3 ghc-8.6.3
+# sudo apt install ghc-7.4.2 ghc-7.6.3 ghc-7.8.4 ghc-7.10.3 ghc-8.0.2 ghc-8.2.2 ghc-8.4.3 ghc-8.6.5
 
-declare -a ghcs=("7.4.2" "7.6.3" "7.8.4" "7.10.3" "8.0.2" "8.2.2" "8.4.4" "8.6.3")
+declare -a ghcs=("7.4.2" "7.6.3" "7.8.4" "7.10.3" "8.0.2" "8.2.2" "8.4.4" "8.6.5")
 
 ## now loop through the above array
 for g in "${ghcs[@]}"

diff --git a/quickcheck-classes.cabal b/quickcheck-classes.cabal
@@ -125,7 +125,7 @@ library
     , QuickCheck >= 2.7
     , transformers >= 0.3 && < 0.6
     , primitive >= 0.7 && < 0.8
-    , primitive-addr >= 0.1 && < 0.2
+    , primitive-addr >= 0.1.0.1 && < 0.2
     , containers >= 0.4.2.1
     , semigroups >= 0.17
     , tagged

diff --git a/src/Test/QuickCheck/Classes/Bitraversable.hs b/src/Test/QuickCheck/Classes/Bitraversable.hs
@@ -25,7 +25,7 @@ import Test.QuickCheck.Property (Property)
 
 import Test.QuickCheck.Classes.Common
 #if HAVE_BINARY_LAWS
-import Test.QuickCheck.Classes.Compat (eq2)
+import Test.QuickCheck.Classes.Compat (eq1_2)
 #endif
 
 #if HAVE_BINARY_LAWS
@@ -35,9 +35,9 @@ import Test.QuickCheck.Classes.Compat (eq2)
 -- [/Naturality/]
 --   @'bitraverse' (t '.' f) (t '.' g) ≡ t '.' 'bitraverse' f g@ for every applicative transformation @t@
 -- [/Identity/]
---   @'bitraverse' 'Identity' 'Identity' ≡ 'Identity'
+--   @'bitraverse' 'Identity' 'Identity' ≡ 'Identity'@
 -- [/Composition/] 
---   @'Compose' '.' 'fmap' ('bitraverse' g1 g2) '.' 'bitraverse' f1 f2 ≡ 'bitraverse' ('Compose' '.' 'fmap' g1 g2 '.' f1) ('Compose' '.' 'fmap' g2 '.' f2)
+--   @'Compose' '.' 'fmap' ('bitraverse' g1 g2) '.' 'bitraverse' f1 f2 ≡ 'bitraverse' ('Compose' '.' 'fmap' g1 g2 '.' f1) ('Compose' '.' 'fmap' g2 '.' f2)@
 --
 -- /Note/: This property test is only available when this package is built with
 -- @base-4.9+@ or @transformers-0.5+@.
@@ -49,7 +49,7 @@ bitraversableLaws :: forall proxy f.
 #endif
   => proxy f -> Laws
 bitraversableLaws p = Laws "Bitraversable"
-  [ ("Naturality", bitraversableIdentity p)
+  [ ("Naturality", bitraversableNaturality p)
   , ("Identity", bitraversableIdentity p)
   , ("Composition", bitraversableComposition p)
   ]
@@ -67,7 +67,7 @@ bitraversableNaturality _ = property $ \(Apply2 (x :: f Integer Integer)) ->
       g = func4
       x' = bitraverse (t . f) (t . g) x
       y' = t (bitraverse f g x)
-  in x' == y'
+  in eq1_2 x' y'
 
 bitraversableIdentity :: forall proxy f.
 #if HAVE_QUANTIFIED_CONSTRAINTS
@@ -76,7 +76,7 @@ bitraversableIdentity :: forall proxy f.
   (Bitraversable f, Eq2 f, Show2 f, Arbitrary2 f)
 #endif
   => proxy f -> Property
-bitraversableIdentity _ = property $ \(Apply2 (x :: f Integer Integer)) -> (bitraverse Identity Identity x) == (Identity x)
+bitraversableIdentity _ = property $ \(Apply2 (x :: f Integer Integer)) -> eq1_2 (bitraverse Identity Identity x) (Identity x)
 
 bitraversableComposition :: forall proxy f.
 #if HAVE_QUANTIFIED_CONSTRAINTS
@@ -92,6 +92,6 @@ bitraversableComposition _ = property $ \(Apply2 (x :: f Integer Integer)) ->
       g2 = func4
       x' = Compose . fmap (bitraverse g1 g2) . bitraverse f1 f2 $ x
       y' = bitraverse (Compose . fmap g1 . f1) (Compose . fmap g2 . f2) x
-  in x' == y'
+  in eq1_2 x' y'
 
 #endif
diff --git a/src/Test/QuickCheck/Classes/Compat.hs b/src/Test/QuickCheck/Classes/Compat.hs
@@ -12,6 +12,7 @@ module Test.QuickCheck.Classes.Compat
 #endif
 #if HAVE_BINARY_LAWS
   , eq2
+  , eq1_2
 #endif
   , readMaybe
   ) where
@@ -52,14 +53,25 @@ isTrue# b = b
 
 #if HAVE_UNARY_LAWS
 #if HAVE_QUANTIFIED_CONSTRAINTS
-eq1 :: (forall a. Eq a => Eq (f a), Eq a) => f a -> f a -> Bool
+eq1 :: (forall x. Eq x => Eq (f x), Eq a) => f a -> f a -> Bool
 eq1 = (==)
 #else
 eq1 :: (C.Eq1 f, Eq a) => f a -> f a -> Bool
 eq1 = C.eq1
 #endif
 #endif
 
+#if HAVE_UNARY_LAWS
+#if HAVE_QUANTIFIED_CONSTRAINTS
+eq1_2 :: (forall a. Eq a => Eq (f a), forall a b. (Eq a, Eq b) => Eq (g a b), Eq x, Eq y)
+  => f (g x y) -> f (g x y) -> Bool
+eq1_2 = (==)
+#else
+eq1_2 :: (C.Eq1 f, C.Eq2 g, Eq a, Eq b) => f (g a b) -> f (g a b) -> Bool
+eq1_2 = C.liftEq C.eq2
+#endif
+#endif
+
 #if HAVE_BINARY_LAWS
 #if HAVE_QUANTIFIED_CONSTRAINTS
 eq2 :: (forall a. (Eq a, Eq b) => Eq (f a b), Eq a, Eq b) => f a b -> f a b -> Bool