Merge pull request #149 from phadej/lifted

Data.Functor.Classes instances

Author: dolio

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 (..), Read1 (..), Show1 (..))
+#endif
+
 import Data.Typeable  ( Typeable )
 import Data.Data      ( Data(..) )
 import Text.Read      ( Read(..), readListPrecDefault )
@@ -228,6 +232,14 @@ instance Read a => Read (Vector a) where
   readPrec = G.readPrec
   readListPrec = readListPrecDefault
 
+#if MIN_VERSION_base(4,9,0)
+instance Show1 Vector where
+    liftShowsPrec = G.liftShowsPrec
+
+instance Read1 Vector where
+    liftReadsPrec = G.liftReadsPrec
+#endif
+
 #if __GLASGOW_HASKELL__ >= 708
 
 instance Exts.IsList (Vector a) where
@@ -293,6 +305,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'

Data/Vector/Generic.hs

@@ -158,9 +158,11 @@ module Data.Vector.Generic (
 
   -- ** Comparisons
   eq, cmp,
+  eqBy, cmpBy,
 
   -- ** Show and Read
   showsPrec, readPrec,
+  liftShowsPrec, liftReadsPrec,
 
   -- ** @Data@ and @Typeable@
   gfoldl, dataCast, mkType
@@ -2131,6 +2133,11 @@ eq :: (Vector v a, Eq a) => v a -> v a -> Bool
 {-# INLINE eq #-}
 xs `eq` ys = stream xs == stream ys
 
+-- | /O(n)/
+eqBy :: (Vector v a, Vector v b) => (a -> b -> Bool) -> v a -> v b -> Bool
+{-# INLINE eqBy #-}
+eqBy e xs ys = Bundle.eqBy e (stream xs) (stream ys)
+
 -- | /O(n)/ Compare two vectors lexicographically. All 'Vector' instances are
 -- also instances of 'Ord' and it is usually more appropriate to use those. This
 -- function is primarily intended for implementing 'Ord' instances for new
@@ -2139,6 +2146,10 @@ cmp :: (Vector v a, Ord a) => v a -> v a -> Ordering
 {-# INLINE cmp #-}
 cmp xs ys = compare (stream xs) (stream ys)
 
+-- | /O(n)/
+cmpBy :: (Vector v a, Vector v b) => (a -> b -> Ordering) -> v a -> v b -> Ordering
+cmpBy c xs ys = Bundle.cmpBy c (stream xs) (stream ys)
+
 -- Show
 -- ----
 
@@ -2147,13 +2158,21 @@ showsPrec :: (Vector v a, Show a) => Int -> v a -> ShowS
 {-# INLINE showsPrec #-}
 showsPrec _ = shows . toList
 
+liftShowsPrec :: (Vector v a) => (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> v a -> ShowS
+{-# INLINE liftShowsPrec #-}
+liftShowsPrec _ s _ = s . toList
+
 -- | Generic definition of 'Text.Read.readPrec'
 readPrec :: (Vector v a, Read a) => Read.ReadPrec (v a)
 {-# INLINE readPrec #-}
 readPrec = do
   xs <- Read.readPrec
   return (fromList xs)
 
+-- | /Note:/ uses 'ReadS'
+liftReadsPrec :: (Vector v a) => (Int -> Read.ReadS a) -> ReadS [a] -> Int -> Read.ReadS (v a)
+liftReadsPrec _ r _ s = [ (fromList v, s') | (v, s') <- r s ]
+
 -- Data and Typeable
 -- -----------------
 

changelog

@@ -1,3 +1,8 @@
+Changes in version 0.12.0.0
+
+ * Add `Eq1`, `Ord1`, `Show1`, and `Read1` `Vector` instances, and related
+   helper functions.
+
 Changes in version 0.11.0.0
 
  * Define `Applicative` instances for `Data.Vector.Fusion.Util.{Box,Id}`