From 04cd8364ba85cb9bf399359def595dd2d8ebac2c Mon Sep 17 00:00:00 2001
From: Preetham Gujjula <gitcommit@mail.preetham.io>
Date: Thu, 9 May 2024 00:55:11 -0700
Subject: [PATCH 1/8] Configure CI to run on PRs and pushes to main

Previously, the CI was configured to run on pushes to all branches, and
on all pull requests. This caused pushes to a PR to cause all CI jobs to
run twice, once because they were a push, and once because the PR was
updated.

To fix this, we configure CI to run on all pull requests, and on pushes
only to main.
---
 .github/workflows/ci.yml | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 495ba4e..b79ceaa 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -3,8 +3,10 @@
 
 name: CI
 on:
-  - push
-  - pull_request
+  push:
+    branches:
+    - main
+  pull_request:
 jobs:
   generate-matrix:
     name: Generate matrix from cabal

From 4e4610ba36b65038089aefa5a07fb4d3671fe7ca Mon Sep 17 00:00:00 2001
From: Preetham Gujjula <gitcommit@mail.preetham.io>
Date: Wed, 8 May 2024 16:05:04 -0700
Subject: [PATCH 2/8] Add IntSet peekInsertChildren

---
 src/ApplyMerge/IntSet.hs | 21 +++++++++++++--------
 1 file changed, 13 insertions(+), 8 deletions(-)

diff --git a/src/ApplyMerge/IntSet.hs b/src/ApplyMerge/IntSet.hs
index 0fb4678..ff393fd 100644
--- a/src/ApplyMerge/IntSet.hs
+++ b/src/ApplyMerge/IntSet.hs
@@ -5,8 +5,8 @@
 
 module ApplyMerge.IntSet (applyMerge) where
 
+import Control.Arrow ((>>>))
 import Control.Monad (guard)
-import Data.Function ((&))
 import Data.IntSet (IntSet)
 import Data.IntSet qualified as IntSet
 import Data.List (unfoldr)
@@ -45,13 +45,7 @@ initialFrontier f as bs =
         }
 
 step :: (Ord c) => (a -> b -> c) -> Frontier a b c -> Maybe (c, Frontier a b c)
-step f frontier = do
-  (node, frontier') <- deleteMinNode frontier
-  let frontier'' =
-        frontier'
-          & insertChildA f node
-          & insertChildB f node
-  pure (node.value, frontier'')
+step f = fmap (uncurry (peekInsertChildren f)) . deleteMinNode
 
 deleteMinNode :: (Ord c) => Frontier a b c -> Maybe (Node a b c, Frontier a b c)
 deleteMinNode frontier = do
@@ -65,6 +59,17 @@ deleteMinNode frontier = do
           }
   pure (node, frontier')
 
+peekInsertChildren ::
+  (Ord c) =>
+  (a -> b -> c) ->
+  Node a b c ->
+  Frontier a b c ->
+  (c, Frontier a b c)
+peekInsertChildren f node =
+  insertChildA f node
+    >>> insertChildB f node
+    >>> (node.value,)
+
 insertChildA ::
   (Ord c) => (a -> b -> c) -> Node a b c -> Frontier a b c -> Frontier a b c
 insertChildA f (Node (ia, ib) _ as bs) frontier = fromMaybe frontier $ do

From ac4f7584e31a5c236fcb77ee4572e507ae7f55df Mon Sep 17 00:00:00 2001
From: Preetham Gujjula <gitcommit@mail.preetham.io>
Date: Wed, 8 May 2024 16:05:29 -0700
Subject: [PATCH 3/8] Add IntMap peekInsertChildren

---
 src/ApplyMerge/IntMap.hs | 21 +++++++++++++--------
 1 file changed, 13 insertions(+), 8 deletions(-)

diff --git a/src/ApplyMerge/IntMap.hs b/src/ApplyMerge/IntMap.hs
index 9ed3968..a63b599 100644
--- a/src/ApplyMerge/IntMap.hs
+++ b/src/ApplyMerge/IntMap.hs
@@ -5,8 +5,8 @@
 
 module ApplyMerge.IntMap (applyMerge) where
 
+import Control.Arrow ((>>>))
 import Control.Monad (guard)
-import Data.Function ((&))
 import Data.IntMap.Strict (IntMap)
 import Data.IntMap.Strict qualified as IntMap
 import Data.List (unfoldr)
@@ -43,13 +43,7 @@ initialFrontier f as bs =
         }
 
 step :: (Ord c) => (a -> b -> c) -> Frontier a b c -> Maybe (c, Frontier a b c)
