Add Data.List.NonEmpty.ApplyMerge

apply-merge.cabal

@@ -35,6 +35,7 @@ source-repository head
 library
   exposed-modules:
       Data.List.ApplyMerge
+      Data.List.NonEmpty.ApplyMerge
   other-modules:
       ApplyMerge.IntSet
   hs-source-dirs:
@@ -55,6 +56,7 @@ test-suite apply-merge-tests
       ApplyMerge.IntSet
       Data.DoublyLinkedList.STRef
       Data.List.ApplyMerge
+      Data.List.NonEmpty.ApplyMerge
       Data.PQueue.Prio.Min.Mutable
       Test.ApplyMerge.Common
       Test.ApplyMerge.DoublyLinkedList
@@ -88,6 +90,7 @@ benchmark apply-merge-benchmarks
       ApplyMerge.IntSet
       Data.DoublyLinkedList.STRef
       Data.List.ApplyMerge
+      Data.List.NonEmpty.ApplyMerge
       Data.PQueue.Prio.Min.Mutable
       Bench.Data.DoublyLinkedList.STRef
       Bench.PriorityQueue.MinPQueue

package.yaml

@@ -38,6 +38,7 @@ library:
   source-dirs: src
   exposed-modules:
   - Data.List.ApplyMerge
+  - Data.List.NonEmpty.ApplyMerge
   other-modules:
   - ApplyMerge.IntSet
   dependencies:

src/ApplyMerge/DoublyLinkedList.hs

@@ -3,7 +3,7 @@
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE NoFieldSelectors #-}
 
-module ApplyMerge.DoublyLinkedList (applyMerge) where
+module ApplyMerge.DoublyLinkedList (applyMerge, applyMergeNonEmpty) where
 
 import Control.Monad (guard, (>=>))
 import Control.Monad.ST qualified as Strict

src/ApplyMerge/IntMap.hs

@@ -3,7 +3,7 @@
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE NoFieldSelectors #-}
 
-module ApplyMerge.IntMap (applyMerge) where
+module ApplyMerge.IntMap (applyMerge, applyMergeNonEmpty) where
 
 import Control.Arrow ((>>>))
 import Control.Monad (guard)

src/ApplyMerge/IntSet.hs

@@ -3,7 +3,7 @@
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE NoFieldSelectors #-}
 
-module ApplyMerge.IntSet (applyMerge) where
+module ApplyMerge.IntSet (applyMerge, applyMergeNonEmpty) where
 
 import Control.Arrow ((>>>))
 import Control.Monad (guard)

src/Data/List/NonEmpty/ApplyMerge.hs

@@ -0,0 +1,29 @@
+-- SPDX-FileCopyrightText: Copyright Preetham Gujjula
+-- SPDX-License-Identifier: BSD-3-Clause
+
+-- |
+-- Module: Data.List.NonEmpty.ApplyMerge
+-- License: BSD-3-Clause
+-- Maintainer: Preetham Gujjula <[email protected]>
+-- Stability: experimental
+module Data.List.NonEmpty.ApplyMerge (applyMerge, applyMergeOn) where
+
+import ApplyMerge.IntSet qualified
+import Data.List.NonEmpty (NonEmpty)
+import Data.List.NonEmpty qualified as NonEmpty
+import Data.Semigroup (Arg (..))
+
+-- | Like 'Data.List.ApplyMerge.applyMerge', but operates on 'NonEmpty's instead
+--   of lists.
+applyMerge :: (Ord c) => (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
+applyMerge = ApplyMerge.IntSet.applyMergeNonEmpty
+
+-- | Like 'applyMerge', but applies a custom projection function before
+--   performing comparisons.
+applyMergeOn ::
+  (Ord d) => (c -> d) -> (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
+applyMergeOn p f as bs =
+  let f' a b =
+        let c = f a b
+         in Arg (p c) c
+   in NonEmpty.map (\(Arg _ c) -> c) (applyMerge f' as bs)