Darcs patch reader: Join adjacent remove-add sequences like in the Git module

src/Data/List/Local.hs

@@ -17,12 +17,17 @@ module Data.List.Local
     ( -- groupByFst
       groupJusts
     , groupEithers
+    , groupPairs
+    , groupMap
+    , groupMapBy
+    , groupMapBy1
     )
 where
 
 import Prelude
 
-import Data.List.NonEmpty (NonEmpty (..), (<|))
+import Data.Function (on)
+import Data.List.NonEmpty (NonEmpty (..), (<|), toList)
 
 -- | Takes a list of pairs and groups them by consecutive ranges with equal
 -- first element. Returns a list of pairs, where each pair corresponds to one
@@ -54,3 +59,41 @@ groupEithers = foldr go ([], [], [])
     go (Left x) ([]  , (xs, ys):ps, as) = ([], (x <| xs, ys) : ps     , as)
     go (Left x) (b:bs, ps         , as) = ([], (x :| [], b :| bs) : ps, as)
     go (Right y) (bs, ps, as)           = (y : bs, ps, as)
+
+groupPairs
+    :: Foldable f => f ([a], [b]) -> ([b], [(NonEmpty a, NonEmpty b)], [a])
+groupPairs = groupEithers . foldr go []
+    where
+    go (xs, ys) es = map Left xs ++ map Right ys ++ es
+
+-- | @groupMap f g l@ groups elements like 'group', except it compares them by
+-- applying @f@ to elements and comparing these values using the 'Eq' instance.
+-- It then maps the elements in each such equality group using @g@.
+--
+-- >>> groupMap fst snd [(1, 5), (1, 6), (2, 7), (2, 8), (2, 9)]
+-- [(1, [5, 6]), (2, [7, 8, 9])]
+groupMap :: Eq b => (a -> b) -> (a -> c) -> [a] -> [(b, NonEmpty c)]
+groupMap f = groupMapBy ((==) `on` f) f
+
+-- | Like 'groupMap', except it uses a comparison predicate instead of an 'Eq'
+-- instance.
+groupMapBy
+    :: (a -> a -> Bool) -> (a -> b) -> (a -> c) -> [a] -> [(b, NonEmpty c)]
+groupMapBy _  _ _ []     = []
+groupMapBy eq f g (x:xs) = toList $ groupMapBy1 eq f g $ x :| xs
+
+-- | Like 'groupMapBy1', but takes and returns a 'NonEmpty'.
+groupMapBy1
+    :: (a -> a -> Bool)
+    -> (a -> b)
+    -> (a -> c)
+    -> NonEmpty a
+    -> NonEmpty (b, NonEmpty c)
+groupMapBy1 eq f g = go
+    where
+    go (x :| xs) =
+        let (ys, zs) = span (eq x) xs
+            rest = case zs of
+                []  -> []
+                z:l -> toList $ go $ z :| l
+        in  (f x, g x :| map g ys) :| rest