-step f frontier = do
-  (node, frontier') <- deleteMinNode frontier
-  let frontier'' =
-        frontier'
-          & insertChildA f node
-          & insertChildB f node
-  pure (node.value, frontier'')
+step f = fmap (uncurry (peekInsertChildren f)) . deleteMinNode
 
 deleteMinNode :: (Ord c) => Frontier a b c -> Maybe (Node a b c, Frontier a b c)
 deleteMinNode frontier = do
@@ -62,6 +56,17 @@ deleteMinNode frontier = do
           }
   pure (node, frontier')
 
+peekInsertChildren ::
+  (Ord c) =>
+  (a -> b -> c) ->
+  Node a b c ->
+  Frontier a b c ->
+  (c, Frontier a b c)
+peekInsertChildren f node =
+  insertChildA f node
+    >>> insertChildB f node
+    >>> (node.value,)
+
 insertChildA ::
   (Ord c) => (a -> b -> c) -> Node a b c -> Frontier a b c -> Frontier a b c
 insertChildA f (Node (ia, ib) _ as bs) frontier = fromMaybe frontier $ do

From d0955d7f23050dfc6d3ddf18232f503d99a12ff6 Mon Sep 17 00:00:00 2001
From: Preetham Gujjula <gitcommit@mail.preetham.io>
Date: Wed, 8 May 2024 16:19:05 -0700
Subject: [PATCH 4/8] Add DoublyLinkedList peekInsertChildren

---
 src/ApplyMerge/DoublyLinkedList.hs | 33 ++++++++++++++++++++----------
 1 file changed, 22 insertions(+), 11 deletions(-)

diff --git a/src/ApplyMerge/DoublyLinkedList.hs b/src/ApplyMerge/DoublyLinkedList.hs
index 7e3700a..5db97a9 100644
--- a/src/ApplyMerge/DoublyLinkedList.hs
+++ b/src/ApplyMerge/DoublyLinkedList.hs
@@ -5,7 +5,7 @@
 
 module ApplyMerge.DoublyLinkedList (applyMerge) where
 
-import Control.Monad (guard)
+import Control.Monad (guard, (>=>))
 import Control.Monad.ST qualified as Strict
 import Control.Monad.ST.Lazy qualified as Lazy
 import Control.Monad.Trans.Class (lift)
@@ -37,7 +37,7 @@ applyMergeNonEmpty ::
   (Ord c) => (a -> b -> c) -> NonEmpty a -> NonEmpty b -> [c]
 applyMergeNonEmpty f as bs = Lazy.runST $ do
   frontier <- Lazy.strictToLazyST (initialFrontier f as bs)
-  unfoldrM (Lazy.strictToLazyST . step f) frontier
+  unfoldrM (Lazy.strictToLazyST . runMaybeT . step f) frontier
 
 unfoldrM :: (Monad m) => (b -> m (Maybe (a, b))) -> b -> m [a]
 unfoldrM f seed = do
@@ -58,17 +58,12 @@ step ::
   (Ord c) =>
   (a -> b -> c) ->
   Frontier s a b c ->
-  Strict.ST s (Maybe (c, Frontier s a b c))
-step f frontier = runMaybeT $ do
-  (node, frontier') <- MaybeT (deleteMinNode frontier)
-  frontier'' <- lift $ insertChildA f node frontier'
-  frontier''' <- lift $ insertChildB f node frontier''
-  lift (DoublyLinked.delete node.position)
-  pure (node.value, frontier''')
+  MaybeT (Strict.ST s) (c, Frontier s a b c)
+step f = deleteMinNode >=> lift . uncurry (peekInsertChildren f)
 
 deleteMinNode ::
-  (Ord c) => Frontier s a b c -> Strict.ST s (Maybe (Node s a b c, Frontier s a b c))
-deleteMinNode frontier = runMaybeT $ do
+  (Ord c) => Frontier s a b c -> MaybeT (Strict.ST s) (Node s a b c, Frontier s a b c)
+deleteMinNode frontier = do
   (node, queue') <- hoistMaybe (MinPQueue.minView frontier.queue)
   let frontier' = Frontier queue'
   pure (node, frontier')
@@ -83,6 +78,22 @@ prevNodeValue valueNode = runMaybeT $ do
   valueNode' <- MaybeT $ DoublyLinked.prev valueNode
   pure (DoublyLinked.value valueNode')
 
+-- Take a node not in the frontier but whose position is still in the position
+-- list, add its children to the frontier, and remove the node from the
+-- position list.
+peekInsertChildren ::
+  (Ord c) =>
+  (a -> b -> c) ->
+  Node s a b c ->
+  Frontier s a b c ->
+  Strict.ST s (c, Frontier s a b c)
+peekInsertChildren f node frontier = do
+  frontier' <-
+    insertChildA f node frontier
+      >>= insertChildB f node
+  DoublyLinked.delete node.position
+  pure (node.value, frontier')
+
 insertChildA ::
   (Ord c) =>
   (a -> b -> c) ->

From f20749bb62d39f8e9a9b0e57c1921afb02f8f182 Mon Sep 17 00:00:00 2001
From: Preetham Gujjula <gitcommit@mail.preetham.io>
Date: Wed, 8 May 2024 22:00:19 -0700
Subject: [PATCH 5/8] Add IntSet applyMergeNonEmpty

---
 src/ApplyMerge/IntSet.hs | 37 +++++++++++++++++++++++++++----------
 1 file changed, 27 insertions(+), 10 deletions(-)

diff --git a/src/ApplyMerge/IntSet.hs b/src/ApplyMerge/IntSet.hs
index ff393fd..2fde91a 100644
--- a/src/ApplyMerge/IntSet.hs
+++ b/src/ApplyMerge/IntSet.hs
@@ -10,7 +10,7 @@ import Control.Monad (guard)
 import Data.IntSet (IntSet)
 import Data.IntSet qualified as IntSet
 import Data.List (unfoldr)
-import Data.List.NonEmpty (NonEmpty, nonEmpty)
+import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty)
 import Data.List.NonEmpty qualified as NonEmpty
 import Data.Maybe (fromMaybe)
 import Data.PQueue.Prio.Min (MinPQueue)
@@ -33,16 +33,33 @@ applyMerge :: (Ord c) => (a -> b -> c) -> [a] -> [b] -> [c]
 applyMerge f as bs = fromMaybe [] $ do
   as' <- nonEmpty as
   bs' <- nonEmpty bs
-  pure (unfoldr (step f) (initialFrontier f as' bs'))
+  pure (NonEmpty.toList (applyMergeNonEmpty f as' bs'))
 
-initialFrontier :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> Frontier a b c
-initialFrontier f as bs =
-  let node = mkNode f (0, 0) as bs
-   in Frontier
-        { queue = MinPQueue.singleton node.value node,
-          indexSetA = IntSet.singleton 0,
-          indexSetB = IntSet.singleton 0
-        }
+applyMergeNonEmpty ::
+  (Ord c) => (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
+applyMergeNonEmpty f as bs =
+  let (c, frontier) = initialState f as bs
+   in c :| unfoldr (step f) frontier
+
+initialState ::
+  forall a b c.
+  (Ord c) =>
+  (a -> b -> c) ->
+  NonEmpty a ->
+  NonEmpty b ->
+  (c, Frontier a b c)
+initialState f as bs =
+  let initialNode :: Node a b c
+      initialNode = mkNode f (0, 0) as bs
+
+      emptyFrontier :: Frontier a b c
+      emptyFrontier =
+        Frontier
+          { queue = MinPQueue.empty,
+            indexSetA = IntSet.empty,
+            indexSetB = IntSet.empty
+          }
+   in peekInsertChildren f initialNode emptyFrontier
 
 step :: (Ord c) => (a -> b -> c) -> Frontier a b c -> Maybe (c, Frontier a b c)
 step f = fmap (uncurry (peekInsertChildren f)) . deleteMinNode

From 1323f11b37020ff864da91d2188dfb796c3313f6 Mon Sep 17 00:00:00 2001
From: Preetham Gujjula <gitcommit@mail.preetham.io>
Date: Wed, 8 May 2024 22:12:15 -0700
Subject: [PATCH 6/8] Add IntMap applyMergeNonEmpty

---
 src/ApplyMerge/IntMap.hs | 35 ++++++++++++++++++++++++++---------
 1 file changed, 26 insertions(+), 9 deletions(-)

diff --git a/src/ApplyMerge/IntMap.hs b/src/ApplyMerge/IntMap.hs
index a63b599..384d4eb 100644
--- a/src/ApplyMerge/IntMap.hs
+++ b/src/ApplyMerge/IntMap.hs
@@ -10,7 +10,7 @@ import Control.Monad (guard)
 import Data.IntMap.Strict (IntMap)
 import Data.IntMap.Strict qualified as IntMap
 import Data.List (unfoldr)
-import Data.List.NonEmpty (NonEmpty, nonEmpty)
+import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty)
 import Data.List.NonEmpty qualified as NonEmpty
 import Data.Maybe (fromMaybe)
 import Data.PQueue.Prio.Min (MinPQueue)
@@ -32,15 +32,32 @@ applyMerge :: (Ord c) => (a -> b -> c) -> [a] -> [b] -> [c]
 applyMerge f as bs = fromMaybe [] $ do
   as' <- nonEmpty as
   bs' <- nonEmpty bs
-  pure (unfoldr (step f) (initialFrontier f as' bs'))
+  pure (NonEmpty.toList (applyMergeNonEmpty f as' bs'))
 
-initialFrontier :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> Frontier a b c
-initialFrontier f as bs =
-  let node = mkNode f (0, 0) as bs
-   in Frontier
-        { queue = MinPQueue.singleton node.value node,
-          indexMap = IntMap.singleton 0 0
-        }
+applyMergeNonEmpty ::
+  (Ord c) => (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
+applyMergeNonEmpty f as bs =
+  let (c, frontier) = initialState f as bs
+   in c :| unfoldr (step f) frontier
+
+initialState ::
+  forall a b c.
+  (Ord c) =>
+  (a -> b -> c) ->
+  NonEmpty a ->
+  NonEmpty b ->
+  (c, Frontier a b c)
+initialState f as bs =
+  let initialNode :: Node a b c
+      initialNode = mkNode f (0, 0) as bs
+
+      emptyFrontier :: Frontier a b c
+      emptyFrontier =
+        Frontier
+          { queue = MinPQueue.empty,
+            indexMap = IntMap.empty
+          }
+   in peekInsertChildren f initialNode emptyFrontier
 
 step :: (Ord c) => (a -> b -> c) -> Frontier a b c -> Maybe (c, Frontier a b c)
 step f = fmap (uncurry (peekInsertChildren f)) . deleteMinNode

From cb9c16a617384ba832ca1f082b4eda02a2d0008e Mon Sep 17 00:00:00 2001
From: Preetham Gujjula <gitcommit@mail.preetham.io>
Date: Thu, 9 May 2024 00:34:59 -0700
Subject: [PATCH 7/8] Add DoublyLinkedList applyMergeNonEmpty

---
 src/ApplyMerge/DoublyLinkedList.hs | 32 ++++++++++++++++++------------
 1 file changed, 19 insertions(+), 13 deletions(-)

diff --git a/src/ApplyMerge/DoublyLinkedList.hs b/src/ApplyMerge/DoublyLinkedList.hs
index 5db97a9..8ac8758 100644
--- a/src/ApplyMerge/DoublyLinkedList.hs
+++ b/src/ApplyMerge/DoublyLinkedList.hs
@@ -11,7 +11,7 @@ import Control.Monad.ST.Lazy qualified as Lazy
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
 import Data.DoublyLinkedList.STRef qualified as DoublyLinked
-import Data.List.NonEmpty (NonEmpty, nonEmpty)
+import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty)
 import Data.List.NonEmpty qualified as NonEmpty
 import Data.Maybe (fromMaybe)
 import Data.PQueue.Prio.Min (MinPQueue)
@@ -29,15 +29,16 @@ newtype Frontier s a b c = Frontier
   }
 
 applyMerge :: (Ord c) => (a -> b -> c) -> [a] -> [b] -> [c]
-applyMerge f as bs =
-  fromMaybe [] $
-    applyMergeNonEmpty f <$> nonEmpty as <*> nonEmpty bs
+applyMerge f as bs = fromMaybe [] $ do
+  as' <- nonEmpty as
+  bs' <- nonEmpty bs
+  pure (NonEmpty.toList (applyMergeNonEmpty f as' bs'))
 
 applyMergeNonEmpty ::
-  (Ord c) => (a -> b -> c) -> NonEmpty a -> NonEmpty b -> [c]
+  (Ord c) => (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
 applyMergeNonEmpty f as bs = Lazy.runST $ do
-  frontier <- Lazy.strictToLazyST (initialFrontier f as bs)
-  unfoldrM (Lazy.strictToLazyST . runMaybeT . step f) frontier
+  (c, frontier) <- Lazy.strictToLazyST (initialState f as bs)
+  (c :|) <$> unfoldrM (Lazy.strictToLazyST . runMaybeT . step f) frontier
 
 unfoldrM :: (Monad m) => (b -> m (Maybe (a, b))) -> b -> m [a]
 unfoldrM f seed = do
@@ -46,13 +47,18 @@ unfoldrM f seed = do
     Nothing -> pure []
     Just (x, newSeed) -> (x :) <$> unfoldrM f newSeed
 
-initialFrontier ::
-  (a -> b -> c) -> NonEmpty a -> NonEmpty b -> Strict.ST s (Frontier s a b c)
-initialFrontier f as bs = do
+initialState ::
+  (Ord c) =>
+  (a -> b -> c) ->
+  NonEmpty a ->
+  NonEmpty b ->
+  Strict.ST s (c, Frontier s a b c)
+initialState f as bs = do
   list <- DoublyLinked.empty
-  position <- DoublyLinked.cons list (0 :: Int, 0 :: Int)
-  let node = mkNode f position as bs
-  pure $ Frontier $ MinPQueue.singleton node.value node
+  rootPosition <- DoublyLinked.cons list (0 :: Int, 0 :: Int)
+  let rootNode = mkNode f rootPosition as bs
+  let emptyFrontier = Frontier MinPQueue.empty
+  peekInsertChildren f rootNode emptyFrontier
 
 step ::
   (Ord c) =>

From 961b05f6e79706fd2aab6851fc44f4c571d1a31c Mon Sep 17 00:00:00 2001
From: Preetham Gujjula <gitcommit@mail.preetham.io>
Date: Thu, 9 May 2024 01:12:20 -0700
Subject: [PATCH 8/8] Add Data.List.NonEmpty.ApplyMerge

---
 apply-merge.cabal                    |  3 +++
 package.yaml                         |  1 +
 src/ApplyMerge/DoublyLinkedList.hs   |  2 +-
 src/ApplyMerge/IntMap.hs             |  2 +-
 src/ApplyMerge/IntSet.hs             |  2 +-
 src/Data/List/NonEmpty/ApplyMerge.hs | 29 ++++++++++++++++++++++++++++
 6 files changed, 36 insertions(+), 3 deletions(-)
 create mode 100644 src/Data/List/NonEmpty/ApplyMerge.hs

diff --git a/apply-merge.cabal b/apply-merge.cabal
index c1f6c4e..492c71d 100644
--- a/apply-merge.cabal
+++ b/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
diff --git a/package.yaml b/package.yaml
index 6aae25c..99aaf1d 100644
--- a/package.yaml
+++ b/package.yaml
@@ -38,6 +38,7 @@ library:
   source-dirs: src
   exposed-modules:
   - Data.List.ApplyMerge
+  - Data.List.NonEmpty.ApplyMerge
   other-modules:
   - ApplyMerge.IntSet
   dependencies:
diff --git a/src/ApplyMerge/DoublyLinkedList.hs b/src/ApplyMerge/DoublyLinkedList.hs
index 8ac8758..14fed78 100644
--- a/src/ApplyMerge/DoublyLinkedList.hs
+++ b/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
diff --git a/src/ApplyMerge/IntMap.hs b/src/ApplyMerge/IntMap.hs
index 384d4eb..a328258 100644
--- a/src/ApplyMerge/IntMap.hs
+++ b/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)
diff --git a/src/ApplyMerge/IntSet.hs b/src/ApplyMerge/IntSet.hs
index 2fde91a..b63bee2 100644
--- a/src/ApplyMerge/IntSet.hs
+++ b/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)
diff --git a/src/Data/List/NonEmpty/ApplyMerge.hs b/src/Data/List/NonEmpty/ApplyMerge.hs
new file mode 100644
index 0000000..41fe838
--- /dev/null
+++ b/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 <libraries@mail.preetham.io>
+-- 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)