Add Eq1 and Ord1 Vector

Author: phadej

Data/Vector.hs

@@ -191,6 +191,10 @@ import Prelude hiding ( length, null,
                         enumFromTo, enumFromThenTo,
                         mapM, mapM_, sequence, sequence_ )
 
+#if MIN_VERSION_base(4,9,0)
+import Data.Functor.Classes (Eq1 (..), Ord1 (..))
+#endif
+
 import Data.Typeable  ( Typeable )
 import Data.Data      ( Data(..) )
 import Text.Read      ( Read(..), readListPrecDefault )
@@ -293,6 +297,14 @@ instance Ord a => Ord (Vector a) where
   {-# INLINE (>=) #-}
   xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT
 
+#if MIN_VERSION_base(4,9,0)
+instance Eq1 Vector where
+  liftEq eq xs ys = Bundle.eqBy eq (G.stream xs) (G.stream ys)
+
+instance Ord1 Vector where
+  liftCompare cmp xs ys = Bundle.cmpBy cmp (G.stream xs) (G.stream ys)
+#endif
+
 instance Semigroup (Vector a) where
   {-# INLINE (<>) #-}
   (<>) = (++)

Data/Vector/Fusion/Bundle.hs

@@ -73,7 +73,7 @@ module Data.Vector.Fusion.Bundle (
   -- * Monadic combinators
   mapM, mapM_, zipWithM, zipWithM_, filterM, foldM, fold1M, foldM', fold1M',
 
-  eq, cmp
+  eq, cmp, eqBy, cmpBy
 ) where
 
 import Data.Vector.Generic.Base ( Vector )
@@ -98,6 +98,10 @@ import Prelude hiding ( length, null,
                         enumFromTo, enumFromThenTo,
                         mapM, mapM_ )
 
+#if MIN_VERSION_base(4,9,0)
+import Data.Functor.Classes (Eq1 (..), Ord1 (..))
+#endif
+
 import GHC.Base ( build )
 
 -- Data.Vector.Internal.Check is unused
@@ -486,14 +490,22 @@ scanl1' = M.scanl1'
 -- -----------
 
 -- | Check if two 'Bundle's are equal
-eq :: Eq a => Bundle v a -> Bundle v a -> Bool
+eq :: (Eq a) => Bundle v a -> Bundle v a -> Bool
 {-# INLINE eq #-}
-eq x y = unId (M.eq x y)
+eq = eqBy (==)
+
+eqBy :: (a -> b -> Bool) -> Bundle v a -> Bundle v b -> Bool
+{-# INLINE eqBy #-}
+eqBy e x y = unId (M.eqBy e x y)
 
 -- | Lexicographically compare two 'Bundle's
-cmp :: Ord a => Bundle v a -> Bundle v a -> Ordering
+cmp :: (Ord a) => Bundle v a -> Bundle v a -> Ordering
 {-# INLINE cmp #-}
-cmp x y = unId (M.cmp x y)
+cmp = cmpBy compare
+
+cmpBy :: (a ->  b -> Ordering) -> Bundle v a -> Bundle v b -> Ordering
+{-# INLINE cmpBy #-}
+cmpBy c x y = unId (M.cmpBy c x y)
 
 instance Eq a => Eq (M.Bundle Id v a) where
   {-# INLINE (==) #-}
@@ -503,6 +515,16 @@ instance Ord a => Ord (M.Bundle Id v a) where
   {-# INLINE compare #-}
   compare = cmp
 
+#if MIN_VERSION_base(4,9,0)
+instance Eq1 (M.Bundle Id v) where
+  {-# INLINE liftEq #-}
+  liftEq = eqBy
+
+instance Ord1 (M.Bundle Id v) where
+  {-# INLINE liftCompare #-}
+  liftCompare = cmpBy
+#endif
+
 -- Monadic combinators
 -- -------------------
 

Data/Vector/Fusion/Bundle/Monadic.hs

@@ -40,7 +40,7 @@ module Data.Vector.Fusion.Bundle.Monadic (
   zip, zip3, zip4, zip5, zip6,
 
   -- * Comparisons
-  eq, cmp,
+  eqBy, cmpBy,
 
   -- * Filtering
   filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM,
@@ -424,14 +424,14 @@ zip6 = zipWith6 (,,,,,)
 -- -----------
 
 -- | Check if two 'Bundle's are equal
-eq :: (Monad m, Eq a) => Bundle m v a -> Bundle m v a -> m Bool
-{-# INLINE_FUSED eq #-}
-eq x y = sElems x `S.eq` sElems y
+eqBy :: (Monad m) => (a -> b -> Bool) -> Bundle m v a -> Bundle m v b -> m Bool
+{-# INLINE_FUSED eqBy #-}
+eqBy eq x y = S.eqBy eq (sElems x) (sElems y)
 
 -- | Lexicographically compare two 'Bundle's
-cmp :: (Monad m, Ord a) => Bundle m v a -> Bundle m v a -> m Ordering
-{-# INLINE_FUSED cmp #-}
-cmp x y = sElems x `S.cmp` sElems y
+cmpBy :: (Monad m) => (a -> b -> Ordering) -> Bundle m v a -> Bundle m v b -> m Ordering
+{-# INLINE_FUSED cmpBy #-}
+cmpBy cmp x y = S.cmpBy cmp (sElems x) (sElems y)
 
 -- Filtering
 -- ---------

Data/Vector/Fusion/Stream/Monadic.hs

@@ -37,7 +37,7 @@ module Data.Vector.Fusion.Stream.Monadic (
   zip, zip3, zip4, zip5, zip6,
 
   -- * Comparisons
-  eq, cmp,
+  eqBy, cmpBy,
 
   -- * Filtering
   filter, filterM, uniq, mapMaybe, takeWhile, takeWhileM, dropWhile, dropWhileM,
@@ -625,9 +625,9 @@ zip6 = zipWith6 (,,,,,)
 -- -----------
 
 -- | Check if two 'Stream's are equal
-eq :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool
-{-# INLINE_FUSED eq #-}
-eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2
+eqBy :: (Monad m) => (a -> b -> Bool) -> Stream m a -> Stream m b -> m Bool
+{-# INLINE_FUSED eqBy #-}
+eqBy eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2
   where
     eq_loop0 !_ s1 s2 = do
       r <- step1 s1
@@ -640,7 +640,7 @@ eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2
       r <- step2 s2
       case r of
         Yield y s2'
-          | x == y    -> eq_loop0 SPEC   s1 s2'
+          | eq x y    -> eq_loop0 SPEC   s1 s2'
           | otherwise -> return False
         Skip    s2'   -> eq_loop1 SPEC x s1 s2'
         Done          -> return False
@@ -653,9 +653,9 @@ eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2
         Done      -> return True
 
 -- | Lexicographically compare two 'Stream's
-cmp :: (Monad m, Ord a) => Stream m a -> Stream m a -> m Ordering
-{-# INLINE_FUSED cmp #-}
-cmp (Stream step1 t1) (Stream step2 t2) = cmp_loop0 SPEC t1 t2
+cmpBy :: (Monad m) => (a -> b -> Ordering) -> Stream m a -> Stream m b -> m Ordering
+{-# INLINE_FUSED cmpBy #-}
+cmpBy cmp (Stream step1 t1) (Stream step2 t2) = cmp_loop0 SPEC t1 t2
   where
     cmp_loop0 !_ s1 s2 = do
       r <- step1 s1
@@ -667,7 +667,7 @@ cmp (Stream step1 t1) (Stream step2 t2) = cmp_loop0 SPEC t1 t2
     cmp_loop1 !_ x s1 s2 = do
       r <- step2 s2
       case r of
-        Yield y s2' -> case x `compare` y of
+        Yield y s2' -> case x `cmp` y of
                          EQ -> cmp_loop0 SPEC s1 s2'
                          c  -> return c
         Skip    s2' -> cmp_loop1 SPEC x s1 s2'