apply-merge 0.1.0.0 → 0.1.1.0

raw patch · 28 files changed

+1244/−605 lines, 28 filesdep +data-ordlistdep +reflectiondep +tasty-quickcheckdep −falsifydep ~basedep ~containersdep ~pqueuePVP ok

version bump matches the API change (PVP)

Dependencies added: data-ordlist, reflection, tasty-quickcheck

Dependencies removed: falsify

Dependency ranges changed: base, containers, pqueue, tasty-bench

API changes (from Hackage documentation)

Files

• ChangeLog.md +17/−0
• LICENSES/BSD-3-Clause.txt +11/−0
• README.md +5/−4
• apply-merge.cabal +33/−15
• bench/Bench/ApplyMerge.hs +93/−0
• bench/Main.hs +3/−31
• docs/Benchmark.md +249/−0
• src/ApplyMerge/DoublyLinkedList.hs +159/−0
• src/ApplyMerge/IntMap.hs +120/−0
• src/ApplyMerge/IntSet.hs +122/−0
• src/ApplyMerge/MergeAll.hs +10/−0
• src/Data/List/ApplyMerge.hs +54/−3
• src/Data/List/ApplyMerge/DoublyLinkedList.hs +0/−149
• src/Data/List/ApplyMerge/IntMap.hs +0/−98
• src/Data/List/ApplyMerge/IntSet.hs +0/−100
• src/Data/List/NonEmpty/ApplyMerge.hs +76/−0
• test/Main.hs +11/−7
• test/Test/ApplyMerge/Common.hs +110/−0
• test/Test/ApplyMerge/DoublyLinkedList.hs +25/−0
• test/Test/ApplyMerge/IntMap.hs +26/−0
• test/Test/ApplyMerge/IntSet.hs +25/−0
• test/Test/ApplyMerge/MergeAll.hs +25/−0
• test/Test/Data/List/ApplyMerge.hs +67/−0
• test/Test/Data/List/ApplyMerge/Common.hs +0/−110
• test/Test/Data/List/ApplyMerge/DoublyLinkedList.hs +0/−25
• test/Test/Data/List/ApplyMerge/IntMap.hs +0/−26
• test/Test/Data/List/ApplyMerge/IntSet.hs +0/−25
• test/Test/Data/PQueue/Prio/Min/Mutable.hs +3/−12

@@ -5,6 +5,23 @@  # Changelog for apply-merge +## 0.1.0.1++### Added+* Implementation of `applyMergeOn`+  ([#1](https://github.com/pgujjula/apply-merge/issues/1)) and `applyMergeBy`+  ([#3](https://github.com/pgujjula/apply-merge/issues/3)).+* Implementation of `applyMerge` for `NonEmpty`+  ([#2](https://github.com/pgujjula/apply-merge/issues/2)).+* Comprehensive benchmark suite for `applyMerge`+  ([#8](https://github.com/pgujjula/apply-merge/issues/8)).++### Changed+* Switched from falsify to QuickCheck in the test suite, allowing the+  project to be used in Stackage+  ([link](https://github.com/well-typed/falsify/issues/71)).+* CI configured to test GHC 9.2.8, 9.4.8, 9.6.5, 9.8.2.+ ## 0.1.0.0  ### Added

@@ -0,0 +1,11 @@+Copyright (c) <year> <owner>.++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -5,8 +5,9 @@  # apply-merge -[![CI](https://github.com/pgujjula/apply-merge/actions/workflows/ci.yml/badge.svg?branch=main)](https://github.com/pgujjula/apply-merge/actions/workflows/ci.yml)-[![REUSE status](https://api.reuse.software/badge/github.com/pgujjula/apply-merge)](https://api.reuse.software/info/github.com/pgujjula/apply-merge)+![CI](https://github.com/pgujjula/apply-merge/actions/workflows/ci.yml/badge.svg?branch=main)+![REUSE status](https://api.reuse.software/badge/github.com/pgujjula/apply-merge)+![Hackage Version](https://img.shields.io/hackage/v/apply-merge?style=flat&color=blue)  Lift a binary, non-decreasing function onto ordered lists and order the output @@ -24,8 +25,8 @@  Producing $n$ elements of `applyMerge f xs ys` takes $O(n \log n)$ time and $O(\sqrt{n})$ auxiliary space, assuming that `f` and `compare` take $O(1)$ time.-See-[docs/ALGORITHM.md#note-about-memory-usage](docs/ALGORITHM.md#note-about-memory-usage)+See <!-- Relative link doesn't work here for some reason, see issue #17 -->+[docs/ALGORITHM.md#note-about-memory-usage](https://github.com/pgujjula/apply-merge/blob/main/docs/ALGORITHM.md#note-about-memory-usage) for caveats.  ## Examples

@@ -1,11 +1,11 @@-cabal-version: 3.6+cabal-version: 2.2  -- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack  name:           apply-merge-version:        0.1.0.0+version:        0.1.1.0 synopsis:       Lift a binary, non-decreasing function onto ordered lists and order the output description:    Please see the README on GitHub at <https://github.com/pgujjula/apply-merge#readme> category:       Data@@ -18,11 +18,16 @@ license:        BSD-3-Clause build-type:     Simple tested-with:-    GHC == {9.2.8, 9.4.8, 9.6.4}+    GHC == 9.2.8+  , GHC == 9.4.8+  , GHC == 9.6.5+  , GHC == 9.8.2 extra-doc-files:     README.md     ChangeLog.md     docs/ALGORITHM.md+    docs/Benchmark.md+    LICENSES/BSD-3-Clause.txt  source-repository head   type: git@@ -31,8 +36,9 @@ library   exposed-modules:       Data.List.ApplyMerge+      Data.List.NonEmpty.ApplyMerge   other-modules:-      Data.List.ApplyMerge.IntSet+      ApplyMerge.IntSet   hs-source-dirs:       src   ghc-options: -Wall -Wunused-packages@@ -40,23 +46,28 @@       base >=4.16 && <4.17 || >=4.17 && <4.18 || >=4.18 && <4.19 || >=4.19 && <4.20     , containers ==0.6.*     , pqueue >=1.4 && <1.5 || >=1.5 && <1.6+    , reflection ==2.1.*   default-language: GHC2021  test-suite apply-merge-tests   type: exitcode-stdio-1.0   main-is: Main.hs   other-modules:+      ApplyMerge.DoublyLinkedList+      ApplyMerge.IntMap+      ApplyMerge.IntSet+      ApplyMerge.MergeAll       Data.DoublyLinkedList.STRef       Data.List.ApplyMerge-      Data.List.ApplyMerge.DoublyLinkedList-      Data.List.ApplyMerge.IntMap-      Data.List.ApplyMerge.IntSet+      Data.List.NonEmpty.ApplyMerge       Data.PQueue.Prio.Min.Mutable+      Test.ApplyMerge.Common+      Test.ApplyMerge.DoublyLinkedList+      Test.ApplyMerge.IntMap+      Test.ApplyMerge.IntSet+      Test.ApplyMerge.MergeAll       Test.Data.DoublyLinkedList.STRef-      Test.Data.List.ApplyMerge.Common-      Test.Data.List.ApplyMerge.DoublyLinkedList-      Test.Data.List.ApplyMerge.IntMap-      Test.Data.List.ApplyMerge.IntSet+      Test.Data.List.ApplyMerge       Test.Data.PQueue.Prio.Min.Mutable   hs-source-dirs:       src@@ -65,11 +76,13 @@   build-depends:       base >=4.16 && <4.17 || >=4.17 && <4.18 || >=4.18 && <4.19 || >=4.19 && <4.20     , containers ==0.6.*-    , falsify ==0.2.*+    , data-ordlist ==0.4.*     , pqueue >=1.4 && <1.5 || >=1.5 && <1.6+    , reflection ==2.1.*     , tasty >=1.4 && <1.5 || >=1.5 && <1.6     , tasty-expected-failure ==0.12.*     , tasty-hunit ==0.10.*+    , tasty-quickcheck ==0.10.*     , transformers >=0.5 && <0.6 || >=0.6 && <0.7     , vector >=0.12 && <0.13 || >=0.13 && <0.14   default-language: GHC2021@@ -78,12 +91,15 @@   type: exitcode-stdio-1.0   main-is: Main.hs   other-modules:+      ApplyMerge.DoublyLinkedList+      ApplyMerge.IntMap+      ApplyMerge.IntSet+      ApplyMerge.MergeAll       Data.DoublyLinkedList.STRef       Data.List.ApplyMerge-      Data.List.ApplyMerge.DoublyLinkedList-      Data.List.ApplyMerge.IntMap-      Data.List.ApplyMerge.IntSet+      Data.List.NonEmpty.ApplyMerge       Data.PQueue.Prio.Min.Mutable+      Bench.ApplyMerge       Bench.Data.DoublyLinkedList.STRef       Bench.PriorityQueue.MinPQueue       Bench.PriorityQueue.MinPQueue.Mutable@@ -94,7 +110,9 @@   build-depends:       base >=4.16 && <4.17 || >=4.17 && <4.18 || >=4.18 && <4.19 || >=4.19 && <4.20     , containers ==0.6.*+    , data-ordlist ==0.4.*     , pqueue >=1.4 && <1.5 || >=1.5 && <1.6+    , reflection ==2.1.*     , tasty-bench ==0.3.*     , transformers >=0.5 && <0.6 || >=0.6 && <0.7     , vector >=0.12 && <0.13 || >=0.13 && <0.14

@@ -0,0 +1,93 @@+-- SPDX-FileCopyrightText: Copyright Preetham Gujjula+-- SPDX-License-Identifier: BSD-3-Clause+{-# LANGUAGE ImpredicativeTypes #-}++module Bench.ApplyMerge (benchmarks) where++import ApplyMerge.DoublyLinkedList qualified+import ApplyMerge.IntMap qualified+import ApplyMerge.IntSet qualified+import ApplyMerge.MergeAll qualified+import Data.Function ((&))+import Data.List.Ordered (minus)+import Test.Tasty.Bench (Benchmark, bench, bgroup, nf)++benchmarks :: Benchmark+benchmarks =+  bgroup+    "ApplyMerge"+    [ funcToBenchmark+        "linear shape: applyMerge const [1..] [1..]"+        const,+      funcToBenchmark+        "double linear shape: applyMerge min [1..] [1..]"+        min,+      funcToBenchmark+        "box shape: applyMerge max [1..] [1..]"+        max,+      funcToBenchmark+        "triangular shape: applyMerge (+) [1..] [1..]"+        (+),+      funcToBenchmark+        "skewed triangular shape: applyMerge (\\x y -> 4 * x + y) [1..] [1..]"+        (\x y -> 4 * x + y),+      funcToBenchmark+        "hyperbolic shape: applyMerge (*) [1..] [1..]"+        (*),+      funcToBenchmark+        "skewed hyperbolic shape: applyMerge (\\x y -> x^3 * y) [1..] [1..]"+        ( \x y ->+            floor @Double $+              100 * (3 * log (fromIntegral x + fromIntegral y))+        ),+      funcToBenchmark+        "circular shape: applyMerge (\\x y -> x*x + y*y) [1..] [1..]"+        (\x y -> x * x + y * y),+      funcToBenchmark+        "elliptical shape: applyMerge (\\x y -> 4*x*x + y*y) [1..] [1..]"+        (\x y -> 4 * x * x + y * y),+      collapseToBenchmark "primes" $ \applyMerge n ->+        let zero :: Int+            zero = (n `quot` maxBound)++            primes :: [Int]+            primes = 2 : 3 : 5 : ([7 ..] `minus` composites)++            composites :: [Int]+            composites = applyMerge (\p j -> p * (p + j)) primes [zero ..]+         in sum (takeWhile (<= n) primes)+    ]++type ApplyMerge = forall a b c. (Ord c) => (a -> b -> c) -> [a] -> [b] -> [c]++funcToBenchmark :: String -> (Int -> Int -> Int) -> Benchmark+funcToBenchmark name f = collapseToBenchmark name (funcToCollapse f)++funcToCollapse :: (Int -> Int -> Int) -> ApplyMerge -> Int -> Int+funcToCollapse f applyMerge n =+  let one = (n `quot` maxBound) + 1+   in applyMerge f [one ..] [one ..]+        & take n+        & sum++collapseToBenchmark :: String -> (ApplyMerge -> Int -> Int) -> Benchmark+collapseToBenchmark name collapse = bgroup name (map mkBench [1 .. 6])+  where+    mkBench :: Int -> Benchmark+    mkBench i =+      let limit :: Int+          limit = 10 ^ i++          applyMerges :: [(String, ApplyMerge)]+          applyMerges =+            [ ("DoublyLinkedList", ApplyMerge.DoublyLinkedList.applyMerge),+              ("IntMap", ApplyMerge.IntMap.applyMerge),+              ("IntSet", ApplyMerge.IntSet.applyMerge),+              ("MergeAll", ApplyMerge.MergeAll.applyMerge),+              ( "MergeAll (flipped)",+                flip . ApplyMerge.MergeAll.applyMerge . flip+              )+            ]+       in bgroup (show limit) $+            flip map applyMerges $ \(applyMergeName, applyMerge) ->+              bench applyMergeName (nf (collapse applyMerge) limit)

@@ -3,45 +3,17 @@  module Main (main) where +import Bench.ApplyMerge qualified import Bench.Data.DoublyLinkedList.STRef qualified import Bench.PriorityQueue.MinPQueue qualified import Bench.PriorityQueue.MinPQueue.Mutable qualified-import Data.Function ((&))-import Data.List.ApplyMerge.DoublyLinkedList qualified-import Data.List.ApplyMerge.IntMap qualified-import Data.List.ApplyMerge.IntSet qualified-import Test.Tasty.Bench (Benchmark, bench, bgroup, defaultMain, nf)+import Test.Tasty.Bench (defaultMain)  main :: IO () main =   defaultMain-    [ benchCommon-        "DoublyLinkedList"-        Data.List.ApplyMerge.DoublyLinkedList.applyMerge,-      benchCommon "IntMap" Data.List.ApplyMerge.IntMap.applyMerge,-      benchCommon "IntSet" Data.List.ApplyMerge.IntSet.applyMerge,+    [ Bench.ApplyMerge.benchmarks,       Bench.Data.DoublyLinkedList.STRef.benchmarks,       Bench.PriorityQueue.MinPQueue.benchmarks,       Bench.PriorityQueue.MinPQueue.Mutable.benchmarks     ]--benchCommon ::-  String ->-  (forall a b c. (Ord c) => (a -> b -> c) -> [a] -> [b] -> [c]) ->-  Benchmark-benchCommon name applyMerge =-  bgroup name [benchmarkSymmetric]-  where-    benchmarkSymmetric :: Benchmark-    benchmarkSymmetric =-      bgroup "benchmarkSymmetric" (fmap mkBench [1 .. (6 :: Int)])-      where-        mkBench :: Int -> Benchmark-        mkBench i = bench (show i) (nf collapse (10 ^ i))-          where-            collapse :: Int -> Int-            collapse n =-              let start = (n `quot` maxBound) + 1-               in applyMerge (*) [start ..] [start ..]-                    & take n-                    & sum

@@ -0,0 +1,249 @@+<!--+SPDX-FileCopyrightText: Copyright Preetham Gujjula+SPDX-License-Identifier: BSD-3-Clause+-->++We benchmark the performance of the `applyMerge` implementations on different+"shapes" of generated elements.++* Linear: `applyMerge const [1..] [1..]`+  <details>+    <summary>Shape</summary>++      . . . . . . . . . . . . . . .+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+  </details>++* Double linear: `applyMerge min [1..] [1..]`+  <details>+    <summary>Shape</summary>++      . . . . . . . . . . . . . . .+      . * * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+  </details>++* Box: `applyMerge max [1..] [1..]`+  <details>+    <summary>Shape</summary>++      . . . . . . . * * * * * * * *+      . . . . . . . * * * * * * * *+      . . . . . . . * * * * * * * *+      . . . . . . . * * * * * * * *+      . . . . . . . * * * * * * * *+      . . . . . . . * * * * * * * *+      . . . . . . . * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+  </details>++* Triangular `applyMerge (+) [1..] [1..]`+  <details>+      <summary>Shape</summary>++      . . . . . . . . . . . . . . *+      . . . . . . . . . . . . . * *+      . . . . . . . . . . . . * * *+      . . . . . . . . . . . * * * *+      . . . . . . . . . . * * * * *+      . . . . . . . . . * * * * * *+      . . . . . . . . * * * * * * *+      . . . . . . . * * * * * * * *+      . . . . . . . * * * * * * * *+      . . . . . . * * * * * * * * *+      . . . . . * * * * * * * * * *+      . . . . * * * * * * * * * * *+      . . . * * * * * * * * * * * *+      . . * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+  </details>++* Skewed triangular `applyMerge (\x y -> 4 * x + y) [1..] [1..]`+  <details>+    <summary>Shape</summary>++      . . . . . . . . . . . . . . *+      . . . . . . . . . . * * * * *+      . . . . . . * * * * * * * * *+      . . * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+  </details>++* Hyperbolic: `applyMerge (*) [1..] [1..]`+  <details>+    <summary>Shape</summary>++      . . . . . . . . . . . . . . .+      . . . . . . . * * * * * * * *+      . . . . . * * * * * * * * * *+      . . . * * * * * * * * * * * *+      . . . * * * * * * * * * * * *+      . . * * * * * * * * * * * * *+      . . * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+    </summary>+  </details>++* Skewed hyperbolic `applyMerge (\x y -> x^3 * y) [1..]`+  <details>+    <summary>Shape</summary>++      . . . . . . . . . . . . . . .+      . . . . . . . . . . . . . . .+      . . . . . . . . . * * * * * *+      . . . * * * * * * * * * * * *+      . . * * * * * * * * * * * * *+      . * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+  </details>++* Circular: `applyMerge (\x y -> x*x + y*y) [1..]`+  <details>+    <summary>Shape</summary>++      . . . . . . . . . . . . . * *+      . . . . . . . . . . . . . * *+      . . . . . . . . . . . . . * *+      . . . . . . . . . . . . . * *+      . . . . . . . . . . . . * * *+      . . . . . . . . . . . . * * *+      . . . . . . . . . . . * * * *+      . . . . . . . . . . . * * * *+      . . . . . . . . . . * * * * *+      . . . . . . . . . * * * * * *+      . . . . . . . . * * * * * * *+      . . . . . . * * * * * * * * *+      . . . . * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+  </details>++* Elliptical: `applyMerge (\x y -> 4*x*x + y*y) [1..]`+  <details>+    <summary>Shape</summary>++      . . . . . . . . . . . . . . *+      . . . . . . . . . . . . . * *+      . . . . . . . . . . . . . * *+      . . . . . . . . . . . . * * *+      . . . . . . . . . . * * * * *+      . . . . . . . * * * * * * * *+      . . . * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+  </details>++* Composites:++  We can generate prime numbers using the Sieve of Erastosthenes:+  ````haskell+  primes :: [Int]+  primes = 2 : ([3..] `minus` composites)    -- `minus` from data-ordlist++  composites :: [Int]+  composites = applyMerge (\p i -> p * (p + i)) primes [0..]+  ````++  The shape of `composites` then looks like:+  <details>+    <summary>Shape</summary>++      . . . . . . . . . . . . . . .+      . . . . . . . . . . . . . . .+      . . . . . . . . . . . * * * *+      . . . . * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+      * * * * * * * * * * * * * * *+  </details>++  Since the *n*th prime number is approximately *n* log *n*, this is a+  quasi-hyperbolic shape, roughly equivalent to++  ```haskell+  f :: Int -> Int -> Double+  f x y =+    let x' :: Double+        x' = fromIntegral x++        y' :: Double+        y' = fromIntegral y++        xlogx :: Double+        xlogx = x' * log x'+     in xlogx * (xlogx + y')++  compositesApprox :: [Double]+  compositesApprox = applyMerge f [1..] [1..]+  ```

@@ -0,0 +1,159 @@+-- SPDX-FileCopyrightText: Copyright Preetham Gujjula+-- SPDX-License-Identifier: BSD-3-Clause+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE NoFieldSelectors #-}++module ApplyMerge.DoublyLinkedList (applyMerge, applyMergeNonEmpty) where++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)+import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)+import Data.DoublyLinkedList.STRef qualified as DoublyLinked+import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty)+import Data.List.NonEmpty qualified as NonEmpty+import Data.Maybe (fromMaybe)+import Data.PQueue.Prio.Min (MinPQueue)+import Data.PQueue.Prio.Min qualified as MinPQueue++data Node s a b c = Node+  { position :: DoublyLinked.DoublyLinkedNode s (Int, Int),+    value :: c,+    as :: NonEmpty a,+    bs :: NonEmpty b+  }++newtype Frontier s a b c = Frontier+  { queue :: MinPQueue c (Node s a b c)+  }++applyMerge :: (Ord c) => (a -> b -> c) -> [a] -> [b] -> [c]+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 -> NonEmpty c+applyMergeNonEmpty f as bs = Lazy.runST $ do+  (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+  result <- f seed+  case result of+    Nothing -> pure []+    Just (x, newSeed) -> (x :) <$> unfoldrM f newSeed++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+  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) =>+  (a -> b -> c) ->+  Frontier s a b c ->+  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 -> 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')++nextNodeValue :: DoublyLinked.DoublyLinkedNode s a -> Strict.ST s (Maybe a)+nextNodeValue valueNode = runMaybeT $ do+  valueNode' <- MaybeT $ DoublyLinked.next valueNode+  pure (DoublyLinked.value valueNode')++prevNodeValue :: DoublyLinked.DoublyLinkedNode s a -> Strict.ST s (Maybe a)+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) ->+  Node s a b c ->+  Frontier s a b c ->+  Strict.ST s (Frontier s a b c)+insertChildA f node frontier = fmap (fromMaybe frontier) $ runMaybeT $ do+  let (ia, ib) = DoublyLinked.value node.position+  nextPosition <- lift $ nextNodeValue node.position+  guard (fmap fst nextPosition /= Just (ia + 1))+  as' <- hoistMaybe (nonEmpty (NonEmpty.tail node.as))+  let bs' = node.bs+  position' <- lift (DoublyLinked.insertAfter node.position (ia + 1, ib))+  let value' = f (NonEmpty.head as') (NonEmpty.head bs')+  let node' =+        Node+          { position = position',+            value = value',+            as = as',+            bs = bs'+          }+  pure $ Frontier $ MinPQueue.insert value' node' frontier.queue++insertChildB ::+  (Ord c) =>+  (a -> b -> c) ->+  Node s a b c ->+  Frontier s a b c ->+  Strict.ST s (Frontier s a b c)+insertChildB f node frontier = fmap (fromMaybe frontier) $ runMaybeT $ do+  let (ia, ib) = DoublyLinked.value node.position+  prevPosition <- lift $ prevNodeValue node.position+  guard (fmap snd prevPosition /= Just (ib + 1))+  bs' <- hoistMaybe (nonEmpty (NonEmpty.tail node.bs))+  let as' = node.as+  position' <- lift (DoublyLinked.insertBefore node.position (ia, ib + 1))+  let value' = f (NonEmpty.head as') (NonEmpty.head bs')+  let node' = mkNode f position' as' bs'+  pure $ Frontier $ MinPQueue.insert value' node' frontier.queue++mkNode ::+  (a -> b -> c) ->+  DoublyLinked.DoublyLinkedNode s (Int, Int) ->+  NonEmpty a ->+  NonEmpty b ->+  Node s a b c+mkNode f position as bs =+  Node+    { position = position,+      value = f (NonEmpty.head as) (NonEmpty.head bs),+      as = as,+      bs = bs+    }++-- Remove this once we allow transformers-0.6+hoistMaybe :: (Applicative m) => Maybe b -> MaybeT m b+hoistMaybe = MaybeT . pure

@@ -0,0 +1,120 @@+-- SPDX-FileCopyrightText: Copyright Preetham Gujjula+-- SPDX-License-Identifier: BSD-3-Clause+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE NoFieldSelectors #-}++module ApplyMerge.IntMap (applyMerge, applyMergeNonEmpty) where++import Control.Arrow ((>>>))+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 qualified as NonEmpty+import Data.Maybe (fromMaybe)+import Data.PQueue.Prio.Min (MinPQueue)+import Data.PQueue.Prio.Min qualified as MinPQueue++data Node a b c = Node+  { position :: (Int, Int),+    value :: c,+    as :: NonEmpty a,+    bs :: NonEmpty b+  }++data Frontier a b c = Frontier+  { queue :: MinPQueue c (Node a b c),+    indexMap :: IntMap Int+  }++applyMerge :: (Ord c) => (a -> b -> c) -> [a] -> [b] -> [c]+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 -> 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++deleteMinNode :: (Ord c) => Frontier a b c -> Maybe (Node a b c, Frontier a b c)+deleteMinNode frontier = do+  (node, queue') <- MinPQueue.minView frontier.queue+  let (ia, _) = node.position+      frontier' =+        Frontier+          { queue = queue',+            indexMap = IntMap.delete ia frontier.indexMap+          }+  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+  let iaNext = fmap fst . IntMap.lookupGT ia $ frontier.indexMap+  guard $ iaNext /= Just (ia + 1)+  as' <- nonEmpty (NonEmpty.tail as)+  let childA = mkNode f (ia + 1, ib) as' bs+  pure $ insertNode childA frontier++insertChildB ::+  (Ord c) => (a -> b -> c) -> Node a b c -> Frontier a b c -> Frontier a b c+insertChildB f (Node (ia, ib) _ as bs) frontier = fromMaybe frontier $ do+  let ibNext = fmap snd . IntMap.lookupLT ia $ frontier.indexMap+  guard $ ibNext /= Just (ib + 1)+  bs' <- nonEmpty (NonEmpty.tail bs)+  let childB = mkNode f (ia, ib + 1) as bs'+  pure $ insertNode childB frontier++insertNode :: (Ord c) => Node a b c -> Frontier a b c -> Frontier a b c+insertNode node frontier =+  let (ia, ib) = node.position+   in Frontier+        { queue = MinPQueue.insert node.value node frontier.queue,+          indexMap = IntMap.insert ia ib frontier.indexMap+        }++mkNode :: (a -> b -> c) -> (Int, Int) -> NonEmpty a -> NonEmpty b -> Node a b c+mkNode f (ia, ib) as bs =+  Node+    { position = (ia, ib),+      value = f (NonEmpty.head as) (NonEmpty.head bs),+      as = as,+      bs = bs+    }

@@ -0,0 +1,122 @@+-- SPDX-FileCopyrightText: Copyright Preetham Gujjula+-- SPDX-License-Identifier: BSD-3-Clause+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE NoFieldSelectors #-}++module ApplyMerge.IntSet (applyMerge, applyMergeNonEmpty) where++import Control.Arrow ((>>>))+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 qualified as NonEmpty+import Data.Maybe (fromMaybe)+import Data.PQueue.Prio.Min (MinPQueue)+import Data.PQueue.Prio.Min qualified as MinPQueue++data Node a b c = Node+  { position :: (Int, Int),+    value :: c,+    as :: NonEmpty a,+    bs :: NonEmpty b+  }++data Frontier a b c = Frontier+  { queue :: MinPQueue c (Node a b c),+    indexSetA :: IntSet,+    indexSetB :: IntSet+  }++applyMerge :: (Ord c) => (a -> b -> c) -> [a] -> [b] -> [c]+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 -> 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++deleteMinNode :: (Ord c) => Frontier a b c -> Maybe (Node a b c, Frontier a b c)+deleteMinNode frontier = do+  (node, queue') <- MinPQueue.minView frontier.queue+  let (ia, ib) = node.position+      frontier' =+        Frontier+          { queue = queue',+            indexSetA = IntSet.delete ia frontier.indexSetA,+            indexSetB = IntSet.delete ib frontier.indexSetB+          }+  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+  guard (not (IntSet.member (ia + 1) frontier.indexSetA))+  as' <- nonEmpty (NonEmpty.tail as)+  let childA = mkNode f (ia + 1, ib) as' bs+  pure $ insertNode childA frontier++insertChildB ::+  (Ord c) => (a -> b -> c) -> Node a b c -> Frontier a b c -> Frontier a b c+insertChildB f (Node (ia, ib) _ as bs) frontier = fromMaybe frontier $ do+  guard (not (IntSet.member (ib + 1) frontier.indexSetB))+  bs' <- nonEmpty (NonEmpty.tail bs)+  let childB = mkNode f (ia, ib + 1) as bs'+  pure $ insertNode childB frontier++insertNode :: (Ord c) => Node a b c -> Frontier a b c -> Frontier a b c+insertNode node frontier =+  let (ia, ib) = node.position+   in Frontier+        { queue = MinPQueue.insert node.value node frontier.queue,+          indexSetA = IntSet.insert ia frontier.indexSetA,+          indexSetB = IntSet.insert ib frontier.indexSetB+        }++mkNode :: (a -> b -> c) -> (Int, Int) -> NonEmpty a -> NonEmpty b -> Node a b c+mkNode f (ia, ib) as bs =+  Node+    { position = (ia, ib),+      value = f (NonEmpty.head as) (NonEmpty.head bs),+      as = as,+      bs = bs+    }

@@ -0,0 +1,10 @@+-- SPDX-FileCopyrightText: Copyright Preetham Gujjula+-- SPDX-License-Identifier: BSD-3-Clause+module ApplyMerge.MergeAll (applyMerge) where++import Data.List.Ordered (mergeAll)++applyMerge :: (Ord c) => (a -> b -> c) -> [a] -> [b] -> [c]+applyMerge _ [] _ = []+applyMerge f xs ys =+  mergeAll (map (\y -> map (`f` y) xs) ys)

@@ -1,14 +1,18 @@ -- SPDX-FileCopyrightText: Copyright Preetham Gujjula -- SPDX-License-Identifier: BSD-3-Clause+{-# LANGUAGE UndecidableInstances #-}  -- | -- Module: Data.List.ApplyMerge -- License: BSD-3-Clause -- Maintainer: Preetham Gujjula <libraries@mail.preetham.io> -- Stability: experimental-module Data.List.ApplyMerge (applyMerge) where+module Data.List.ApplyMerge (applyMerge, applyMergeBy, applyMergeOn) where -import Data.List.ApplyMerge.IntSet qualified+import ApplyMerge.IntSet qualified+import Data.Proxy (Proxy (..))+import Data.Reflection (Reifies, reflect, reify)+import Data.Semigroup (Arg (..))  -- | If given a binary function @f@ that is non-decreasing in both arguments, --   and two (potentially infinite) ordered lists @xs@ and @ys@, then@@ -28,4 +32,51 @@ --   For more examples, see --   [README#examples](https://github.com/pgujjula/apply-merge/#examples). applyMerge :: (Ord c) => (a -> b -> c) -> [a] -> [b] -> [c]-applyMerge = Data.List.ApplyMerge.IntSet.applyMerge+applyMerge = ApplyMerge.IntSet.applyMerge++-- | Like 'applyMerge', but uses a custom comparison function.+applyMergeBy :: (c -> c -> Ordering) -> (a -> b -> c) -> [a] -> [b] -> [c]+applyMergeBy = applyMergeBy_++-- Reflection logic in applyMerge_ is based on "All about reflection: a+-- tutorial" [1] by Arnaud Spiwack, licensed under CC BY 4.0 [2].+--+-- [1]: https://www.tweag.io/blog/2017-12-21-reflection-tutorial/+-- [2]: https://creativecommons.org/licenses/by/4.0/+applyMergeBy_ ::+  forall a b c. (c -> c -> Ordering) -> (a -> b -> c) -> [a] -> [b] -> [c]+applyMergeBy_ cmp f as bs =+  reify cmp $ \(_ :: Proxy s) ->+    let f' :: a -> b -> ReflectedOrd s c+        f' a b = ReflectedOrd (f a b)+     in map unReflectedOrd (applyMerge f' as bs)++newtype ReflectedOrd s a = ReflectedOrd {unReflectedOrd :: a}++instance (Reifies s (a -> a -> Ordering)) => Eq (ReflectedOrd s a) where+  (==) (ReflectedOrd x) (ReflectedOrd y) =+    let cmp = reflect (Proxy :: Proxy s)+     in cmp x y == EQ++instance (Reifies s (a -> a -> Ordering)) => Ord (ReflectedOrd s a) where+  compare (ReflectedOrd x) (ReflectedOrd y) =+    let cmp = reflect (Proxy :: Proxy s)+     in cmp x y++-- | Like 'applyMerge', but applies a custom projection function before+--   performing comparisons.+--+--   For example, to compute the Gaussian integers, ordered by norm:+--+--   > zs :: [Integer]+--   > zs = 0 : concatMap (\i -> [i, -i]) [1..]+--   >+--   > gaussianIntegers :: [GaussianInteger]      -- `GaussianInteger` from arithmoi+--   > gaussianIntegers = applyMergeOn norm (:+) zs zs+applyMergeOn ::+  (Ord d) => (c -> d) -> (a -> b -> c) -> [a] -> [b] -> [c]+applyMergeOn p f as bs =+  let f' a b =+        let c = f a b+         in Arg (p c) c+   in map (\(Arg _ c) -> c) (applyMerge f' as bs)

@@ -1,149 +0,0 @@--- SPDX-FileCopyrightText: Copyright Preetham Gujjula--- SPDX-License-Identifier: BSD-3-Clause-{-# LANGUAGE OverloadedRecordDot #-}-{-# LANGUAGE NoFieldSelectors #-}--module Data.List.ApplyMerge.DoublyLinkedList (applyMerge) where--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)-import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)-import Data.DoublyLinkedList.STRef qualified as DoublyLinked-import Data.List.NonEmpty (NonEmpty, nonEmpty)-import Data.List.NonEmpty qualified as NonEmpty-import Data.Maybe (fromMaybe)-import Data.PQueue.Prio.Min (MinPQueue)-import Data.PQueue.Prio.Min qualified as MinPQueue--data Node s a b c = Node-  { position :: DoublyLinked.DoublyLinkedNode s (Int, Int),-    value :: c,-    as :: NonEmpty a,-    bs :: NonEmpty b-  }--newtype Frontier s a b c = Frontier-  { queue :: MinPQueue c (Node s a b c)-  }--applyMerge :: (Ord c) => (a -> b -> c) -> [a] -> [b] -> [c]-applyMerge f as bs =-  fromMaybe [] $-    applyMergeNonEmpty f <$> nonEmpty as <*> nonEmpty bs--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 :: (Monad m) => (b -> m (Maybe (a, b))) -> b -> m [a]-unfoldrM f seed = do-  result <- f seed-  case result of-    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-  list <- DoublyLinked.empty-  position <- DoublyLinked.cons list (0 :: Int, 0 :: Int)-  let c = f (NonEmpty.head as) (NonEmpty.head bs)-      node =-        Node-          { position = position,-            value = c,-            as = as,-            bs = bs-          }-  pure $ Frontier $ MinPQueue.singleton c node--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''')--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-  (node, queue') <- hoistMaybe (MinPQueue.minView frontier.queue)-  let frontier' = Frontier queue'-  pure (node, frontier')--nextNodeValue :: DoublyLinked.DoublyLinkedNode s a -> Strict.ST s (Maybe a)-nextNodeValue valueNode = runMaybeT $ do-  valueNode' <- MaybeT $ DoublyLinked.next valueNode-  pure (DoublyLinked.value valueNode')--prevNodeValue :: DoublyLinked.DoublyLinkedNode s a -> Strict.ST s (Maybe a)-prevNodeValue valueNode = runMaybeT $ do-  valueNode' <- MaybeT $ DoublyLinked.prev valueNode-  pure (DoublyLinked.value valueNode')--insertChildA ::-  (Ord c) =>-  (a -> b -> c) ->-  Node s a b c ->-  Frontier s a b c ->-  Strict.ST s (Frontier s a b c)-insertChildA f node frontier = fmap (fromMaybe frontier) $ runMaybeT $ do-  let (ia, ib) = DoublyLinked.value node.position-  nextPosition <- lift $ nextNodeValue node.position-  guard (fmap fst nextPosition /= Just (ia + 1))-  as' <- hoistMaybe (nonEmpty (NonEmpty.tail node.as))-  let bs' = node.bs-  position' <- lift (DoublyLinked.insertAfter node.position (ia + 1, ib))-  let value' = f (NonEmpty.head as') (NonEmpty.head bs')-  let node' =-        Node-          { position = position',-            value = value',-            as = as',-            bs = bs'-          }-  pure $ Frontier $ MinPQueue.insert value' node' frontier.queue--insertChildB ::-  (Ord c) =>-  (a -> b -> c) ->-  Node s a b c ->-  Frontier s a b c ->-  Strict.ST s (Frontier s a b c)-insertChildB f node frontier = fmap (fromMaybe frontier) $ runMaybeT $ do-  let (ia, ib) = DoublyLinked.value node.position-  prevPosition <- lift $ prevNodeValue node.position-  guard (fmap snd prevPosition /= Just (ib + 1))-  bs' <- hoistMaybe (nonEmpty (NonEmpty.tail node.bs))-  let as' = node.as-  position' <- lift (DoublyLinked.insertBefore node.position (ia, ib + 1))-  let value' = f (NonEmpty.head as') (NonEmpty.head bs')-  let node' = mkNode f position' as' bs'-  pure $ Frontier $ MinPQueue.insert value' node' frontier.queue--mkNode ::-  (a -> b -> c) ->-  DoublyLinked.DoublyLinkedNode s (Int, Int) ->-  NonEmpty a ->-  NonEmpty b ->-  Node s a b c-mkNode f position as bs =-  Node-    { position = position,-      value = f (NonEmpty.head as) (NonEmpty.head bs),-      as = as,-      bs = bs-    }---- Remove this once we allow transformers-0.6-hoistMaybe :: (Applicative m) => Maybe b -> MaybeT m b-hoistMaybe = MaybeT . pure

@@ -1,98 +0,0 @@--- SPDX-FileCopyrightText: Copyright Preetham Gujjula--- SPDX-License-Identifier: BSD-3-Clause-{-# LANGUAGE OverloadedRecordDot #-}-{-# LANGUAGE NoFieldSelectors #-}--module Data.List.ApplyMerge.IntMap (applyMerge) where--import Control.Monad (guard)-import Data.Function ((&))-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 qualified as NonEmpty-import Data.Maybe (fromMaybe)-import Data.PQueue.Prio.Min (MinPQueue)-import Data.PQueue.Prio.Min qualified as MinPQueue--data Node a b c = Node-  { position :: (Int, Int),-    value :: c,-    as :: NonEmpty a,-    bs :: NonEmpty b-  }--data Frontier a b c = Frontier-  { queue :: MinPQueue c (Node a b c),-    indexMap :: IntMap Int-  }--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'))--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-        }--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'')--deleteMinNode :: (Ord c) => Frontier a b c -> Maybe (Node a b c, Frontier a b c)-deleteMinNode frontier = do-  (node, queue') <- MinPQueue.minView frontier.queue-  let (ia, _) = node.position-      frontier' =-        Frontier-          { queue = queue',-            indexMap = IntMap.delete ia frontier.indexMap-          }-  pure (node, frontier')--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-  let iaNext = fmap fst . IntMap.lookupGT ia $ frontier.indexMap-  guard $ iaNext /= Just (ia + 1)-  as' <- nonEmpty (NonEmpty.tail as)-  let childA = mkNode f (ia + 1, ib) as' bs-  pure $ insertNode childA frontier--insertChildB ::-  (Ord c) => (a -> b -> c) -> Node a b c -> Frontier a b c -> Frontier a b c-insertChildB f (Node (ia, ib) _ as bs) frontier = fromMaybe frontier $ do-  let ibNext = fmap snd . IntMap.lookupLT ia $ frontier.indexMap-  guard $ ibNext /= Just (ib + 1)-  bs' <- nonEmpty (NonEmpty.tail bs)-  let childB = mkNode f (ia, ib + 1) as bs'-  pure $ insertNode childB frontier--insertNode :: (Ord c) => Node a b c -> Frontier a b c -> Frontier a b c-insertNode node frontier =-  let (ia, ib) = node.position-   in Frontier-        { queue = MinPQueue.insert node.value node frontier.queue,-          indexMap = IntMap.insert ia ib frontier.indexMap-        }--mkNode :: (a -> b -> c) -> (Int, Int) -> NonEmpty a -> NonEmpty b -> Node a b c-mkNode f (ia, ib) as bs =-  Node-    { position = (ia, ib),-      value = f (NonEmpty.head as) (NonEmpty.head bs),-      as = as,-      bs = bs-    }

@@ -1,100 +0,0 @@--- SPDX-FileCopyrightText: Copyright Preetham Gujjula--- SPDX-License-Identifier: BSD-3-Clause-{-# LANGUAGE OverloadedRecordDot #-}-{-# LANGUAGE NoFieldSelectors #-}--module Data.List.ApplyMerge.IntSet (applyMerge) where--import Control.Monad (guard)-import Data.Function ((&))-import Data.IntSet (IntSet)-import Data.IntSet qualified as IntSet-import Data.List (unfoldr)-import Data.List.NonEmpty (NonEmpty, nonEmpty)-import Data.List.NonEmpty qualified as NonEmpty-import Data.Maybe (fromMaybe)-import Data.PQueue.Prio.Min (MinPQueue)-import Data.PQueue.Prio.Min qualified as MinPQueue--data Node a b c = Node-  { position :: (Int, Int),-    value :: c,-    as :: NonEmpty a,-    bs :: NonEmpty b-  }--data Frontier a b c = Frontier-  { queue :: MinPQueue c (Node a b c),-    indexSetA :: IntSet,-    indexSetB :: IntSet-  }--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'))--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-        }--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'')--deleteMinNode :: (Ord c) => Frontier a b c -> Maybe (Node a b c, Frontier a b c)-deleteMinNode frontier = do-  (node, queue') <- MinPQueue.minView frontier.queue-  let (ia, ib) = node.position-      frontier' =-        Frontier-          { queue = queue',-            indexSetA = IntSet.delete ia frontier.indexSetA,-            indexSetB = IntSet.delete ib frontier.indexSetB-          }-  pure (node, frontier')--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-  guard (not (IntSet.member (ia + 1) frontier.indexSetA))-  as' <- nonEmpty (NonEmpty.tail as)-  let childA = mkNode f (ia + 1, ib) as' bs-  pure $ insertNode childA frontier--insertChildB ::-  (Ord c) => (a -> b -> c) -> Node a b c -> Frontier a b c -> Frontier a b c-insertChildB f (Node (ia, ib) _ as bs) frontier = fromMaybe frontier $ do-  guard (not (IntSet.member (ib + 1) frontier.indexSetB))-  bs' <- nonEmpty (NonEmpty.tail bs)-  let childB = mkNode f (ia, ib + 1) as bs'-  pure $ insertNode childB frontier--insertNode :: (Ord c) => Node a b c -> Frontier a b c -> Frontier a b c-insertNode node frontier =-  let (ia, ib) = node.position-   in Frontier-        { queue = MinPQueue.insert node.value node frontier.queue,-          indexSetA = IntSet.insert ia frontier.indexSetA,-          indexSetB = IntSet.insert ib frontier.indexSetB-        }--mkNode :: (a -> b -> c) -> (Int, Int) -> NonEmpty a -> NonEmpty b -> Node a b c-mkNode f (ia, ib) as bs =-  Node-    { position = (ia, ib),-      value = f (NonEmpty.head as) (NonEmpty.head bs),-      as = as,-      bs = bs-    }

@@ -0,0 +1,76 @@+-- SPDX-FileCopyrightText: Copyright Preetham Gujjula+-- SPDX-License-Identifier: BSD-3-Clause+{-# LANGUAGE UndecidableInstances #-}++-- |+-- Module: Data.List.NonEmpty.ApplyMerge+-- License: BSD-3-Clause+-- Maintainer: Preetham Gujjula <libraries@mail.preetham.io>+-- Stability: experimental+module Data.List.NonEmpty.ApplyMerge+  ( applyMerge,+    applyMergeBy,+    applyMergeOn,+  )+where++import ApplyMerge.IntSet qualified+import Data.List.NonEmpty (NonEmpty)+import Data.List.NonEmpty qualified as NonEmpty+import Data.Proxy (Proxy (..))+import Data.Reflection (Reifies, reflect, reify)+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 uses a custom comparison function.+applyMergeBy ::+  (c -> c -> Ordering) ->+  (a -> b -> c) ->+  NonEmpty a ->+  NonEmpty b ->+  NonEmpty c+applyMergeBy = applyMergeBy_++-- Reflection logic in applyMerge_ is based on "All about reflection: a+-- tutorial" [1] by Arnaud Spiwack, licensed under CC BY 4.0 [2].+--+-- [1]: https://www.tweag.io/blog/2017-12-21-reflection-tutorial/+-- [2]: https://creativecommons.org/licenses/by/4.0/+applyMergeBy_ ::+  forall a b c.+  (c -> c -> Ordering) ->+  (a -> b -> c) ->+  NonEmpty a ->+  NonEmpty b ->+  NonEmpty c+applyMergeBy_ cmp f as bs =+  reify cmp $ \(_ :: Proxy s) ->+    let f' :: a -> b -> ReflectedOrd s c+        f' a b = ReflectedOrd (f a b)+     in NonEmpty.map unReflectedOrd (applyMerge f' as bs)++newtype ReflectedOrd s a = ReflectedOrd {unReflectedOrd :: a}++instance (Reifies s (a -> a -> Ordering)) => Eq (ReflectedOrd s a) where+  (==) (ReflectedOrd x) (ReflectedOrd y) =+    let cmp = reflect (Proxy :: Proxy s)+     in cmp x y == EQ++instance (Reifies s (a -> a -> Ordering)) => Ord (ReflectedOrd s a) where+  compare (ReflectedOrd x) (ReflectedOrd y) =+    let cmp = reflect (Proxy :: Proxy s)+     in cmp x y++-- | 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)

@@ -3,10 +3,12 @@  module Main (main) where +import Test.ApplyMerge.DoublyLinkedList qualified (tests)+import Test.ApplyMerge.IntMap qualified (tests)+import Test.ApplyMerge.IntSet qualified (tests)+import Test.ApplyMerge.MergeAll qualified (tests) import Test.Data.DoublyLinkedList.STRef qualified (tests)-import Test.Data.List.ApplyMerge.DoublyLinkedList qualified (tests)-import Test.Data.List.ApplyMerge.IntMap qualified (tests)-import Test.Data.List.ApplyMerge.IntSet qualified (tests)+import Test.Data.List.ApplyMerge qualified (tests) import Test.Data.PQueue.Prio.Min.Mutable qualified (tests) import Test.Tasty (TestTree, defaultMain, testGroup) @@ -17,9 +19,11 @@ tests =   testGroup     ""-    [ Test.Data.DoublyLinkedList.STRef.tests,-      Test.Data.List.ApplyMerge.DoublyLinkedList.tests,-      Test.Data.List.ApplyMerge.IntMap.tests,-      Test.Data.List.ApplyMerge.IntSet.tests,+    [ Test.ApplyMerge.DoublyLinkedList.tests,+      Test.ApplyMerge.IntMap.tests,+      Test.ApplyMerge.IntSet.tests,+      Test.ApplyMerge.MergeAll.tests,+      Test.Data.List.ApplyMerge.tests,+      Test.Data.DoublyLinkedList.STRef.tests,       Test.Data.PQueue.Prio.Min.Mutable.tests     ]

@@ -0,0 +1,110 @@+-- SPDX-FileCopyrightText: Copyright Preetham Gujjula+-- SPDX-License-Identifier: BSD-3-Clause+{-# LANGUAGE Rank2Types #-}++module Test.ApplyMerge.Common+  ( basicTest,+    skewedTest,+    blockTest,+    maxTest,+  )+where++import Data.List (sort)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++type ApplyMerge = forall a b c. (Ord c) => (a -> b -> c) -> [a] -> [b] -> [c]++basicTest :: ApplyMerge -> TestTree+basicTest applyMerge =+  testGroup+    "basic tests"+    [ testCase "applyMerge (+) [] [] == []" $+        applyMerge (undefined :: Int -> Int -> Int) [] [] @?= [],+      testCase "applyMerge (+) [0 ..] [] == []" $+        applyMerge (+) ([0 ..] :: [Int]) [] @?= [],+      testCase "applyMerge (+) [] [0 ..] == []" $+        applyMerge (+) ([] :: [Int]) [0 ..] @?= [],+      testCase "applyMerge (+) [0 .. 10] [0 .. 10] is correct" $+        let xs :: [Int]+            xs = [0 .. 10]+            expected = sort $ (+) <$> xs <*> xs+         in applyMerge (+) xs xs @?= expected,+      testCase "applyMerge (+) [0 .. 10] (replicate 10 1) is correct" $+        let xs :: [Int]+            xs = [0 .. 10]+            ys :: [Int]+            ys = replicate 10 1+            expected = sort $ (+) <$> xs <*> ys+         in applyMerge (+) xs ys @?= expected,+      testCase "applyMerge (+) (replicate 10 1) [0 .. 10] is correct" $+        let xs :: [Int]+            xs = [0 .. 10]+            ys :: [Int]+            ys = replicate 10 1+            expected = sort $ (+) <$> ys <*> xs+         in applyMerge (+) ys xs @?= expected,+      testCase "applyMerge (+) (replicate 10 1) (replicate 10 1) is correct" $+        let ys :: [Int]+            ys = replicate 10 1+            expected = sort $ (+) <$> ys <*> ys+         in applyMerge (+) ys ys @?= expected,+      testCase "applyMerge (+) [0..] [0..] is correct in the first 100 elems" $+        let xs :: [Int]+            xs = [0 ..]+            expected :: [Int]+            expected = take 100 $ sort $ (+) <$> take 100 xs <*> take 100 xs+         in take 100 (applyMerge (+) xs xs) @?= expected+    ]++skewedTest :: ApplyMerge -> TestTree+skewedTest applyMerge =+  testGroup+    "skewed tests"+    [ testCase "applyMerge (^) [2..] [1..] is correct in the first 100 elems" $+        let bases :: [Integer]+            bases = [2 ..]+            exps :: [Int]+            exps = [1 ..]+            expected :: [Integer]+            expected = take 100 $ sort $ (^) <$> take 100 bases <*> take 100 exps+         in take 100 (applyMerge (^) bases exps) @?= expected,+      testCase "applyMerge (flip (^)) [2..] [1..] is correct in the first 100 elems" $+        let bases :: [Integer]+            bases = [2 ..]+            exps :: [Int]+            exps = [1 ..]+            expected :: [Integer]+            expected = take 100 $ sort $ flip (^) <$> take 100 exps <*> take 100 bases+         in take 100 (applyMerge (flip (^)) exps bases) @?= expected+    ]++blockTest :: ApplyMerge -> TestTree+blockTest applyMerge =+  testGroup+    "block tests"+    [ testCase+        ( "applyMerge (\\x y -> (x `quot` 3) + (y `quot` 3)) [0..] [0..] is correct in the "+            ++ "first 100 elems"+        )+        $ let xs :: [Int]+              xs = [0 ..]+              f :: Int -> Int -> Int+              f x y = (x `quot` 3) + (y `quot` 3)+              expected :: [Int]+              expected = take 100 $ sort $ f <$> take 100 xs <*> take 100 xs+           in take 100 (applyMerge f xs xs) @?= expected+    ]++maxTest :: ApplyMerge -> TestTree+maxTest applyMerge =+  testGroup+    "max tests"+    [ testCase "applyMerge max [0..] [0..] is correct in the first 100 elems" $+        let xs :: [Int]+            xs = [0 ..]+            expected :: [Int]+            expected = take 100 $ sort $ max <$> take 100 xs <*> take 100 xs+         in take 100 (applyMerge max xs xs) @?= expected+    ]

@@ -0,0 +1,25 @@+-- SPDX-FileCopyrightText: Copyright Preetham Gujjula+-- SPDX-License-Identifier: BSD-3-Clause+module Test.ApplyMerge.DoublyLinkedList+  ( tests,+  )+where++import ApplyMerge.DoublyLinkedList (applyMerge)+import Test.ApplyMerge.Common+  ( basicTest,+    blockTest,+    maxTest,+    skewedTest,+  )+import Test.Tasty (TestTree, testGroup)++tests :: TestTree+tests =+  testGroup+    "ApplyMerge.DoublyLinkedList"+    [ basicTest applyMerge,+      skewedTest applyMerge,+      blockTest applyMerge,+      maxTest applyMerge+    ]

@@ -0,0 +1,26 @@+-- SPDX-FileCopyrightText: Copyright Preetham Gujjula+-- SPDX-License-Identifier: BSD-3-Clause++module Test.ApplyMerge.IntMap+  ( tests,+  )+where++import ApplyMerge.IntMap (applyMerge)+import Test.ApplyMerge.Common+  ( basicTest,+    blockTest,+    maxTest,+    skewedTest,+  )+import Test.Tasty (TestTree, testGroup)++tests :: TestTree+tests =+  testGroup+    "ApplyMerge.IntMap"+    [ basicTest applyMerge,+      skewedTest applyMerge,+      blockTest applyMerge,+      maxTest applyMerge+    ]

@@ -0,0 +1,25 @@+-- SPDX-FileCopyrightText: Copyright Preetham Gujjula+-- SPDX-License-Identifier: BSD-3-Clause+module Test.ApplyMerge.IntSet+  ( tests,+  )+where++import ApplyMerge.IntSet (applyMerge)+import Test.ApplyMerge.Common+  ( basicTest,+    blockTest,+    maxTest,+    skewedTest,+  )+import Test.Tasty (TestTree, testGroup)++tests :: TestTree+tests =+  testGroup+    "ApplyMerge.IntSet"+    [ basicTest applyMerge,+      skewedTest applyMerge,+      blockTest applyMerge,+      maxTest applyMerge+    ]

@@ -0,0 +1,25 @@+-- SPDX-FileCopyrightText: Copyright Preetham Gujjula+-- SPDX-License-Identifier: BSD-3-Clause+module Test.ApplyMerge.MergeAll+  ( tests,+  )+where++import ApplyMerge.MergeAll (applyMerge)+import Test.ApplyMerge.Common+  ( basicTest,+    blockTest,+    maxTest,+    skewedTest,+  )+import Test.Tasty (TestTree, testGroup)++tests :: TestTree+tests =+  testGroup+    "ApplyMerge.MergeAll"+    [ basicTest applyMerge,+      skewedTest applyMerge,+      blockTest applyMerge,+      maxTest applyMerge+    ]

@@ -0,0 +1,67 @@+-- SPDX-FileCopyrightText: Copyright Preetham Gujjula+-- SPDX-License-Identifier: BSD-3-Clause+{-# LANGUAGE CPP #-}++module Test.Data.List.ApplyMerge (tests) where++#if !MIN_VERSION_base(4,18,0)+import Control.Applicative (liftA2)+#endif+import Data.Complex (Complex ((:+)))+import Data.List (sortOn)+import Data.List.ApplyMerge (applyMergeBy, applyMergeOn)+import Data.Ratio ((%))+import Test.ApplyMerge.Common (basicTest, blockTest, maxTest, skewedTest)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Data.List.ApplyMerge"+    [ testGroup+        "applyMergeOn"+        [ basicTest (applyMergeOn id),+          skewedTest (applyMergeOn id),+          blockTest (applyMergeOn id),+          maxTest (applyMergeOn id),+          gaussianIntegerTest+        ],+      testGroup+        "applyMergeBy"+        [ basicTest (applyMergeBy compare),+          skewedTest (applyMergeBy compare),+          blockTest (applyMergeBy compare),+          maxTest (applyMergeBy compare)+        ]+    ]++gaussianIntegerTest :: TestTree+gaussianIntegerTest =+  testCase "gaussian integers x + yi, with 0 <= x <= y, ordered by norm" $ do+    let actual =+          take 100 $+            applyMergeOn+              (\x -> (norm x, slope x))+              (\x k -> x :+ (x + k))+              [0 ..]+              [0 ..]+        expected =+          take 100 $+            filter (\(x :+ y) -> x <= y) $+              sortOn+                (\x -> (norm x, slope x))+                (liftA2 (:+) [0 .. 100] [0 .. 100])+     in actual @?= expected++norm :: Complex Integer -> Integer+norm (a :+ b) = a * a + b * b++data Slope = Finite Rational | Infinity+  deriving (Eq, Show, Ord)++slope :: Complex Integer -> Slope+slope (x :+ y) =+  if x == 0+    then Infinity+    else Finite (y % x)

@@ -1,110 +0,0 @@--- SPDX-FileCopyrightText: Copyright Preetham Gujjula--- SPDX-License-Identifier: BSD-3-Clause-{-# LANGUAGE Rank2Types #-}--module Test.Data.List.ApplyMerge.Common-  ( basicTest,-    skewedTest,-    blockTest,-    maxTest,-  )-where--import Data.List (sort)-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (testCase, (@?=))--type ApplyMerge = forall a b c. (Ord c) => (a -> b -> c) -> [a] -> [b] -> [c]--basicTest :: ApplyMerge -> TestTree-basicTest applyMerge =-  testGroup-    "basic tests"-    [ testCase "applyMerge (+) [] [] == []" $-        applyMerge (undefined :: Int -> Int -> Int) [] [] @?= [],-      testCase "applyMerge (+) [0 ..] [] == []" $-        applyMerge (+) ([0 ..] :: [Int]) [] @?= [],-      testCase "applyMerge (+) [] [0 ..] == []" $-        applyMerge (+) ([] :: [Int]) [0 ..] @?= [],-      testCase "applyMerge (+) [0 .. 10] [0 .. 10] is correct" $-        let xs :: [Int]-            xs = [0 .. 10]-            expected = sort $ (+) <$> xs <*> xs-         in applyMerge (+) xs xs @?= expected,-      testCase "applyMerge (+) [0 .. 10] (replicate 10 1) is correct" $-        let xs :: [Int]-            xs = [0 .. 10]-            ys :: [Int]-            ys = replicate 10 1-            expected = sort $ (+) <$> xs <*> ys-         in applyMerge (+) xs ys @?= expected,-      testCase "applyMerge (+) (replicate 10 1) [0 .. 10] is correct" $-        let xs :: [Int]-            xs = [0 .. 10]-            ys :: [Int]-            ys = replicate 10 1-            expected = sort $ (+) <$> ys <*> xs-         in applyMerge (+) ys xs @?= expected,-      testCase "applyMerge (+) (replicate 10 1) (replicate 10 1) is correct" $-        let ys :: [Int]-            ys = replicate 10 1-            expected = sort $ (+) <$> ys <*> ys-         in applyMerge (+) ys ys @?= expected,-      testCase "applyMerge (+) [0..] [0..] is correct in the first 100 elems" $-        let xs :: [Int]-            xs = [0 ..]-            expected :: [Int]-            expected = take 100 $ sort $ (+) <$> take 100 xs <*> take 100 xs-         in take 100 (applyMerge (+) xs xs) @?= expected-    ]--skewedTest :: ApplyMerge -> TestTree-skewedTest applyMerge =-  testGroup-    "skewed tests"-    [ testCase "applyMerge (^) [2..] [1..] is correct in the first 100 elems" $-        let bases :: [Integer]-            bases = [2 ..]-            exps :: [Int]-            exps = [1 ..]-            expected :: [Integer]-            expected = take 100 $ sort $ (^) <$> take 100 bases <*> take 100 exps-         in take 100 (applyMerge (^) bases exps) @?= expected,-      testCase "applyMerge (flip (^)) [2..] [1..] is correct in the first 100 elems" $-        let bases :: [Integer]-            bases = [2 ..]-            exps :: [Int]-            exps = [1 ..]-            expected :: [Integer]-            expected = take 100 $ sort $ flip (^) <$> take 100 exps <*> take 100 bases-         in take 100 (applyMerge (flip (^)) exps bases) @?= expected-    ]--blockTest :: ApplyMerge -> TestTree-blockTest applyMerge =-  testGroup-    "block tests"-    [ testCase-        ( "applyMerge (\\x y -> (x `quot` 3) + (y `quot` 3)) [0..] [0..] is correct in the "-            ++ "first 100 elems"-        )-        $ let xs :: [Int]-              xs = [0 ..]-              f :: Int -> Int -> Int-              f x y = (x `quot` 3) + (y `quot` 3)-              expected :: [Int]-              expected = take 100 $ sort $ f <$> take 100 xs <*> take 100 xs-           in take 100 (applyMerge f xs xs) @?= expected-    ]--maxTest :: ApplyMerge -> TestTree-maxTest applyMerge =-  testGroup-    "max tests"-    [ testCase "applyMerge max [0..] [0..] is correct in the first 100 elems" $-        let xs :: [Int]-            xs = [0 ..]-            expected :: [Int]-            expected = take 100 $ sort $ max <$> take 100 xs <*> take 100 xs-         in take 100 (applyMerge max xs xs) @?= expected-    ]

@@ -1,25 +0,0 @@--- SPDX-FileCopyrightText: Copyright Preetham Gujjula--- SPDX-License-Identifier: BSD-3-Clause-module Test.Data.List.ApplyMerge.DoublyLinkedList-  ( tests,-  )-where--import Data.List.ApplyMerge.DoublyLinkedList (applyMerge)-import Test.Data.List.ApplyMerge.Common-  ( basicTest,-    blockTest,-    maxTest,-    skewedTest,-  )-import Test.Tasty (TestTree, testGroup)--tests :: TestTree-tests =-  testGroup-    "Data.List.ApplyMerge.DoublyLinkedList"-    [ basicTest applyMerge,-      skewedTest applyMerge,-      blockTest applyMerge,-      maxTest applyMerge-    ]

@@ -1,26 +0,0 @@--- SPDX-FileCopyrightText: Copyright Preetham Gujjula--- SPDX-License-Identifier: BSD-3-Clause--module Test.Data.List.ApplyMerge.IntMap-  ( tests,-  )-where--import Data.List.ApplyMerge.IntMap (applyMerge)-import Test.Data.List.ApplyMerge.Common-  ( basicTest,-    blockTest,-    maxTest,-    skewedTest,-  )-import Test.Tasty (TestTree, testGroup)--tests :: TestTree-tests =-  testGroup-    "Data.List.ApplyMerge.IntMap"-    [ basicTest applyMerge,-      skewedTest applyMerge,-      blockTest applyMerge,-      maxTest applyMerge-    ]

@@ -1,25 +0,0 @@--- SPDX-FileCopyrightText: Copyright Preetham Gujjula--- SPDX-License-Identifier: BSD-3-Clause-module Test.Data.List.ApplyMerge.IntSet-  ( tests,-  )-where--import Data.List.ApplyMerge.IntSet (applyMerge)-import Test.Data.List.ApplyMerge.Common-  ( basicTest,-    blockTest,-    maxTest,-    skewedTest,-  )-import Test.Tasty (TestTree, testGroup)--tests :: TestTree-tests =-  testGroup-    "Data.List.ApplyMerge.IntSet"-    [ basicTest applyMerge,-      skewedTest applyMerge,-      blockTest applyMerge,-      maxTest applyMerge-    ]

@@ -8,12 +8,8 @@ import Data.List (sort) import Data.Maybe (catMaybes) import Data.PQueue.Prio.Min.Mutable-import Test.Falsify.Generator (int, list)-import Test.Falsify.Predicate (eq, (.$))-import Test.Falsify.Property (Property, assert, gen, info)-import Test.Falsify.Range (between) import Test.Tasty (TestTree, testGroup)-import Test.Tasty.Falsify (testProperty)+import Test.Tasty.QuickCheck (testProperty)  tests :: TestTree tests =@@ -22,13 +18,8 @@     [ testProperty "priority queue sorts a list" prop_sorts_list     ] -prop_sorts_list :: Property ()-prop_sorts_list = do-  xs <- gen $ list (between (1, 20)) (int (between (0, 100)))-  info ("xs == " ++ show xs)-  let actual = pqueueSort xs-  let expected = sort xs-  assert (eq .$ ("expected", expected) .$ ("actual", actual))+prop_sorts_list :: [Int] -> Bool+prop_sorts_list xs = pqueueSort xs == sort xs  pqueueSort :: (Ord a) => [a] -> [a] pqueueSort xs = runST $ do