packages feed

monoidmap (empty) → 0.0.0.0

raw patch · 40 files changed

+12861/−0 lines, 40 filesdep +QuickCheckdep +basedep +containers

Dependencies added: QuickCheck, base, containers, deepseq, groups, hspec, monoid-subclasses, monoidmap, nonempty-containers, nothunks, pretty-show, quickcheck-classes, quickcheck-groups, quickcheck-instances, quickcheck-monoid-subclasses, tasty-bench, tasty-hunit, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# 0.0.0.0++Initial release.
+ LICENSE view
@@ -0,0 +1,201 @@+                                 Apache License+                           Version 2.0, January 2004+                        http://www.apache.org/licenses/++   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++   1. Definitions.++      "License" shall mean the terms and conditions for use, reproduction,+      and distribution as defined by Sections 1 through 9 of this document.++      "Licensor" shall mean the copyright owner or entity authorized by+      the copyright owner that is granting the License.++      "Legal Entity" shall mean the union of the acting entity and all+      other entities that control, are controlled by, or are under common+      control with that entity. For the purposes of this definition,+      "control" means (i) the power, direct or indirect, to cause the+      direction or management of such entity, whether by contract or+      otherwise, or (ii) ownership of fifty percent (50%) or more of the+      outstanding shares, or (iii) beneficial ownership of such entity.++      "You" (or "Your") shall mean an individual or Legal Entity+      exercising permissions granted by this License.++      "Source" form shall mean the preferred form for making modifications,+      including but not limited to software source code, documentation+      source, and configuration files.++      "Object" form shall mean any form resulting from mechanical+      transformation or translation of a Source form, including but+      not limited to compiled object code, generated documentation,+      and conversions to other media types.++      "Work" shall mean the work of authorship, whether in Source or+      Object form, made available under the License, as indicated by a+      copyright notice that is included in or attached to the work+      (an example is provided in the Appendix below).++      "Derivative Works" shall mean any work, whether in Source or Object+      form, that is based on (or derived from) the Work and for which the+      editorial revisions, annotations, elaborations, or other modifications+      represent, as a whole, an original work of authorship. For the purposes+      of this License, Derivative Works shall not include works that remain+      separable from, or merely link (or bind by name) to the interfaces of,+      the Work and Derivative Works thereof.++      "Contribution" shall mean any work of authorship, including+      the original version of the Work and any modifications or additions+      to that Work or Derivative Works thereof, that is intentionally+      submitted to Licensor for inclusion in the Work by the copyright owner+      or by an individual or Legal Entity authorized to submit on behalf of+      the copyright owner. For the purposes of this definition, "submitted"+      means any form of electronic, verbal, or written communication sent+      to the Licensor or its representatives, including but not limited to+      communication on electronic mailing lists, source code control systems,+      and issue tracking systems that are managed by, or on behalf of, the+      Licensor for the purpose of discussing and improving the Work, but+      excluding communication that is conspicuously marked or otherwise+      designated in writing by the copyright owner as "Not a Contribution."++      "Contributor" shall mean Licensor and any individual or Legal Entity+      on behalf of whom a Contribution has been received by Licensor and+      subsequently incorporated within the Work.++   2. Grant of Copyright License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      copyright license to reproduce, prepare Derivative Works of,+      publicly display, publicly perform, sublicense, and distribute the+      Work and such Derivative Works in Source or Object form.++   3. Grant of Patent License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      (except as stated in this section) patent license to make, have made,+      use, offer to sell, sell, import, and otherwise transfer the Work,+      where such license applies only to those patent claims licensable+      by such Contributor that are necessarily infringed by their+      Contribution(s) alone or by combination of their Contribution(s)+      with the Work to which such Contribution(s) was submitted. If You+      institute patent litigation against any entity (including a+      cross-claim or counterclaim in a lawsuit) alleging that the Work+      or a Contribution incorporated within the Work constitutes direct+      or contributory patent infringement, then any patent licenses+      granted to You under this License for that Work shall terminate+      as of the date such litigation is filed.++   4. Redistribution. You may reproduce and distribute copies of the+      Work or Derivative Works thereof in any medium, with or without+      modifications, and in Source or Object form, provided that You+      meet the following conditions:++      (a) You must give any other recipients of the Work or+          Derivative Works a copy of this License; and++      (b) You must cause any modified files to carry prominent notices+          stating that You changed the files; and++      (c) You must retain, in the Source form of any Derivative Works+          that You distribute, all copyright, patent, trademark, and+          attribution notices from the Source form of the Work,+          excluding those notices that do not pertain to any part of+          the Derivative Works; and++      (d) If the Work includes a "NOTICE" text file as part of its+          distribution, then any Derivative Works that You distribute must+          include a readable copy of the attribution notices contained+          within such NOTICE file, excluding those notices that do not+          pertain to any part of the Derivative Works, in at least one+          of the following places: within a NOTICE text file distributed+          as part of the Derivative Works; within the Source form or+          documentation, if provided along with the Derivative Works; or,+          within a display generated by the Derivative Works, if and+          wherever such third-party notices normally appear. The contents+          of the NOTICE file are for informational purposes only and+          do not modify the License. You may add Your own attribution+          notices within Derivative Works that You distribute, alongside+          or as an addendum to the NOTICE text from the Work, provided+          that such additional attribution notices cannot be construed+          as modifying the License.++      You may add Your own copyright statement to Your modifications and+      may provide additional or different license terms and conditions+      for use, reproduction, or distribution of Your modifications, or+      for any such Derivative Works as a whole, provided Your use,+      reproduction, and distribution of the Work otherwise complies with+      the conditions stated in this License.++   5. Submission of Contributions. Unless You explicitly state otherwise,+      any Contribution intentionally submitted for inclusion in the Work+      by You to the Licensor shall be under the terms and conditions of+      this License, without any additional terms or conditions.+      Notwithstanding the above, nothing herein shall supersede or modify+      the terms of any separate license agreement you may have executed+      with Licensor regarding such Contributions.++   6. Trademarks. This License does not grant permission to use the trade+      names, trademarks, service marks, or product names of the Licensor,+      except as required for reasonable and customary use in describing the+      origin of the Work and reproducing the content of the NOTICE file.++   7. Disclaimer of Warranty. Unless required by applicable law or+      agreed to in writing, Licensor provides the Work (and each+      Contributor provides its Contributions) on an "AS IS" BASIS,+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+      implied, including, without limitation, any warranties or conditions+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+      PARTICULAR PURPOSE. You are solely responsible for determining the+      appropriateness of using or redistributing the Work and assume any+      risks associated with Your exercise of permissions under this License.++   8. Limitation of Liability. In no event and under no legal theory,+      whether in tort (including negligence), contract, or otherwise,+      unless required by applicable law (such as deliberate and grossly+      negligent acts) or agreed to in writing, shall any Contributor be+      liable to You for damages, including any direct, indirect, special,+      incidental, or consequential damages of any character arising as a+      result of this License or out of the use or inability to use the+      Work (including but not limited to damages for loss of goodwill,+      work stoppage, computer failure or malfunction, or any and all+      other commercial damages or losses), even if such Contributor+      has been advised of the possibility of such damages.++   9. Accepting Warranty or Additional Liability. While redistributing+      the Work or Derivative Works thereof, You may choose to offer,+      and charge a fee for, acceptance of support, warranty, indemnity,+      or other liability obligations and/or rights consistent with this+      License. However, in accepting such obligations, You may act only+      on Your own behalf and on Your sole responsibility, not on behalf+      of any other Contributor, and only if You agree to indemnify,+      defend, and hold each Contributor harmless for any liability+      incurred by, or claims asserted against, such Contributor by reason+      of your accepting any such warranty or additional liability.++   END OF TERMS AND CONDITIONS++   APPENDIX: How to apply the Apache License to your work.++      To apply the Apache License to your work, attach the following+      boilerplate notice, with the fields enclosed by brackets "[]"+      replaced with your own identifying information. (Don't include+      the brackets!)  The text should be enclosed in the appropriate+      comment syntax for the file format. We also recommend that a+      file or class name and description of purpose be included on the+      same "printed page" as the copyright notice for easier+      identification within third-party archives.++   Copyright © 2022–2023 Jonathan Knowles++   Licensed under the Apache License, Version 2.0 (the "License");+   you may not use this file except in compliance with the License.+   You may obtain a copy of the License at++       http://www.apache.org/licenses/LICENSE-2.0++   Unless required by applicable law or agreed to in writing, software+   distributed under the License is distributed on an "AS IS" BASIS,+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+   See the License for the specific language governing permissions and+   limitations under the License.
+ README.md view
@@ -0,0 +1,1143 @@+# `monoidmap`+<a href="https://jonathanknowles.github.io/monoidmap/"><img src="https://img.shields.io/badge/API-Documentation-227755" /></a>++# Overview++This library provides a **[`MonoidMap`]** type that:++- models a [total function](#relationship-between-keys-and-values) with [finite support](https://en.wikipedia.org/wiki/Support_(mathematics)) from keys to [monoidal][`Monoid`] values, with a default value of [`mempty`][`Monoid.mempty`].+- encodes key-value mappings with a [minimal encoding](#encoding) that only+includes values _not_ equal to [`mempty`][`Monoid.mempty`].+- provides a comprehensive set of [monoidal operations](#monoidal-operations) for transforming, combining, and comparing maps.+- provides a [general basis](#General-basis-for-more-specialised-map-types) for building more specialised monoidal data structures.++# Relationship between keys and values++A map of type <code><a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#t:MonoidMap">MonoidMap</a> k v</code> associates **every** possible key of type `k` with a value of type `v`:++```hs+MonoidMap.get :: (Ord k, Monoid v) => k -> MonoidMap k v -> v+```++The [`empty`][`MonoidMap.empty`] map associates every key `k` with a default value of [`mempty`][`Monoid.mempty`]:++```hs+∀ k. MonoidMap.get k MonoidMap.empty == mempty+```++## Comparison with standard `Map` type++The [`MonoidMap`] type differs from the standard [`containers`] [`Map`] type in how it relates keys to values:++|            Type | Models a total function with finite support        |+|----------------:|:---------------------------------------------------|+|       `Map k v` | from keys of type `k` to values of type `Maybe v`. |+| `MonoidMap k v` | from keys of type `k` to values of type `v`.       |++This difference can be illustrated by comparing the type signatures of operations to query a key for its value, for both types:++```hs+      Map.lookup ::             k ->       Map k v -> Maybe v+MonoidMap.get    :: Monoid v => k -> MonoidMap k v ->       v+```++Whereas a standard [`Map`] has a default value of [`Nothing`], a [`MonoidMap`] has a default value of [`mempty`][`Monoid.mempty`]:++```hs+∀ k.       Map.lookup k       Map.empty == Nothing+∀ k. MonoidMap.get    k MonoidMap.empty == mempty+```++In practice, the standard [`Map`] type uses [`Maybe`] to indicate the _presence_ or _absence_ of a value for a particular key. This representation is necessary because the [`Map`] type imposes no constraints on value types.++However, _monoidal_ types already have a natural way to represent null or empty values: the [`mempty`][`Monoid.mempty`] constant, which represents the neutral or identity element of a [`Monoid`].++Consequently, using a standard [`Map`] with a _monoidal_ value type gives rise to _two_ distinct representations for null or empty values:++| `Map.lookup k m` | Interpretation                                              |+|:-----------------|:------------------------------------------------------------|+| `Nothing`        | Map `m` has _no_ entry for key `k`.                         |+| `Just mempty`    | Map `m` has an entry for key `k`, but the value is _empty_. |++In constrast, the [`MonoidMap`] type provides a single, _canonical_ representation for null or empty values, according to the following conceptual mapping:++| `Map.lookup k m`        | ⟼ | `MonoidMap.get k m`     |+|:------------------------|---|:------------------------|+| `Nothing`               | ⟼ | `mempty`                |+| `Just v \| v == mempty` | ⟼ | `mempty`                |+| `Just v \| v /= mempty` | ⟼ | `v`                     |++## Advantages of using a canonical representation++A canonical representation for [`mempty`][`Monoid.mempty`] values can make it easier to correctly implement operations that compare or combine pairs of maps.++When comparing or combining maps of the standard [`containers`] [`Map`] type, there are **two** cases to consider for each key `k` in each map:++- [`Map`] `m` associates `k` with `Nothing`.+- [`Map`] `m` associates `k` with `Just v`.++With a _pair_ of maps, there are **four** possible cases to consider for each key.++For maps with monoidal values, and in contexts that assume or require a default value of [`mempty`][`Monoid.mempty`], there are now **three** cases to consider for each map:++- [`Map`] `m` associates `k` with `Nothing`.+- [`Map`] `m` associates `k` with `Just v` where `v == mempty`.+- [`Map`] `m` associates `k` with `Just v` where `v /= mempty`.++With a _pair_ of maps, there are now **nine** possible cases to consider for each key.++Mishandling cases such as these can give rise to subtle bugs that manifest in unexpected places. For maps with more complex value types (such as maps that nest other maps), the number of cases requiring consideration can easily multiply further, making it even easier to introduce bugs.++Since all [`MonoidMap`] operations provide a canonical representation for [`mempty`][`Monoid.mempty`] values, it's possible to write functions that compare or combine maps without having to consider [`Nothing`] and <code><a href="https://hackage.haskell.org/package/base/docs/Data-Maybe.html#v:Just">Just</a> <a href="https://hackage.haskell.org/package/base/docs/Data-Monoid.html#v:mempty">mempty</a></code> as separate cases.++# Encoding++A [`MonoidMap`] only encodes mappings from keys to values that are **_not_** equal to [`mempty`][`Monoid.mempty`].++The total function $T$ modelled by a [`MonoidMap`] is encoded as a **support map** $S$, where $S$ is the finite subset of key-value mappings in $T$ for which values are **_not_** equal to [`mempty`][`Monoid.mempty`] (denoted by $\varnothing$):++> $S = \\{ \(k, v\) \in T \ \|\ v \ne \varnothing \\} $++## Automatic minimisation++All [`MonoidMap`] operations perform **automatic minimisation** of the support map, so that [`mempty`][`Monoid.mempty`] values do not appear in:+- any encoding of a [`MonoidMap`];+- any traversal of a [`MonoidMap`].++## Constraints on values++[`MonoidMap`] operations require the monoidal value type to be an instance of [`MonoidNull`].++Instances of [`MonoidNull`] must provide a [`null`][`MonoidNull.null`] indicator function that satisfies the following law:++```hs+null v == (v == mempty)+```++[`MonoidMap`] operations use the [`null`][`MonoidNull.null`] indicator function to detect and exclude [`mempty`][`Monoid.mempty`] values from the support map.++Note that it is _not_ generally necessary for the value type to be an instance of [`Eq`].++<details><summary><strong>Justification</strong></summary>+<br/>++> The set of monoidal types that admit a [`MonoidNull`] instance is strictly larger than the set of monoidal types that admit an [`Eq`] instance.+>+> For any type `v` that is an instance of both [`Eq`] and [`Monoid`], it is _always_ possible to define a [`MonoidNull`] instance:+>+> ```hs+> instance MonoidNull v where+>     null = (== mempty)+> ```+>+> However, there are monoidal types for which it is possible to define a [`MonoidNull`] instance, but not practical (or possible) to define a lawful [`Eq`] instance.+>+> For example, consider the following type:+> ```hs+> Maybe (String -> Sum Natural)+> ```+>+> Requiring a [`MonoidNull`] constraint instead of an [`Eq`] constraint allows [`MonoidMap`] to be usable with a greater range of monoidal value types.++</details>++## Examples of automatic minimisation++<details><summary><strong>Updating a map with a value that <em>may</em> be <code>mempty</code></strong></summary>+<br/>++> Consider the following operation, which constructs a map of type `MonoidMap Int String`:+>+> ```hs+> >>> m0 = fromList [(1, "hello"), (2, "brave"), (3, "new"), (4, "world")]+> >>> m0+> fromList [(1, "hello"), (2, "brave"), (3, "new"), (4, "world")]+> ```+>+> The [`Monoid`] instance for [`String`] defines [`mempty`][`Monoid.mempty`] to be the empty [`String`] `""`.+>+> If we update the map to associate key `3` with value `""`, that association will no longer appear when encoding the map:+>+> ```hs+> >>> m1 = MonoidMap.set 3 "" m0+> >>> m1+> fromList [(1, "hello"), (2, "brave"), (4, "world")]+> ```+>+> However, we can still read the updated value for key `3`:+> ```hs+> >>> MonoidMap.get 3 m1+> ""+> ```++</details>++<details><summary><strong>Constructing a map from a list that <em>may</em> include <code>mempty</code> values</strong></summary>+<br/>++> Consider the following operation, which constructs a map of type `MonoidMap Char (Sum Natural)`:+>+> ```hs+> >>> m = fromList [('a', Sum 0), ('b', Sum 1), ('c', Sum 2), ('d', Sum 3)]+> ```+> The [`Monoid`] instance for <code><a href="https://hackage.haskell.org/package/base/docs/Data-Monoid.html#v:Sum">Sum</a> <a href="https://hackage.haskell.org/package/base/docs/Numeric-Natural.html#t:Natural">Natural</a></code> defines [`mempty`][`Monoid.mempty`] to be `Sum 0`.+>+> The original list contained a mapping from key `'a'` to value `Sum 0`, but that association will not appear when encoding the map:+>+> ```hs+> >>> m+> fromList [('b', Sum 1), ('c', Sum 2), ('d', Sum 3)]+> ```+>+> Nevertheless, we can still read the value for key `'a'`:+> ```hs+> >>> MonoidMap.get 'a' m+> Sum 0+> ```++</details>++<details><summary><strong>Combining maps with operations that <em>may</em> produce <code>mempty</code> values</strong></summary>+<br/>++> Consider the following operations, which construct two maps of type `MonoidMap Char (Sum Natural)`:+>+> ```hs+> >>> m1 = fromList [('a', Sum 1), ('b', Sum   1 )]+> >>> m2 = fromList [('a', Sum 1), ('b', Sum (-1))]+> ```+>+> The [`Semigroup`] instance for <code><a href="https://hackage.haskell.org/package/base/docs/Data-Monoid.html#v:Sum">Sum</a> <a href="https://hackage.haskell.org/package/base/docs/Numeric-Natural.html#t:Natural">Natural</a></code> defines [`<>`] as equivalent to ordinary addition.+>+> If we add both maps together with [`<>`], then each key in the resulting map will be associated with the result of applying [`<>`] to each matching pair of values in the original maps. However, adding together the values for key `'b'` with [`<>`] produces `Sum 0`, so this value will not appear in the encoding:+>+> ```hs+> >>> m1 <> m2+> fromList [('a', Sum 2)]+> ```+>+> Nevertheless, we can still read the value for key `'b'`:+> ```hs+> >>> MonoidMap.get 'b' (m1 <> m2)+> Sum 0+> ```++</details>++## Advantages of automatic minimisation++### Consistency++Automatic exclusion of [`mempty`][`Monoid.mempty`] values can help to ensure consistency when encoding to or decoding from other formats such as JSON, CBOR, or YAML.++For example, you may wish to ensure that:++- When _encoding_ a map, no [`mempty`][`Monoid.mempty`] values appear in the encoded result.+- When _decoding_ a map, no [`mempty`][`Monoid.mempty`] values appear in the decoded result.++### Performance++Automatic exclusion of [`mempty`][`Monoid.mempty`] values makes it possible to perform certain operations in _constant time_, rather than in linear time, as it is never necessary to traverse the entire map in order to determine which values may or may not be [`mempty`][`Monoid.mempty`]:++<table>+<thead>+  <tr valign="top" align="left">+    <th>Operation</th>+    <th>With<br>Automatic<br>Minimisation</th>+    <th>Without<br>Automatic<br>Minimisation</th>+  </tr>+</thead>+<tbody>+  <tr>+    <td><a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:null" rel="nofollow"><code>null</code></a></td>+    <td>$O(1)$</td>+    <td>$O(n)$</td>+  </tr>+  <tr>+    <td><a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:nonNull" rel="nofollow"><code>nonNull</code></a></td>+    <td>$O(1)$</td>+    <td>$O(n)$</td>+  </tr>+  <tr>+    <td><a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:nonNullCount" rel="nofollow"><code>nonNullCount</code></a></td>+    <td>$O(1)$</td>+    <td>$O(n)$</td>+  </tr>+  <tr>+    <td><a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:toMap" rel="nofollow"><code>toMap</code></a></td>+    <td>$O(1)$</td>+    <td>$O(n)$</td>+  </tr>+</tbody>+</table>++### Memory usage++Automatic minimisation makes it easier to reason about the memory usage of a [`MonoidMap`], as memory is not required to encode mappings from keys to empty values.++This is a useful property for large, long-lived map structures that are subject to multiple updates over their lifetimes, where it's important to not retain large numbers of mappings from keys to empty values.++### Simplicity++Some total map data types only perform minimisation when _explicitly demanded to_.++For example, the [`TMap`] data type provides a [`trim`][`TMap.trim`] operation that traverses the map and removes any values that are equal to the _default_ value. This approach has some advantages, such the ability to provide a lawful [`Functor`] instance.++However, this approach also has some disadvantages:+- It might not be obvious _when_ it's necessary to call [`trim`][`TMap.trim`]. For example, consider the following operation: `m1 <> m2`. Could this operation produce a map where some keys map to default values? (Answer: it depends on the choice of default value and the underlying value type.)+- Calling [`trim`][`TMap.trim`] when it _isn't_ necessary might adversely affect performance, since [`trim`][`TMap.trim`] must traverse the entire data structure.+- Not calling [`trim`][`TMap.trim`] when it _is_ necessary might affect correctness. The compiler will not help here, as trimmed and untrimmed maps share the same type.+- Even if [`trim`][`TMap.trim`] is a semantic no-op, default values can _still_ be made visible by operations that encode maps to other types.++Since all [`MonoidMap`] operations perform automatic minimisation when appropriate, it's not necessary for users to reason about when or whether it's necessary to "trim" the map.++Furthermore, for nested maps such as <code><a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#t:MonoidMap">MonoidMap</a> k1 (<a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#t:MonoidMap">MonoidMap</a> k2 v)</code>, automatic minimisation of inner maps enables seamless automatic minimisation of outer maps. See the [`NestedMonoidMap`] type for an example of this.++## Limitations of automatic minimisation++The [`MonoidMap`] type has no [`Functor`] instance, as the requirement to exclude [`mempty`][`Monoid.mempty`] values means that the [`map`][`MonoidMap.map`] operation must remove [`mempty`][`Monoid.mempty`] values from its result. Therefore, [`map`][`MonoidMap.map`] does _not_ unconditionally satisfy the functor composition law:++```hs+map (f . g) == map f . map g+```++<details><summary><strong>Example violation</strong></summary>+<br/>++Consider the following [`MonoidMap`] `m`:+```hs+m :: MonoidMap String String+m = singleton "k" "v"+```++And the following functions `f` and `g`:+```hs+f :: a -> String+f = const "z"++g :: Monoid a => b -> a+g = const mempty+```++By substituting the above definitions into the left-hand side of the functor composition law, we obtain:+```hs+map (f . g) m = map (const "z" . const mempty) (singleton "k" "v")+              = map (const "z"               ) (singleton "k" "v")+              =                                (singleton "k" "z")+```++By substituting the above definitions into the right-hand side of the functor composition law, we obtain:+```hs+map f (map g m) = map (const "z") (map (const mempty) (singleton "k" "v"))+                = map (const "z") mempty+                =                 mempty+```++This leads to the following inequality between the left-hand side and right-hand side:+```hs+singleton "k" "z" /= mempty+```+Therefore, for this example, the functor composition law is not satisfied.++</details>++However, if applying function `f` to [`mempty`][`Monoid.mempty`] produces [`mempty`][`Monoid.mempty`], the functor composition law is satisfied:++```hs+(f mempty == mempty) ==> (∀ g. map (f . g) == map f . map g)+```++# Monoidal operations++The [`MonoidMap`] type provides a comprehensive set of monoidal operations for transforming, combining, and comparing maps.++Instances for several _subclasses_ of [`Semigroup`] and [`Monoid`] are provided, including classes from the following libraries:++- [`monoid-subclasses`]+- [`groups`]++At the root of this hierarchy of subclasses is the [`Semigroup`] class, whose instance for [`MonoidMap`] is defined in terms of the _underlying value type_, so that applying [`<>`] to a _pair of maps_ is equivalent to applying [`<>`] to all _pairs of values_ for matching keys:++```hs+∀ k. MonoidMap.get k (m1 <> m2) == MonoidMap.get k m1 <> get k m2+```++In general, operations for subclasses of [`Semigroup`] and [`Monoid`] are defined _analogously_ to the [`Semigroup`] instance, so that:++- _unary_ operations on _individual maps_ are defined in terms of their distributive application to all values.+- _binary_ operations on _pairs of maps_ are defined in terms of their distributive application to all _pairs of values_ for matching keys.++Unary monoidal operations typically satisfy a property similar to:++```hs+∀ k. MonoidMap.get k (f m) == f (MonoidMap.get k m)+```++Binary monoidal operations typically satisfy a property similar to:++```hs+∀ k. MonoidMap.get k (f m1 m2) == f (MonoidMap.get k m1) (MonoidMap.get k m2)+```++Defining monoidal operations in this way makes it possible to transform, combine, and compare maps in ways that are consistent with the algebraic properties of the underlying monoidal value type.++## Examples of monoidal operations and their properties++<table>+<thead>+  <tr valign="top" align="left">+    <th><code>MonoidMap</code><br>operation</th>+    <th>Required<br>class<br>constraint</th>+    <th>Equivalent<br>class<br>method</th>+    <th>Distributive<br>relationship</th>+  </tr>+</thead>+<tbody>+  <tr>+    <td><a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:append"><code>append</code></a></td>+    <td><a href="https://hackage.haskell.org/package/base/docs/Data-Semigroup.html#t:Semigroup"><code>Semigroup</code></a></td>+    <td><a href="https://hackage.haskell.org/package/base/docs/Data-Semigroup.html#v:-60--62-"><code>(&lt;&gt;)</code></a></td>+    <td><code>∀ k. <a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:get">get</a> k (m1  <a href="https://hackage.haskell.org/package/base/docs/Data-Semigroup.html#v:-60--62-"><></a>   m2) ≡ <a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:get">get</a> k m1  <a href="https://hackage.haskell.org/package/base/docs/Data-Semigroup.html#v:-60--62-"><></a>   <a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:get">get</a> k m2</code></td>+  </tr>+  <tr>+    <td><a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:minus"><code>minus</code></a></td>+    <td><a href="https://hackage.haskell.org/package/groups/docs/Data-Group.html#t:Group"><code>Group</code></a></td>+    <td><a href="https://hackage.haskell.org/package/groups/docs/Data-Group.html#v:-126--126-"><code>(~~)</code></a></td>+    <td><code>∀ k. <a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:get">get</a> k (m1  <a href="https://hackage.haskell.org/package/groups/docs/Data-Group.html#v:-126--126-">~~</a>   m2) ≡ <a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:get">get</a> k m1  <a href="https://hackage.haskell.org/package/groups/docs/Data-Group.html#v:-126--126-">~~</a>   <a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:get">get</a> k m2</code></td>+  </tr>+  <tr>+    <td><a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:monus"><code>monus</code></a></td>+    <td><a href="https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-Monus.html#t:Monus"><code>Monus</code></a></td>+    <td><a href="https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-Monus.html#v:-60--92--62-"><code>(&lt;\&gt;)</code></a></td>+    <td><code>∀ k. <a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:get">get</a> k (m1  <a href="https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-Monus.html#v:-60--92--62-"><\></a>  m2) ≡ <a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:get">get</a> k m1  <a href="https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-Monus.html#v:-60--92--62-"><\></a>  <a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:get">get</a> k m2</code></td>+  </tr>+  <tr>+    <td><a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:intersection"><code>intersection</code></a></td>+    <td><a href="https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-GCD.html#t:GCDMonoid"><code>GCDMonoid</code></a></td>+    <td><a href="https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-GCD.html#v:gcd"><code>gcd</code></a></td>+    <td><code>∀ k. <a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:get">get</a> k (m1 `<a href="https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-GCD.html#v:gcd">gcd</a>` m2) ≡ <a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:get">get</a> k m1 `<a href="https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-GCD.html#v:gcd">gcd</a>` <a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:get">get</a> k m2</code></td>+  </tr>+  <tr>+    <td><a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:union"><code>union</code></a></td>+    <td><a href="https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-LCM.html#t:LCMMonoid"><code>LCMMonoid</code></a></td>+    <td><a href="https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-LCM.html#v:lcm"><code>lcm</code></a></td>+    <td><code>∀ k. <a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:get">get</a> k (m1 `<a href="https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-LCM.html#v:lcm">lcm</a>` m2) ≡ <a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:get">get</a> k m1 `<a href="https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-LCM.html#v:lcm">lcm</a>` <a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:get">get</a> k m2</code></td>+  </tr>+</tbody>+</table>++## Examples of monoidal operations applied to values++<details><summary><strong>Example: <code>MonoidMap k (Set Integer)</code></strong></summary>+<br/>++For maps with [`Set`]-based values, [`MonoidMap.union`] and [`MonoidMap.intersection`] compute the [`Set.union`] and [`Set.intersection`] of each pair of matching values, respectively.++Consider the following maps of type `MonoidMap Char (Set Integer)`:++```hs+>>> m1 = fromList [('a', Set.fromList [0, 1]), ('b', Set.fromList [3, 4])]+>>> m2 = fromList [('a', Set.fromList [0, 2]), ('b', Set.fromList [3, 5])]+```++The [`MonoidMap.union`] of maps `m1` and `m2` is a map that associates every key `k` with the [`Set.union`] of the corresponding sets for `k` in `m1` and `m2`:++```hs+>>> m1 `union` m2+fromList [('a', Set.fromList [0,1,2]), ('b', Set.fromList [3,4,5])]+```++The [`MonoidMap.intersection`] of maps `m1` and `m2` is a map that associates every key `k` with the [`Set.intersection`] of the corresponding sets for `k` in `m1` and `m2`:++```hs+>>> m1 `intersection` m2+fromList [('a', Set.fromList [0]), ('b', Set.fromList [3])]+```+</details>++<details><summary><strong>Example: <code>MonoidMap k (Sum Integer)</code></strong></summary>+<br/>++Consider the following maps of type `MonoidMap Char (Sum Integer)`:++```hs+>>> m1 = fromList [('a', Sum 10), ('b', Sum 20), ('c, Sum 40)]+>>> m2 = fromList [('a', Sum 40), ('b', Sum 20), ('c, Sum 10)]+```++The [`MonoidMap.invert`] operation produces a new map where every key is associated with the negation of its value in the original map:++```hs+>>> invert m1+fromList [('a', Sum (-10)), ('b', Sum (-20)), ('c, Sum (-40))]++>>> invert m2+fromList [('a', Sum (-40)), ('b', Sum (-20)), ('c, Sum (-10))]+```++The [`MonoidMap.minus`] operation, when applied to maps `m1` and `m2`, produces a new map where every key `k` is associated with the value of `k` in `m1` minus the value of `k` in `m2`:++```hs+>>> m1 `minus` m2+fromList [('a', Sum (-30)), ('c', Sum 30)]++>>> m2 `minus` m1+fromList [('a', Sum 30), ('c', Sum (-30))]+```++</details>++<details><summary><strong>Example: <code>MonoidMap k (Sum Natural)</code></strong></summary>+<br/>++For maps with <code><a href="https://hackage.haskell.org/package/base/docs/Data-Monoid.html#v:Sum">Sum</a> <a href="https://hackage.haskell.org/package/base/docs/Numeric-Natural.html#t:Natural">Natural</a></code> values, [`MonoidMap.union`] and [`MonoidMap.intersection`] compute the _maximum_ and _minimum_ of each pair of matching values, respectively:++```hs+>>> m1 = fromList [('a', Sum 10), ('b', Sum 20)]+>>> m2 = fromList [('a', Sum 20), ('b', Sum 10)]++>>> m1 `union` m2+fromList [('a', Sum 20), ('b', Sum 20)]++>>> m1 `intersection` m2+fromList [('a', Sum 10), ('b', Sum 10)]+```+</details>++<details><summary><strong>Example: <code>MonoidMap k (Product Natural)</code></strong></summary>+<br/>++For maps with <code><a href="https://hackage.haskell.org/package/base/docs/Data-Monoid.html#v:Product">Product</a> <a href="https://hackage.haskell.org/package/base/docs/Numeric-Natural.html#t:Natural">Natural</a></code> values, [`MonoidMap.union`] and [`MonoidMap.intersection`] compute the _lowest common multiple_ (LCM) and _greatest common divisor_ (GCD) of each pair of matching values, respectively:++```hs+>>> m1 = fromList [('a', Product  6), ('b', Product 15), ('c', Product 35)]+>>> m2 = fromList [('a', Product 15), ('b', Product 35), ('c', Product 77)]++>>> m1 `union` m2+fromList [('a', Product 30), ('b', Product 105), ('c', Product 385)]++>>> m1 `intersection` m2+fromList [('a', Product 3), ('b', Product 5), ('c', Product 7)]+```+</details>++# General basis for more specialised map types++The [`MonoidMap`] type can be used as a general basis for building other more specialised map types.++If you have a [`Map`]-based data type with an invariant that values **must not** be [`mempty`][`Monoid.mempty`], then by expressing this type in terms of [`MonoidMap`], [`MonoidMap`] will handle the invariant for you:++```patch+- newtype SomeMap k v = SomeMap (      Map k (SomeMonoidalContainer v))++ newtype SomeMap k v = SomeMap (MonoidMap k (SomeMonoidalContainer v))+```++If you're already using a specialised non-empty container type to enforce the invariant that values must not be empty, then [`MonoidMap`] makes it possible to _replace_ the use of the specialised non-empty container type with its ordinary equivalent:++Example transformations:+```patch+  -- Non-empty lists:+- newtype ListMap k v = ListMap (      Map k (NonEmpty v))++ newtype ListMap k v = ListMap (MonoidMap k          [v])++  -- Non-empty sets:+- newtype SetMap k v = SetMap (      Map k (NonEmptySet v))++ newtype SetMap k v = SetMap (MonoidMap k         (Set v))++  -- Non-empty sequences:+- newtype SeqMap k v = SeqMap (      Map k (NonEmptySeq v))++ newtype SeqMap k v = SeqMap (MonoidMap k         (Seq v))+```++Using [`MonoidMap`] can simplify the implementation of such types, as special handling code for empty values can often be greatly simplified or even eliminated.++## Real-world examples from the Haskell ecosystem++### Example: `SignedMultiSet` (a signed multiset type)++> The [`signed-multiset`] library provides the [`SignedMultiSet`] type, which is internally defined as a [`Map`] from elements to signed integer occurrence counts:+>+> ```hs+> newtype SignedMultiset a = SMS {unSMS :: Map a Int}+> ```+>+> All [`SignedMultiSet`] operations maintain an invariant that the internal [`Map`] **must not** contain any mappings to `0` (zero). This requires [`SignedMultiSet`] functions to detect and eliminate values of `0`.+>+> For example, the [`insertMany`][`SignedMultiSet.insertMany`] operation:+>+> ```hs+> insertMany :: Ord a => a -> Int -> SignedMultiset a -> SignedMultiset a+> insertMany x n = SMS . Map.alter f x . unSMS+>   where+>     f Nothing  = Just n+>     f (Just m) = let k = m + n in if k == 0 then Nothing else Just k+> ```+>+> Let's redefine [`SignedMultiSet`] in terms of [`MonoidMap`]:+>+> ```diff+> - newtype SignedMultiset a = SMS {unSMS ::       Map a      Int }+> + newtype SignedMultiset a = SMS {unSMS :: MonoidMap a (Sum Int)}+> ```+>+> Here we've used the [`Sum`] wrapper type, whose [`Monoid`] instance defines [`mempty`][`Monoid.mempty`] as `Sum 0`, and [`<>`] as ordinary addition.+>+> Now we can redefine [`insertMany`][`SignedMultiSet.insertMany`] (and similar operations) in a simpler way:+>+> ```patch+>   insertMany :: Ord a => a -> Int -> SignedMultiset a -> SignedMultiset a+> + insertMany x n = SMS . MonoidMap.adjust (+ Sum n) x . unSMS+> - insertMany x n = SMS . Map.alter f x . unSMS+> -   where+> -     f Nothing  = Just n+> -     f (Just m) = let k = m + n in if k == 0 then Nothing else Just k+> ```+>+> Since the [`MonoidMap.adjust`] operation performs automatic minimisation, values of `Sum 0` are automatically excluded from the internal data structure, and there is no need to handle them differently from non-zero values.++### Example: `SetMultiMap` (a set-based multimap type)++> The [`multi-containers`] library provides the [`SetMultiMap`] type, which is internally defined as a [`Map`] from keys to (possibly-empty) sets of values, together with a `Size` parameter that records the total number of elements in the map (counting duplicates):+>+> ```hs+> newtype SetMultimap k a = SetMultimap (Map k (Set a), Size)+> type Size = Int+> ```+>+> All [`SetMultiMap`] operations maintain an invariant that the internal [`Map`] **must not** contain any mappings to empty sets. This requires [`SetMultiMap`] functions to detect and eliminate values of [`Set.empty`] (indicated by the [`Set.null`] function).+>+> For example, the [`alterWithKey`][`SetMultiMap.alterWithKey`] operation detects if the updated set is empty, and if so, performs a deletion instead of an insertion:+>+> ```hs+> alterWithKey :: Ord k => (k -> Set a -> Set a) -> k -> SetMultimap k a -> SetMultimap k a+> alterWithKey f k mm@(SetMultimap (m, _))+>     | Set.null as = fromMap (Map.delete k    m)+>     | otherwise   = fromMap (Map.insert k as m)+>   where+>     as = f k (mm ! k)+>+> fromMap :: Map k (Set a) -> SetMultimap k a+> fromMap m = SetMultimap (m', sum (fmap Set.size m'))+>   where+>     m' = Map.filter (not . Set.null) m+> ```+>+> Let's redefine [`SetMultiMap`] in terms of [`MonoidMap`]:+>+> ```patch+> - newtype SetMultimap k a = SetMultimap (      Map k (Set a), Size)+> + newtype SetMultimap k a = SetMultimap (MonoidMap k (Set a), Size)+> ```+>+> Now we can provide a simpler definition for [`alterWithKey`][`SetMultiMap.alterWithKey`] (and other operations):+>+> ```hs+> alterWithKey :: Ord k => (k -> Set a -> Set a) -> k -> SetMultimap k a -> SetMultimap k a+> alterWithKey f k (SetMultimap (m, size)) = SetMultiMap+>     (MonoidMap.set k new m, size - Set.size old + Set.size new)+>   where+>     old = MonoidMap.get k m+>     new = f k old+> ```+>+> Since the [`MonoidMap.set`] operation performs automatic minimisation, empty sets are automatically excluded from the internal data structure, and there is no need to handle them any differently from non-empty sets.++### Example: `MultiMap` (a list-based multimap type)++> The [`multi-containers`] library provides the [`MultiMap`] type, which is internally defined as a [`Map`] from keys to non-empty lists of values, together with a `Size` parameter that records the total number of elements in the map (counting duplicates):+>+> ```hs+> newtype Multimap k a = Multimap (Map k (NonEmpty a), Size)+> type Size = Int+> ```+>+> All [`MultiMap`] operations maintain the invariant that the internal [`Map`] **must not** contain any mappings to empty lists. This invariant is handled rather nicely by the use of the [`NonEmpty`] list type, which disallows empty lists _by construction_. As a result, it's arguably more difficult to make a mistake in the implementation than it would be if [`MultiMap`] were defined in terms of ordinary lists.+>+> However, certain operations still need to differentiate between the empty and non-empty case, and it's still necessary to handle each case specially.+>+> For example, the [`alterWithKey`][`MultiMap.alterWithKey`] operation detects if the updated list is empty, and if so, performs a deletion instead of an insertion:+>+> ```hs+> alterWithKey :: Ord k => (k -> [a] -> [a]) -> k -> Multimap k a -> Multimap k a+> alterWithKey f k mm@(Multimap (m, _)) = case nonEmpty (f k (mm ! k)) of+>     Just as' -> fromMap (Map.insert k as' m)+>     Nothing  -> fromMap (Map.delete k     m)+>+> fromMap :: Map k (NonEmpty a) -> Multimap k a+> fromMap m = Multimap (m, sum (fmap length m))+> ```+>+> Let's redefine [`MultiMap`] in terms of [`MonoidMap`] and ordinary lists:+>+> ```patch+> - newtype Multimap k a = Multimap (      Map k (NonEmpty a), Size)+> + newtype Multimap k a = Multimap (MonoidMap k          [a], Size)+> ```+>+> Now we can provide a simpler definition for [`alterWithKey`][`MultiMap.alterWithKey`] (and other operations):+> ```hs+> alterWithKey :: Ord k => (k -> [a] -> [a]) -> k -> Multimap k a -> Multimap k a+> alterWithKey f k (Multimap (m, size)) = MultiMap+>     (MonoidMap.set k new m, size - List.length old + List.length new)+>   where+>     old = MonoidMap.get k m+>     new = f k old+> ```+>+> Since the [`MonoidMap.set`] operation performs automatic minimisation:+> - empty lists are automatically excluded from the internal data structure.+> - there is no need to use a specialised [`NonEmpty`] type.+> - there is no need to handle empty lists differently from non-empty lists.++### Example: `MultiAsset` (a nested map type)++> The [`cardano-ledger`] library provides the [`MultiAsset`] type, which models a **nested** mapping from [`PolicyID`][`MultiAsset.PolicyID`] keys to [`AssetName`][`MultiAsset.AssetName`] keys to [`Integer`] values:+>+> ```hs+> newtype MultiAsset c = MultiAsset (Map (PolicyID c) (Map AssetName Integer))+> ```+>+> Each [`Integer`] value represents the value of an **asset** on the Cardano blockchain, where each asset is uniquely identified by the combination of a [`PolicyID`][`MultiAsset.PolicyID`] and an [`AssetName`][`MultiAsset.AssetName`]. (Multiple assets can share the same [`PolicyID`][`MultiAsset.PolicyID`].)+>+> All [`MultiAsset`] operations maintain a **dual invariant** that:+> - there must be no mappings from [`PolicyID`][`MultiAsset.PolicyID`] keys to empty maps; and that+> - there must be no mappings from [`AssetName`][`MultiAsset.AssetName`] keys to [`Integer`] values of `0`.+>+> To satisfy this invariant, [`MultiAsset`] operations use a variety of helper functions to ensure that [`MultiAsset`] values are always in a canonical form.+>+> For example, consider the [`Semigroup`] instance for [`MultiAsset`]:+>+> ```hs+> instance Semigroup (MultiAsset c) where+>     MultiAsset m1 <> MultiAsset m2 =+>         MultiAsset (canonicalMapUnion (canonicalMapUnion (+)) m1 m2)+> ```+>+> The above definition of [`<>`] performs pointwise addition of all pairs of values for matching assets.+>+> For example, if:+> - [`MultiAsset`] `m1` maps asset `a` to a value of `10`;+> - [`MultiAsset`] `m2` maps asset `a` to a value of `20`;+>+> Then:+> - [`MultiAsset`] `m1 <> m2` will map asset `a` to a value of `30`.+>+> The definition of [`<>`] uses a function called [`canonicalMapUnion`][`CanonicalMaps.canonicalMapUnion`], which does the heavy lifting work of performing a union while ensuring that each resulting [`Map`] is in canonical form.+>+> Let's have a look at the definition of [`canonicalMapUnion`][`CanonicalMaps.canonicalMapUnion`]:+>+> ```hs+> canonicalMapUnion ::+>   (Ord k, CanonicalZero a) =>+>   (a -> a -> a) ->+>   Map k a ->+>   Map k a ->+>   Map k a+> canonicalMapUnion _f t1 Tip                 = t1+> canonicalMapUnion  f t1 (Bin _ k x Tip Tip) = canonicalInsert f k x t1+> canonicalMapUnion  f (Bin _ k x Tip Tip) t2 = canonicalInsert f k x t2+> canonicalMapUnion _f Tip t2                 = t2+> canonicalMapUnion  f (Bin _ k1 x1 l1 r1) t2 = case Map.splitLookup k1 t2 of+>   (l2, mb, r2) -> case mb of+>     Nothing ->+>       if x1 == zeroC+>         then link2 l1l2 r1r2+>         else link k1 x1 l1l2 r1r2+>     Just x2 ->+>       if new == zeroC+>         then link2 l1l2 r1r2+>         else link k1 new l1l2 r1r2+>       where+>         new = f x1 x2+>     where+>       !l1l2 = canonicalMapUnion f l1 l2+>       !r1r2 = canonicalMapUnion f r1 r2+> ```+>+> The [`canonicalMapUnion`][`CanonicalMaps.canonicalMapUnion`] function in turn relies on [`canonicalInsert`][`CanonicalMaps.canonicalInsert`], which handles individual insertions:+>+> ```hs+> canonicalInsert ::+>   (Ord k, CanonicalZero a) =>+>   (a -> a -> a) ->+>   k ->+>   a ->+>   Map k a ->+>   Map k a+> canonicalInsert f !kx x = go+>   where+>     go Tip = if x == zeroC then Tip else Map.singleton kx x+>     go (Bin sy ky y l r) =+>       case compare kx ky of+>         LT -> link ky y (go l) r+>         GT -> link ky y l (go r)+>         EQ -> if new == zeroC then link2 l r else Bin sy kx new l r+>           where+>             new = f y x+> ```+>+> Similarly, the [`insertMultiAsset`][`MultiAsset.insertMultiAsset`] function, which "inserts" the value of an individual asset into a [`MultiAsset`] value, has the following definition:+>+> ```hs+> insertMultiAsset ::+>   (Integer -> Integer -> Integer) ->+>   PolicyID c ->+>   AssetName ->+>   Integer ->+>   MultiAsset c ->+>   MultiAsset c+> insertMultiAsset combine pid aid new (MultiAsset m1) =+>   case Map.splitLookup pid m1 of+>     (l1, Just m2, l2) ->+>       case Map.splitLookup aid m2 of+>         (v1, Just old, v2) ->+>           if n == 0+>             then+>               let m3 = link2 v1 v2+>                in if Map.null m3+>                     then MultiAsset (link2 l1 l2)+>                     else MultiAsset (link pid m3 l1 l2)+>             else MultiAsset (link pid (link aid n v1 v2) l1 l2)+>           where+>             n = combine old new+>         (_, Nothing, _) ->+>           MultiAsset+>             ( link+>                 pid+>                 ( if new == 0+>                     then m2+>                     else Map.insert aid new m2+>                 )+>                 l1+>                 l2+>             )+>     (l1, Nothing, l2) ->+>       MultiAsset+>         ( if new == 0+>             then link2 l1 l2+>             else link pid (Map.singleton aid new) l1 l2+>         )+> ```+>+> A notable feature of all the above functions is that they completely eschew the use of [`Map.merge`]. Instead, they directly manipulate constructors exported from [`Map.Internal`]. This approach was probably taken for performance reasons.+>+> However, it's clear that maintaining the invariant in this way comes at a **cost**: the code is rather complex, and it were not for a comprehensive test suite, it would probably be very easy to introduce a regression.+>+> In the spirit of demonstration, let's see what happens if we redefine the [`MultiAsset`] type in terms of [`MonoidMap`]:+>+> ```patch+> - newtype MultiAsset c = MultiAsset (Map       (PolicyID c) (      Map AssetName      Integer))+> + newtype MultiAsset c = MultiAsset (MonoidMap (PolicyID c) (MonoidMap AssetName (Sum Integer))+> ```+>+> Note that we have replaced [`Integer`] with <code><a href="https://hackage.haskell.org/package/base/docs/Data-Monoid.html#v:Sum">Sum</a> <a href="https://hackage.haskell.org/package/base/docs/Prelude.html#t:Integer">Integer</a></code>, whose [`Monoid`] instance defines [`mempty`][`Monoid.mempty`] as <code><a href="https://hackage.haskell.org/package/base/docs/Data-Monoid.html#v:Sum">Sum</a> 0</code>, and whose [`Semigroup`] instance defines [`<>`] as equivalent to ordinary integer addition.+>+> Recall that all [`MonoidMap`] operations automatically take care of the invariant that values cannot be [`mempty`][`Monoid.mempty`]. For the [`MultiAsset`] type, this means that:+> - outer maps are now prevented from including any mappings from [`PolicyID`][`MultiAsset.PolicyID`] to empty inner maps.+> - inner maps are now prevented from including any mappings from [`AssetName`][`MultiAsset.AssetName`] to values of <code><a href="https://hackage.haskell.org/package/base/docs/Data-Monoid.html#v:Sum">Sum</a> 0</code>.+>+> As a result, we can remove virtually all code that deals with canonicalisation.+>+> For example, we can now simplify the [`Semigroup`] instance for [`MultiAsset`], dispensing entirely with the need to call [`canonicalMapUnion`][`CanonicalMaps.canonicalMapUnion`]:+>+> ```patch+>   instance Semigroup (MultiAsset c) where+>       MultiAsset m1 <> MultiAsset m2 =+> -         MultiAsset (canonicalMapUnion (canonicalMapUnion (+)) m1 m2)+> +         m1 <> m2+> ```+>+> Given that the above instance is trivial, we can even derive the [`Semigroup`] and [`Monoid`] instances automatically:+>+> ```patch+>   newtype MultiAsset c = MultiAsset (MonoidMap (PolicyID c) (MonoidMap AssetName (Sum Integer))+> +     deriving newtype (Semigroup, Monoid)+> ```+>+> We can also simplify the [`insertMultiAsset`][`MultiAsset.insertMultiAsset`] function:+>+> ```patch+>   insertMultiAsset ::+>     (Integer -> Integer -> Integer) ->+>     PolicyID c ->+>     AssetName ->+>     Integer ->+>     MultiAsset c ->+>     MultiAsset c+>   insertMultiAsset combine pid aid new (MultiAsset m1) =+> +   MultiAsset $+> +   MonoidMap.adjust+> +     (MonoidMap.adjust (\(M.Sum old) -> M.Sum (combine old new)) aid) pid m1+> -  ...+> -  ### 27 lines deleted ###+> -  ...+> ```+>+> Finally, since [`MonoidMap`] already provides [`Eq`] and [`Group`] instances that are defined in terms of the underlying monoidal value type, we can automatically derive [`Eq`] and [`Group`] instances for [`MultiAsset`]:+>+> ```patch+>   newtype MultiAsset c = MultiAsset (MonoidMap (PolicyID c) (MonoidMap AssetName (Sum Integer))+> -     deriving newtype (Semigroup, Monoid)+> +     deriving newtype (Eq, Semigroup, Monoid, Group)+>+> - instance Eq (MultiAsset c) where+> -   MultiAsset x == MultiAsset y = pointWise (pointWise (==)) x y+> -+> - instance Group (MultiAsset c) where+> -   invert (MultiAsset m) =+> -     MultiAsset (canonicalMap (canonicalMap ((-1 :: Integer) *)) m)+> ```+>+> Many other simplifications are also possible. (Left as an exercise for readers!)++# Comparison with other generalised map types++The Haskell ecosystem has several different types for maps with monoidal properties, and several different types that model total functions from keys to values. Each type comes with its own set of advantages and limitations.++Here's a comparison between the [`MonoidMap`] type provided by this library and types provided by other libraries:++<table>+<thead>+  <tr valign="top" align="left">+    <th rowspan="2">Type<br><br><br></th>+    <th colspan="2">Features</th>+    <th colspan="5">Class Instances</th>+  </tr>+  <tr valign="top" align="left">+    <th>+      Models<br/>total<br/>functions+    </th>+    <th>+      Performs<br/>automatic<br/>minimisation+    </th>+    <th>+      <a href="https://hackage.haskell.org/package/base/docs/Data-Eq.html#t:Eq">+        <code>Eq</code>+      </a>+    </th>+    <th>+      <a href="https://hackage.haskell.org/package/monoid-subclasses">+        <code>Monoid</code><br/><em>subclasses</em>+      </a>+    </th>+    <th>+      <a href="https://hackage.haskell.org/package/groups/docs/Data-Group.html#t:Group">+        <code>Group</code>+      </a>+    </th>+    <th>+      <a href="https://hackage.haskell.org/package/base/docs/Data-Functor.html#t:Functor">+        <code>Functor</code>+      </a>+    </th>+    <th>+      <a href="https://hackage.haskell.org/package/base/docs/Control-Applicative.html#t:Applicative">+        <code>Applicative</code>+      </a>+    </th>+  </tr>+</thead>+<tbody>+  <tr>+    <td>+      <a href="https://github.com/jonathanknowles/monoidmap">+        <code><em>monoidmap</em></code>+      </a>+      <br/>+      <a href="https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#t:MonoidMap">+        <code>MonoidMap</code>+      </a>+      <br/>+      (this library)+    </td>+    <td>:heavy_check_mark:</td>+    <td>:heavy_check_mark:</td>+    <td>:heavy_check_mark:</td>+    <td>:heavy_check_mark:</td>+    <td>:heavy_check_mark:</td>+    <td>:x:</td>+    <td>:x:</td>+  </tr>+  <tr>+    <td>+      <a href="https://hackage.haskell.org/package/monoid-map">+        <code><em>monoid‑map</em></code>+      </a>+      <br/>+      <a href="https://hackage.haskell.org/package/monoid-map/docs/Data-MonoidMap.html">+        <code>MonoidMap</code>+      </a>+    </td>+    <td>:x:</td>+    <td>:heavy_check_mark:</td>+    <td>:heavy_check_mark:</td>+    <td>:x:</td>+    <td>:heavy_check_mark:</td>+    <td>:heavy_check_mark:</td>+    <td>:x:</td>+  </tr>+  <tr>+    <td>+      <a href="https://hackage.haskell.org/package/monoidal-containers">+        <code><em>monoidal‑containers</em></code>+      </a>+      <br/>+      <a href="https://hackage.haskell.org/package/monoidal-containers/docs/Data-Map-Monoidal.html#t:MonoidalMap">+        <code>MonoidalMap</code>+      </a>+    </td>+    <td>:x:</td>+    <td>:x:</td>+    <td>:heavy_check_mark:</td>+    <td>:x:</td>+    <td>:x:</td>+    <td>:heavy_check_mark:</td>+    <td>:x:</td>+  </tr>+  <tr>+    <td>+      <a href="https://hackage.haskell.org/package/total-map">+        <code><em>total‑map</em></code>+      </a>+      <br/>+      <a href="https://hackage.haskell.org/package/total-map/docs/Data-TotalMap.html#t:TMap">+        <code>TMap</code>+      </a>+    </td>+    <td>:heavy_check_mark:</td>+    <td>:x:</td>+    <td>:x:</td>+    <td>:x:</td>+    <td>:x:</td>+    <td>:heavy_check_mark:</td>+    <td>:heavy_check_mark:</td>+  </tr>+  <tr>+    <td>+      <a href="https://hackage.haskell.org/package/total-maps">+        <code><em>total‑maps</em></code>+      </a>+      <br/>+      <a href="https://hackage.haskell.org/package/total-maps/docs/Data-Total-Map-Sparse.html#t:TotalSparseMap">+        <code>TotalSparseMap</code>+      </a>+    </td>+    <td>:heavy_check_mark:</td>+    <td>:x:</td>+    <td>:heavy_check_mark:</td>+    <td>:x:</td>+    <td>:x:</td>+    <td>:heavy_check_mark:</td>+    <td>:heavy_check_mark:</td>+  </tr>+  <tr>+    <td>+      <a href="https://hackage.haskell.org/package/defaultable-map">+        <code><em>defaultable‑map</em></code>+      </a>+      <br/>+      <a href="https://hackage.haskell.org/package/defaultable-map/docs/Defaultable-Map.html#t:Defaultable">+        <code>DefaultableMap</code>+      </a>+    </td>+    <td>:x:</td>+    <td>:x:</td>+    <td>:heavy_check_mark:</td>+    <td>:x:</td>+    <td>:x:</td>+    <td>:heavy_check_mark:</td>+    <td>:heavy_check_mark:</td>+  </tr>+  <tr>+    <td>+      <a href="https://hackage.haskell.org/package/chatter">+        <code><em>chatter</em></code>+      </a>+      <br/>+      <a href="https://hackage.haskell.org/package/chatter/docs/Data-DefaultMap.html#t:DefaultMap">+        <code>DefaultMap</code>+      </a>+    </td>+    <td>:heavy_check_mark:</td>+    <td>:x:</td>+    <td>:heavy_check_mark:</td>+    <td>:x:</td>+    <td>:x:</td>+    <td>:heavy_check_mark:</td>+    <td>:x:</td>+  </tr>+  <tr>+    <td>+      <a href="https://hackage.haskell.org/package/stack">+        <code><em>stack</em></code>+      </a>+      <br/>+      <a href="https://hackage.haskell.org/package/stack/docs/Data-Monoid-Map.html#t:MonoidMap">+        <code>MonoidMap</code>+      </a>+    </td>+    <td>:x:</td>+    <td>:x:</td>+    <td>:heavy_check_mark:</td>+    <td>:x:</td>+    <td>:heavy_check_mark:</td>+    <td>:heavy_check_mark:</td>+    <td>:x:</td>+  </tr>+</tbody>+</table>++[`cardano-ledger`]: https://github.com/input-output-hk/cardano-ledger+[`containers`]: https://hackage.haskell.org/package/containers+[`groups`]: https://hackage.haskell.org/package/groups+[`monoid-subclasses`]: https://hackage.haskell.org/package/monoid-subclasses+[`multi-containers`]: https://hackage.haskell.org/package/multi-containers+[`signed-multiset`]: https://hackage.haskell.org/package/signed-multiset++[`<>`]: https://hackage.haskell.org/package/base/docs/Data-Semigroup.html#v:-60--62-+[`CanonicalMaps.canonicalInsert`]: https://github.com/input-output-hk/cardano-ledger/blob/b00e28698d9c7fbbeda1c9cfdd1238d3bc4569cf/libs/cardano-data/src/Data/CanonicalMaps.hs#L69+[`CanonicalMaps.canonicalMapUnion`]: https://github.com/input-output-hk/cardano-ledger/blob/b00e28698d9c7fbbeda1c9cfdd1238d3bc4569cf/libs/cardano-data/src/Data/CanonicalMaps.hs#L42+[`Eq`]: https://hackage.haskell.org/package/base/docs/Data-Eq.html#t:Eq+[`Functor`]: https://hackage.haskell.org/package/base/docs/Data-Functor.html#t:Functor+[`Group`]: https://hackage.haskell.org/package/groups/docs/Data-Group.html#t:Group+[`Integer`]: https://hackage.haskell.org/package/base/docs/Prelude.html#t:Integer+[`Map.Internal`]: https://hackage.haskell.org/package/containers/docs/Data-Map-Internal.html+[`Map.merge`]: https://hackage.haskell.org/package/containers/docs/Data-Map-Merge-Strict.html#v:merge+[`Map`]: https://hackage.haskell.org/package/containers/docs/Data-Map-Strict.html#t:Map+[`Maybe`]: https://hackage.haskell.org/package/base/docs/Data-Maybe.html#t:Maybe+[`Monoid.mempty`]: https://hackage.haskell.org/package/base/docs/Data-Monoid.html#v:mempty+[`MonoidMap.adjust`]: https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:adjust+[`MonoidMap.empty`]: https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:empty+[`MonoidMap.intersection`]: https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:intersection+[`MonoidMap.invert`]: https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:invert+[`MonoidMap.map`]: https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:map+[`MonoidMap.minus`]: https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:minus+[`MonoidMap.set`]: https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:set+[`MonoidMap.union`]: https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#v:union+[`MonoidMap`]: https://jonathanknowles.github.io/monoidmap/Data-MonoidMap.html#t:MonoidMap+[`MonoidNull.null`]: https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-Null.html#v:null+[`MonoidNull`]: https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-Null.html#t:MonoidNull+[`Monoid`]: https://hackage.haskell.org/package/base/docs/Data-Monoid.html#t:Monoid+[`MultiAsset.AssetName`]: https://github.com/input-output-hk/cardano-ledger/blob/b00e28698d9c7fbbeda1c9cfdd1238d3bc4569cf/eras/mary/impl/src/Cardano/Ledger/Mary/Value.hs#L110+[`MultiAsset.PolicyID`]: https://github.com/input-output-hk/cardano-ledger/blob/b00e28698d9c7fbbeda1c9cfdd1238d3bc4569cf/eras/mary/impl/src/Cardano/Ledger/Mary/Value.hs#L140+[`MultiAsset.insertMultiAsset`]: https://github.com/input-output-hk/cardano-ledger/blob/b00e28698d9c7fbbeda1c9cfdd1238d3bc4569cf/eras/mary/impl/src/Cardano/Ledger/Mary/Value.hs#LL831C1-L868C10+[`MultiAsset`]: https://github.com/input-output-hk/cardano-ledger/blob/b00e28698d9c7fbbeda1c9cfdd1238d3bc4569cf/eras/mary/impl/src/Cardano/Ledger/Mary/Value.hs#L157+[`MultiMap.alterWithKey`]: https://hackage.haskell.org/package/multi-containers/docs/Data-Multimap.html#v:alterWithKey+[`MultiMap`]: https://hackage.haskell.org/package/multi-containers/docs/Data-Multimap.html#t:Multimap+[`NestedMonoidMap`]: https://github.com/jonathanknowles/monoidmap/blob/main/src/examples/Examples/NestedMonoidMap.hs+[`NonEmpty`]: https://hackage.haskell.org/package/base/docs/Data-List-NonEmpty.html#t:NonEmpty+[`Nothing`]: https://hackage.haskell.org/package/base/docs/Data-Maybe.html#v:Nothing+[`Semigroup`]: https://hackage.haskell.org/package/base/docs/Data-Semigroup.html#t:Semigroup+[`Set.empty`]: https://hackage.haskell.org/package/containers/docs/Data-Set.html#v:empty+[`Set.intersection`]: https://hackage.haskell.org/package/containers/docs/Data-Set.html#v:intersection+[`Set.null`]: https://hackage.haskell.org/package/containers/docs/Data-Set.html#v:null+[`Set.union`]: https://hackage.haskell.org/package/containers/docs/Data-Set.html#v:union+[`SetMultiMap.alterWithKey`]: https://hackage.haskell.org/package/multi-containers/docs/Data-Multimap-Set.html#v:alterWithKey+[`SetMultiMap`]: https://hackage.haskell.org/package/multi-containers/docs/Data-Multimap-Set.html#t:SetMultimap+[`Set`]: https://hackage.haskell.org/package/containers/docs/Data-Set.html#t:Set+[`SignedMultiSet.insertMany`]: https://hackage.haskell.org/package/signed-multiset/docs/Data-SignedMultiset.html#v:insertMany+[`SignedMultiSet`]: https://hackage.haskell.org/package/signed-multiset/docs/Data-SignedMultiset.html#t:SignedMultiset+[`String`]: https://hackage.haskell.org/package/base/docs/Data-String.html#t:String+[`Sum`]: https://hackage.haskell.org/package/base/docs/Data-Monoid.html#v:Sum+[`TMap.trim`]: https://hackage.haskell.org/package/total-map/docs/Data-TotalMap.html#v:trim+[`TMap`]: https://hackage.haskell.org/package/total-map/docs/Data-TotalMap.html#t:TMap
+ monoidmap.cabal view
@@ -0,0 +1,206 @@+cabal-version:  3.0+name:           monoidmap+version:        0.0.0.0+bug-reports:    https://github.com/jonathanknowles/monoidmap/issues+license:        Apache-2.0+license-file:   LICENSE+author:         Jonathan Knowles+maintainer:     mail@jonathanknowles.net+copyright:      2022–2023 Jonathan Knowles+category:       Data Structures+synopsis:       Monoidal map type+description:+    Monoidal map type with support for semigroup and monoid subclasses.++extra-doc-files:+    CHANGELOG.md+    README.md++common dependency-base+    build-depends:base                          >= 4.14.3.0   && < 4.19+common dependency-containers+    build-depends:containers                    >= 0.6.5.1    && < 0.7+common dependency-deepseq+    build-depends:deepseq                       >= 1.4.4.0    && < 1.5+common dependency-groups+    build-depends:groups                        >= 0.5.3      && < 0.6+common dependency-hspec+    build-depends:hspec                         >= 2.10.9     && < 2.11+common dependency-monoid-subclasses+    build-depends:monoid-subclasses             >= 1.2.3      && < 1.3+common dependency-nonempty-containers+    build-depends:nonempty-containers           >= 0.3.4.4    && < 0.4+common dependency-nothunks+    build-depends:nothunks                      >= 0.1.3      && < 0.2+common dependency-pretty-show+    build-depends:pretty-show                   >= 1.10       && < 1.11+common dependency-QuickCheck+    build-depends:QuickCheck                    >= 2.14.2     && < 2.15+common dependency-quickcheck-classes+    build-depends:quickcheck-classes            >= 0.6.5.0    && < 0.7+common dependency-quickcheck-groups+    build-depends:quickcheck-groups             >= 0.0.0.0    && < 0.1+common dependency-quickcheck-instances+    build-depends:quickcheck-instances          >= 0.3.28     && < 0.4+common dependency-quickcheck-monoid-subclasses+    build-depends:quickcheck-monoid-subclasses  >= 0.3.0.0    && < 0.4+common dependency-tasty-bench+    build-depends:tasty-bench                   >= 0.3.2      && < 0.4+common dependency-tasty-hunit+    build-depends:tasty-hunit                   >= 0.10.0.3   && < 0.11+common dependency-text+    build-depends:text                          >= 1.2.4.1    && < 2.1++common extensions+    default-extensions:+        BangPatterns+        ConstraintKinds+        DerivingStrategies+        DerivingVia+        FlexibleContexts+        FlexibleInstances+        GeneralizedNewtypeDeriving+        LambdaCase+        MultiParamTypeClasses+        NoImplicitPrelude+        ScopedTypeVariables+        TupleSections+        TypeApplications+        TypeFamilies+        TypeOperators+        ViewPatterns++source-repository head+    type: git+    location: https://github.com/jonathanknowles/monoidmap++library+    import:+      , dependency-base+      , dependency-containers+      , dependency-groups+      , dependency-monoid-subclasses+      , extensions+    hs-source-dirs:+        src/public+    exposed-modules:+        Data.MonoidMap+    default-language:+        Haskell2010+    build-depends:+      , internal++library examples+    import:+      , dependency-base+      , dependency-containers+      , dependency-deepseq+      , dependency-monoid-subclasses+      , dependency-nonempty-containers+      , extensions+    hs-source-dirs:+        src/examples+    exposed-modules:+        Examples.MultiMap.Class+        Examples.MultiMap.Instances.MultiMap1+        Examples.MultiMap.Instances.MultiMap2+        Examples.MultiMap.Instances.MultiMap3+        Examples.MultiMap.Instances.MultiMap4+        Examples.MultiSet+        Examples.NestedMonoidMap+        Examples.RecoveredMap+    default-language:+        Haskell2010+    build-depends:+      , monoidmap++library internal+    import:+      , dependency-base+      , dependency-containers+      , dependency-deepseq+      , dependency-groups+      , dependency-monoid-subclasses+      , dependency-nothunks+      , extensions+    hs-source-dirs:+        src/internal+    exposed-modules:+        Data.MonoidMap.Internal+        Data.MonoidMap.Unsafe+    default-language:+        Haskell2010++test-suite test+    import:+      , dependency-base+      , dependency-containers+      , dependency-groups+      , dependency-hspec+      , dependency-monoid-subclasses+      , dependency-pretty-show+      , dependency-QuickCheck+      , dependency-quickcheck-classes+      , dependency-quickcheck-groups+      , dependency-quickcheck-instances+      , dependency-quickcheck-monoid-subclasses+      , dependency-text+      , extensions+    ghc-options:+        -threaded -with-rtsopts=-N+    main-is:+        Spec.hs+    hs-source-dirs:+        src/test+    other-modules:+        SpecHook+        Data.MonoidMap.ClassSpec+        Data.MonoidMap.ExampleSpec+        Data.MonoidMap.AccessSpec+        Data.MonoidMap.ComparisonSpec+        Data.MonoidMap.ConversionSpec+        Data.MonoidMap.DistributivitySpec+        Data.MonoidMap.MapSpec+        Data.MonoidMap.FilterSpec+        Data.MonoidMap.PartitionSpec+        Data.MonoidMap.MembershipSpec+        Data.MonoidMap.SingletonSpec+        Data.MonoidMap.SliceSpec+        Data.MonoidMap.PrefixSpec+        Data.MonoidMap.SuffixSpec+        Data.MonoidMap.IntersectionSpec+        Data.MonoidMap.UnionSpec+        Data.MonoidMap.ValiditySpec+        Examples.MultiMapSpec+        Examples.RecoveredMapSpec+        Test.Common+        Test.QuickCheck.Classes.Hspec+        Test.Hspec.Unit+    type:+        exitcode-stdio-1.0+    default-language:+        Haskell2010+    build-tool-depends:+        hspec-discover:hspec-discover ==2.*+    build-depends:+      , examples+      , monoidmap++benchmark benchmark+    import:+      , dependency-base+      , dependency-containers+      , dependency-deepseq+      , dependency-tasty-bench+      , dependency-tasty-hunit+    default-language:+        Haskell2010+    type:+        exitcode-stdio-1.0+    hs-source-dirs:+        src/benchmark+    main-is:+        Main.hs+    build-depends:+      , examples+      , monoidmap
+ src/benchmark/Main.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Main where++import Prelude hiding+    ( lookup )++import Control.DeepSeq+    ( rnf )+import Control.Exception+    ( evaluate )+import Data.List+    ( foldl' )+import Data.Maybe+    ( fromMaybe )+import Test.Tasty.Bench+    ( bench, bgroup, defaultMain, nf )++import qualified Data.Map.Strict as OMap+import qualified Examples.RecoveredMap as RMap++main :: IO ()+main = do++    let om_even = fromList elems_even :: OMap.Map Int Int+        om_odd  = fromList elems_odd  :: OMap.Map Int Int++        rm_even = fromList elems_even :: RMap.Map Int Int+        rm_odd  = fromList elems_odd  :: RMap.Map Int Int++    evaluate $ rnf [om_even, om_odd]+    evaluate $ rnf [rm_even, rm_odd]++    defaultMain+        [ bgroup "delete"+            [ bgroup "absent"+                [ bench "Data.Map.Strict" $+                    nf (deleteMany evens) om_odd+                , bench "Data.MonoidMap" $+                    nf (deleteMany evens) rm_odd+                ]+            , bgroup "present"+                [ bench "Data.Map.Strict" $+                    nf (deleteMany evens) om_even+                , bench "Data.MonoidMap" $+                    nf (deleteMany evens) rm_even+                ]+            ]+        , bgroup "insert"+            [ bgroup "absent"+                [ bench "Data.Map.Strict" $+                    nf (insertMany elems_even) om_odd+                , bench "Data.MonoidMap" $+                    nf (insertMany elems_even) rm_odd+                ]+            , bgroup "present"+                [ bench "Data.Map.Strict" $+                    nf (insertMany elems_even) om_even+                , bench "Data.MonoidMap" $+                    nf (insertMany elems_even) rm_even+                ]+            ]+        , bgroup "lookup"+            [ bgroup "absent"+                [ bench "Data.Map.Strict" $+                    nf (lookupMany evens) om_odd+                , bench "Data.MonoidMap" $+                    nf (lookupMany evens) rm_odd+                ]+            , bgroup "present"+                [ bench "Data.Map.Strict" $+                    nf (lookupMany evens) om_even+                , bench "Data.MonoidMap" $+                    nf (lookupMany evens) rm_even+                ]+            ]+        , bgroup "mappend"+            [ bgroup "disjoint"+                [ bench "Data.Map.Strict" $+                    nf (<> om_even) om_odd+                , bench "Data.MonoidMap" $+                    nf (<> rm_even) rm_odd+                ]+            , bgroup "identical"+                [ bench "Data.Map.Strict" $+                    nf (<> om_even) om_even+                , bench "Data.MonoidMap" $+                    nf (<> rm_even) rm_even+                ]+            ]+        ]+  where+    bound :: Int+    bound = 2 ^ (16 :: Int)++    elems_even :: [(Int, Int)]+    elems_even = zip evens evens++    elems_odd :: [(Int, Int)]+    elems_odd = zip odds odds++    evens :: [Int]+    evens = [2, 4 .. bound]++    odds :: [Int]+    odds = [1, 3 .. bound]++class Ord k => Map m k v where+    fromList :: [(k, v)] -> m k v+    delete :: k -> m k v -> m k v+    insert :: k -> v -> m k v -> m k v+    lookup :: k -> m k v -> Maybe v++instance Ord k => Map OMap.Map k v where+    fromList = OMap.fromList+    delete = OMap.delete+    insert = OMap.insert+    lookup = OMap.lookup++instance (Ord k, Eq v) => Map RMap.Map k v where+    fromList = RMap.fromList+    delete = RMap.delete+    insert = RMap.insert+    lookup = RMap.lookup++deleteMany :: (Map m k v, Num v) => [k] -> m k v -> m k v+deleteMany xs m = foldl' (flip delete) m xs++insertMany :: (Map m k v, Num v) => [(k, v)] -> m k v -> m k v+insertMany xs m = foldl' (\m' (k, v) -> insert k v m') m xs++lookupMany :: (Map m k v, Num v) => [k] -> m k v -> v+lookupMany xs m = foldl' (\n k -> fromMaybe n (lookup k m)) 0 xs
+ src/examples/Examples/MultiMap/Class.hs view
@@ -0,0 +1,168 @@+-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+-- Provides the 'MultiMap' class, which models a total relation from unique+-- keys to sets of values.+--+module Examples.MultiMap.Class where++import Data.Set+    ( Set )+import Prelude hiding+    ( lookup )++-- | Models a total relation from unique keys to sets of values.+--+class (Eq (m k v), Ord k, Ord v) => MultiMap m k v where++    -- | Constructs a multimap from a list of key to value set mappings.+    --+    -- Removing empty sets from the input list does not affect the result:+    --+    -- > fromList ≡ fromList . filter ((/= Set.empty) . snd)+    --+    fromList :: [(k, Set v)] -> m k v++    -- | Converts a multimap to a list of key to value-set mappings.+    --+    -- Removing empty sets from the output list does not affect the result:+    --+    -- > toList ≡ filter ((/= Set.empty) . snd) . toList+    --+    -- The resulting list can be used to reconstruct the original multimap:+    --+    -- > fromList . toList ≡ id+    --+    toList :: m k v -> [(k, Set v)]++    -- | Constructs an empty multimap.+    --+    -- > empty ≡ fromList []+    --+    empty :: m k v++    -- | Returns the set of values associated with a given key.+    --+    -- > lookup k (fromList kvs) ≡ foldMap snd (filter ((== k) . fst) kvs)+    --+    lookup :: k -> m k v -> Set v++    -- | Indicates whether or not a multimap is empty.+    --+    -- > null m ≡ (∀ k. lookup k m == Set.empty)+    --+    null :: m k v -> Bool++    -- | Indicates whether or not a multimap is non-empty.+    --+    -- > nonNull m ≡ (∃ k. lookup k m /= Set.empty)+    --+    nonNull :: m k v -> Bool++    -- | Returns 'True' iff. the given key is associated with a non-empty set.+    --+    -- > nonNullKey k m ≡ (lookup k m /= Set.empty)+    --+    nonNullKey :: k -> m k v -> Bool++    -- | Returns the set of keys that are associated with non-empty sets.+    --+    -- > all (`nonNullKey` m) (nonNullKeys m)+    --+    nonNullKeys :: m k v -> Set k++    -- | Indicates how many keys are associated with non-empty sets.+    --+    -- > nonNullCount m ≡ Set.size (nonNullKeys m)+    --+    nonNullCount :: m k v -> Int++    -- | Indicates whether or not the first map is a sub-map of the second.+    --+    -- > m1 `isSubmapOf` m2 ≡ ∀ k. (lookup k m1 `Set.isSubsetOf` lookup k m2)+    --+    isSubmapOf :: m k v -> m k v -> Bool++    -- | Updates the set of values associated with a given key.+    --+    -- > lookup k1 (update k2 vs m) ≡+    -- >     if k1 == k2+    -- >     then vs+    -- >     else lookup k1 m+    --+    update :: k -> Set v -> m k v -> m k v++    -- | Inserts values into the set of values associated with a given key.+    --+    -- > lookup k1 (insert k2 vs m) ≡+    -- >     if k1 == k2+    -- >     then lookup k1 m `Set.union` vs+    -- >     else lookup k1 m+    --+    insert :: k -> Set v -> m k v -> m k v++    -- | Removes values from the set of values associated with a given key.+    --+    -- > lookup k1 (remove k2 vs m) ≡+    -- >     if k1 == k2+    -- >     then lookup k1 m `Set.difference` vs+    -- >     else lookup k1 m+    --+    remove :: k -> Set v -> m k v -> m k v++    -- | Computes the union of two multimaps.+    --+    -- Instances must satisfy the following properties:+    --+    -- /Idempotence/+    -- > union m m ≡ m+    --+    -- /Identity/+    -- > union empty m ≡ m+    -- > union m empty ≡ m+    --+    -- /Commutativity/+    -- > union m1 m2 ≡ union m2 m1+    --+    -- /Associativity/+    -- > union        m1 (union m2  m3) ≡+    -- > union (union m1        m2) m3+    --+    -- /Containment/+    -- > m1 `isSubmapOf` union m1 m2+    -- > m2 `isSubmapOf` union m1 m2+    --+    -- /Distributivity/+    -- > lookup k (union m1 m2) ≡ Set.union (lookup k m1)+    -- >                                    (lookup k m2)+    --+    union :: m k v -> m k v -> m k v++    -- | Computes the intersection of two multimaps.+    --+    -- Instances must satisfy the following properties:+    --+    -- /Idempotence/+    -- > intersection m m ≡ m+    --+    -- /Identity/+    -- > intersection empty m ≡ empty+    -- > intersection m empty ≡ empty+    --+    -- /Commutativity/+    -- > intersection m1 m2 ≡ intersection m2 m1+    --+    -- /Associativity/+    -- > intersection               m1 (intersection m2  m3) ≡+    -- > intersection (intersection m1               m2) m3+    --+    -- /Containment/+    -- intersection m1 m2 `isSubmapOf` m1+    -- intersection m1 m2 `isSubmapOf` m2+    --+    -- /Distributivity/+    -- > lookup k (intersection m1 m2) ≡ Set.intersection (lookup k m1)+    -- >                                                  (lookup k m2)+    --+    intersection :: m k v -> m k v -> m k v
+ src/examples/Examples/MultiMap/Instances/MultiMap1.hs view
@@ -0,0 +1,61 @@+-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+-- An unlawful implementation of 'MultiMap', implemented in terms of 'Map' and+-- 'Set'.+--+-- This implementation has several subtle bugs.+--+module Examples.MultiMap.Instances.MultiMap1 where++import Prelude++import Data.Map.Strict+    ( Map )+import Data.Set+    ( Set )++import qualified Data.Map.Strict as Map+import qualified Data.Set as Set+import qualified Examples.MultiMap.Class as Class++newtype MultiMap k v = MultiMap (Map k (Set v))+    deriving stock (Eq, Show)++instance (Ord k, Ord v) => Class.MultiMap MultiMap k v where++    fromList = MultiMap . Map.fromList++    toList (MultiMap m) = Map.toList m++    empty = MultiMap Map.empty++    lookup k (MultiMap m) = Map.findWithDefault Set.empty k m++    null (MultiMap m) = Map.null m++    nonNull (MultiMap m) = not (Map.null m)++    nonNullKey k (MultiMap m) = Map.member k m++    nonNullKeys (MultiMap m) = Map.keysSet m++    nonNullCount (MultiMap m) = Map.size m++    isSubmapOf (MultiMap m1) (MultiMap m2) =+        Map.isSubmapOfBy Set.isSubsetOf m1 m2++    update k vs (MultiMap m) = MultiMap (Map.insert k vs m)++    insert k vs (MultiMap m) = MultiMap $+        Map.insert k (Map.findWithDefault Set.empty k m `Set.union` vs) m++    remove k vs (MultiMap m) = MultiMap $+        Map.insert k (Map.findWithDefault Set.empty k m `Set.difference` vs) m++    union (MultiMap m1) (MultiMap m2) = MultiMap $+        Map.unionWith Set.union m1 m2++    intersection (MultiMap m1) (MultiMap m2) = MultiMap $+        Map.intersectionWith Set.intersection m1 m2
+ src/examples/Examples/MultiMap/Instances/MultiMap2.hs view
@@ -0,0 +1,80 @@+-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+-- A lawful implementation of 'MultiMap', implemented in terms of 'Map' and+-- 'Set'.+--+module Examples.MultiMap.Instances.MultiMap2 where++import Prelude++import Data.Map.Strict+    ( Map )+import Data.Set+    ( Set )++import qualified Data.Map.Merge.Strict as Map+import qualified Data.Map.Strict as Map+import qualified Data.Set as Set+import qualified Examples.MultiMap.Class as Class++newtype MultiMap k v = MultiMap (Map k (Set v))+    deriving stock (Eq, Show)++instance (Ord k, Ord v) => Class.MultiMap MultiMap k v where++    fromList = MultiMap . Map.fromListWith (<>) . filter ((/= mempty) . snd)++    toList (MultiMap m) = Map.toList m++    empty = MultiMap Map.empty++    lookup k (MultiMap m) = Map.findWithDefault Set.empty k m++    null (MultiMap m) = Map.null m++    nonNull (MultiMap m) = not (Map.null m)++    nonNullKey k (MultiMap m) = Map.member k m++    nonNullKeys (MultiMap m) = Map.keysSet m++    nonNullCount (MultiMap m) = Map.size m++    isSubmapOf (MultiMap m1) (MultiMap m2) =+        Map.isSubmapOfBy Set.isSubsetOf m1 m2++    update k vs (MultiMap m)+        | Set.null vs = MultiMap (Map.delete k    m)+        | otherwise   = MultiMap (Map.insert k vs m)++    insert k vs (MultiMap m)+        | Set.null xs = MultiMap (Map.delete k    m)+        | otherwise   = MultiMap (Map.insert k xs m)+      where+        xs = Map.findWithDefault Set.empty k m `Set.union` vs++    remove k vs (MultiMap m)+        | Set.null xs = MultiMap (Map.delete k    m)+        | otherwise   = MultiMap (Map.insert k xs m)+      where+        xs = Map.findWithDefault Set.empty k m `Set.difference` vs++    union (MultiMap m1) (MultiMap m2) = MultiMap $+        Map.unionWith Set.union m1 m2++    intersection (MultiMap m1) (MultiMap m2) = MultiMap $+        Map.merge+            Map.dropMissing+            Map.dropMissing+            (Map.zipWithMaybeMatched mergeValues)+            m1+            m2+      where+        mergeValues :: k -> Set v -> Set v -> Maybe (Set v)+        mergeValues _k s1 s2+            | Set.null s3 = Nothing+            | otherwise   = Just s3+          where+            s3 = Set.intersection s1 s2
+ src/examples/Examples/MultiMap/Instances/MultiMap3.hs view
@@ -0,0 +1,85 @@+-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+-- A lawful implementation of 'MultiMap', implemented in terms of 'Map' and+-- 'NESet'.+--+module Examples.MultiMap.Instances.MultiMap3 where++import Prelude++import Data.Map.Strict+    ( Map )+import Data.Maybe+    ( mapMaybe )+import Data.Set.NonEmpty+    ( NESet )++import qualified Data.Map.Merge.Strict as Map+import qualified Data.Map.Strict as Map+import qualified Data.Set as Set+import qualified Data.Set.NonEmpty as NESet+import qualified Examples.MultiMap.Class as Class++newtype MultiMap k v = MultiMap (Map k (NESet v))+    deriving stock (Eq, Show)++instance (Ord k, Ord v) => Class.MultiMap MultiMap k v where++    fromList+        = MultiMap+        . Map.fromListWith (<>)+        . mapMaybe (traverse NESet.nonEmptySet)++    toList (MultiMap m) = fmap NESet.toSet <$> Map.toList m++    empty = MultiMap Map.empty++    lookup k (MultiMap m) = maybe Set.empty NESet.toSet (Map.lookup k m)++    null (MultiMap m) = Map.null m++    nonNull (MultiMap m) = not (Map.null m)++    nonNullKey k (MultiMap m) = Map.member k m++    nonNullKeys (MultiMap m) = Map.keysSet m++    nonNullCount (MultiMap m) = Map.size m++    isSubmapOf (MultiMap m1) (MultiMap m2) =+        Map.isSubmapOfBy NESet.isSubsetOf m1 m2++    update k vs (MultiMap m) =+        case NESet.nonEmptySet vs of+            Nothing -> MultiMap (Map.delete k    m)+            Just ys -> MultiMap (Map.insert k ys m)++    insert k vs (MultiMap m) =+        case NESet.nonEmptySet xs of+            Nothing -> MultiMap (Map.delete k    m)+            Just ys -> MultiMap (Map.insert k ys m)+      where+        xs = maybe Set.empty NESet.toSet (Map.lookup k m) `Set.union` vs++    remove k vs (MultiMap m) =+        case NESet.nonEmptySet xs of+            Nothing -> MultiMap (Map.delete k    m)+            Just ys -> MultiMap (Map.insert k ys m)+      where+        xs = maybe Set.empty NESet.toSet (Map.lookup k m) `Set.difference` vs++    union (MultiMap m1) (MultiMap m2) = MultiMap $+        Map.unionWith NESet.union m1 m2++    intersection (MultiMap m1) (MultiMap m2) = MultiMap $+        Map.merge+            Map.dropMissing+            Map.dropMissing+            (Map.zipWithMaybeMatched mergeValues)+            m1+            m2+      where+        mergeValues :: Ord v => k -> NESet v -> NESet v -> Maybe (NESet v)+        mergeValues _k s1 s2 = NESet.nonEmptySet (NESet.intersection s1 s2)
+ src/examples/Examples/MultiMap/Instances/MultiMap4.hs view
@@ -0,0 +1,59 @@+-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+-- A lawful implementation of 'MultiMap', implemented in terms of 'MonoidMap'+-- and 'Set'.+--+module Examples.MultiMap.Instances.MultiMap4 where++import Prelude++import Data.MonoidMap+    ( MonoidMap )+import Data.Set+    ( Set )++import qualified Data.MonoidMap as MonoidMap+import qualified Data.Set as Set+import qualified Examples.MultiMap.Class as Class++newtype MultiMap k v = MultiMap (MonoidMap k (Set v))+    deriving stock (Eq, Show)++instance (Ord k, Ord v) => Class.MultiMap MultiMap k v where++    fromList = MultiMap . MonoidMap.fromListWith (<>)++    toList (MultiMap m) = MonoidMap.toList m++    empty = MultiMap MonoidMap.empty++    lookup k (MultiMap m) = MonoidMap.get k m++    null (MultiMap m) = MonoidMap.null m++    nonNull (MultiMap m) = MonoidMap.nonNull m++    nonNullKey k (MultiMap m) = MonoidMap.nonNullKey k m++    nonNullKeys (MultiMap m) = MonoidMap.nonNullKeys m++    nonNullCount (MultiMap m) = MonoidMap.nonNullCount m++    isSubmapOf (MultiMap m1) (MultiMap m2) = m1 `MonoidMap.isSubmapOf` m2++    update k vs (MultiMap m) =+        MultiMap (MonoidMap.set k vs m)++    insert k vs (MultiMap m) =+        MultiMap (MonoidMap.adjust (`Set.union` vs) k m)++    remove k vs (MultiMap m) =+        MultiMap (MonoidMap.adjust (`Set.difference` vs) k m)++    union (MultiMap m1) (MultiMap m2) =+        MultiMap (MonoidMap.union m1 m2)++    intersection (MultiMap m1) (MultiMap m2) =+        MultiMap (MonoidMap.intersection m1 m2)
+ src/examples/Examples/MultiSet.hs view
@@ -0,0 +1,156 @@+-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+-- A multiset type, implemented in terms of 'MonoidMap'.+--+-- See: https://en.wikipedia.org/wiki/Multiset+--+module Examples.MultiSet+    ( fromList+    , toList+    , null+    , member+    , multiplicity+    , root+    , cardinality+    , dimension+    , height+    , isSubsetOf+    , intersection+    , union+    , disjointUnion+    , add+    , subtract+    , subtractMaybe+    )+    where++import Prelude hiding+    ( null, subtract )++import Data.Function+    ( on )+import Data.Monoid+    ( Sum (..) )+import Data.Monoid.GCD+    ( DistributiveGCDMonoid+    , GCDMonoid+    , LeftDistributiveGCDMonoid+    , LeftGCDMonoid+    , OverlappingGCDMonoid+    , RightDistributiveGCDMonoid+    , RightGCDMonoid+    )+import Data.Monoid.LCM+    ( DistributiveLCMMonoid, LCMMonoid )+import Data.Monoid.Monus+    ( Monus ((<\>)) )+import Data.Monoid.Null+    ( MonoidNull, PositiveMonoid )+import Data.MonoidMap+    ( MonoidMap )+import Data.Semigroup.Cancellative+    ( Cancellative+    , Commutative+    , LeftCancellative+    , LeftReductive+    , Reductive ((</>))+    , RightCancellative+    , RightReductive+    )+import Data.Set+    ( Set )+import Numeric.Natural+    ( Natural )+import Text.Read+    ( Read (..) )++import qualified Data.Foldable as F+import qualified Data.MonoidMap as MonoidMap++newtype MultiSet a = MultiSet+    { unMultiSet :: MonoidMap a (Sum Natural)+    }+    deriving newtype+        ( Eq+        , Semigroup+        , Commutative+        , Monoid+        , MonoidNull+        , PositiveMonoid+        , LeftReductive+        , LeftCancellative+        , LeftGCDMonoid+        , LeftDistributiveGCDMonoid+        , RightReductive+        , RightCancellative+        , RightGCDMonoid+        , RightDistributiveGCDMonoid+        , Reductive+        , Cancellative+        , GCDMonoid+        , LCMMonoid+        , DistributiveGCDMonoid+        , DistributiveLCMMonoid+        , OverlappingGCDMonoid+        , Monus+        )++instance (Ord a, Read a) => Read (MultiSet a) where+    readPrec = fromList <$> readPrec++instance Show a => Show (MultiSet a) where+    show = show . toList++fromList :: Ord a => [(a, Natural)] -> MultiSet a+fromList = MultiSet . MonoidMap.fromList . fmap (fmap Sum)++toList :: MultiSet a -> [(a, Natural)]+toList = fmap (fmap getSum) . MonoidMap.toList . unMultiSet++null :: MultiSet a -> Bool+null = MonoidMap.null . unMultiSet++member :: Ord a => a -> MultiSet a -> Bool+member a = MonoidMap.nonNullKey a . unMultiSet++multiplicity :: Ord a => a -> MultiSet a -> Natural+multiplicity a = getSum . MonoidMap.get a . unMultiSet++root :: Ord a => MultiSet a -> Set a+root = MonoidMap.nonNullKeys . unMultiSet++cardinality :: MultiSet a -> Natural+cardinality = getSum . F.fold . unMultiSet++dimension :: MultiSet a -> Natural+dimension = fromIntegral . MonoidMap.nonNullCount . unMultiSet++height :: Ord a => MultiSet a -> Natural+height s+    | null s = 0+    | otherwise = getSum $ F.maximum $ unMultiSet s++isSubsetOf :: Ord a => MultiSet a -> MultiSet a -> Bool+isSubsetOf = MonoidMap.isSubmapOf `on` unMultiSet++intersection :: Ord a => MultiSet a -> MultiSet a -> MultiSet a+intersection (MultiSet s1) (MultiSet s2) =+    MultiSet (MonoidMap.intersection s1 s2)++union :: Ord a => MultiSet a -> MultiSet a -> MultiSet a+union (MultiSet s1) (MultiSet s2) =+    MultiSet (MonoidMap.union s1 s2)++disjointUnion :: Ord a => MultiSet a -> MultiSet a -> MultiSet a+disjointUnion m1 m2 = (m1 <\> m2) <> (m2 <\> m1)++add :: Ord a => MultiSet a -> MultiSet a -> MultiSet a+add = (<>)++subtract :: Ord a => MultiSet a -> MultiSet a -> MultiSet a+subtract = (<\>)++subtractMaybe :: Ord a => MultiSet a -> MultiSet a -> Maybe (MultiSet a)+subtractMaybe = (</>)
+ src/examples/Examples/NestedMonoidMap.hs view
@@ -0,0 +1,314 @@+{-# LANGUAGE TypeSynonymInstances #-}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+-- A nested map with compound keys, implemented in terms of 'MonoidMap'.+--+module Examples.NestedMonoidMap+    (+    -- * Type+      NestedMonoidMap++    -- * Construction+    , fromFlatList+    , fromFlatMap+    , fromNestedList+    , fromNestedMap++    -- * Deconstruction+    , toFlatList+    , toFlatMap+    , toNestedList+    , toNestedMap++    -- * Basic operations+    , get+    , set+    , adjust+    , nullify++    -- * Membership+    , nonNullCount+    , nonNullKey+    , nonNullKeys++    -- * Intersection+    , intersection+    , intersectionWith++    -- * Union+    , union+    , unionWith++    -- * Comparison+    , isSubmapOf+    , isSubmapOfBy+    , disjoint+    , disjointBy+    )+    where++import Prelude++import Data.Map.Strict+    ( Map )+import Data.Monoid+    ( Sum (..) )+import Data.Monoid.GCD+    ( GCDMonoid, LeftGCDMonoid, OverlappingGCDMonoid, RightGCDMonoid )+import Data.Monoid.LCM+    ( LCMMonoid )+import Data.Monoid.Monus+    ( Monus )+import Data.Monoid.Null+    ( MonoidNull, PositiveMonoid )+import Data.MonoidMap+    ( MonoidMap )+import Data.Semigroup.Cancellative+    ( Cancellative+    , Commutative+    , LeftCancellative+    , LeftReductive+    , Reductive+    , RightCancellative+    , RightReductive+    )+import Data.Set+    ( Set )+import GHC.Exts+    ( IsList (..) )++import qualified Data.Foldable as F+import qualified Data.Map.Strict as Map+import qualified Data.MonoidMap as MonoidMap+import qualified Data.Set as Set++--------------------------------------------------------------------------------+-- Type+--------------------------------------------------------------------------------++newtype NestedMonoidMap k1 k2 v =+    NestedMonoidMap (MonoidMap k1 (MonoidMap k2 v))+    deriving stock Eq+    deriving newtype+        ( Cancellative+        , Commutative+        , GCDMonoid+        , LCMMonoid+        , LeftCancellative+        , LeftGCDMonoid+        , LeftReductive+        , Monoid+        , MonoidNull+        , Monus+        , OverlappingGCDMonoid+        , PositiveMonoid+        , Reductive+        , RightCancellative+        , RightGCDMonoid+        , RightReductive+        , Semigroup+        , Show+        )++--------------------------------------------------------------------------------+-- Construction+--------------------------------------------------------------------------------++fromFlatList+    :: (Ord k1, Ord k2, MonoidNull v)+    => [((k1, k2), v)]+    -> NestedMonoidMap k1 k2 v+fromFlatList = F.foldl' acc mempty+  where+    acc m ((k1, k2), v) = adjust (<> v) k1 k2 m++fromFlatMap+    :: (Ord k1, Ord k2, MonoidNull v)+    => Map (k1, k2) v+    -> NestedMonoidMap k1 k2 v+fromFlatMap = fromFlatList . Map.toList++fromNestedList+    :: (Ord k1, Ord k2, MonoidNull v)+    => [(k1, [(k2, v)])]+    -> NestedMonoidMap k1 k2 v+fromNestedList entries =+    fromFlatList [((k1, k2), v) | (k1, n) <- entries, (k2, v) <- n]++fromNestedMap+    :: (Ord k2, MonoidNull v)+    => Map k1 (Map k2 v)+    -> NestedMonoidMap k1 k2 v+fromNestedMap = NestedMonoidMap . MonoidMap.fromMap . fmap MonoidMap.fromMap++--------------------------------------------------------------------------------+-- Deconstruction+--------------------------------------------------------------------------------++toFlatList+    :: (Ord k1, Ord k2, MonoidNull v)+    => NestedMonoidMap k1 k2 v+    -> [((k1, k2), v)]+toFlatList m = [((k1, k2), v) | (k1, n) <- toNestedList m, (k2, v) <- toList n]++toFlatMap+    :: (Ord k1, Ord k2, MonoidNull v)+    => NestedMonoidMap k1 k2 v+    -> Map (k1, k2) v+toFlatMap = Map.fromList . toFlatList++toNestedList+    :: (Ord k1, Ord k2, MonoidNull v)+    => NestedMonoidMap k1 k2 v+    -> [(k1, [(k2, v)])]+toNestedList (NestedMonoidMap m) = fmap toList <$> toList m++toNestedMap+    :: NestedMonoidMap k1 k2 v+    -> Map k1 (Map k2 v)+toNestedMap (NestedMonoidMap m) = MonoidMap.toMap <$> MonoidMap.toMap m++--------------------------------------------------------------------------------+-- Basic operations+--------------------------------------------------------------------------------++get :: (Ord k1, Ord k2, MonoidNull v)+    => k1+    -> k2+    -> NestedMonoidMap k1 k2 v+    -> v+get k1 k2 (NestedMonoidMap m) = MonoidMap.get k2 (MonoidMap.get k1 m)++set :: (Ord k1, Ord k2, MonoidNull v)+    => k1+    -> k2+    -> v+    -> NestedMonoidMap k1 k2 v+    -> NestedMonoidMap k1 k2 v+set k1 k2 v (NestedMonoidMap m) =+    NestedMonoidMap $ MonoidMap.adjust (MonoidMap.set k2 v) k1 m++adjust+    :: (Ord k1, Ord k2, MonoidNull v)+    => (v -> v)+    -> k1+    -> k2+    -> NestedMonoidMap k1 k2 v+    -> NestedMonoidMap k1 k2 v+adjust f k1 k2 (NestedMonoidMap m) =+    NestedMonoidMap $ MonoidMap.adjust (MonoidMap.adjust f k2) k1 m++nullify+    :: (Ord k1, Ord k2, MonoidNull v)+    => k1+    -> k2+    -> NestedMonoidMap k1 k2 v+    -> NestedMonoidMap k1 k2 v+nullify k1 k2 (NestedMonoidMap m) =+    NestedMonoidMap $ MonoidMap.adjust (MonoidMap.nullify k2) k1 m++--------------------------------------------------------------------------------+-- Membership+--------------------------------------------------------------------------------++nonNullCount :: NestedMonoidMap k1 k2 v -> Int+nonNullCount (NestedMonoidMap m) =+    getSum $ F.foldMap (Sum . MonoidMap.nonNullCount) m++nonNullKey+    :: (Ord k1, Ord k2, MonoidNull v)+    => k1+    -> k2+    -> NestedMonoidMap k1 k2 v+    -> Bool+nonNullKey k1 k2 (NestedMonoidMap m) =+    MonoidMap.nonNullKey k2 (MonoidMap.get k1 m)++nonNullKeys+    :: (Ord k1, Ord k2, MonoidNull v)+    => NestedMonoidMap k1 k2 v+    -> Set (k1, k2)+nonNullKeys = Set.fromList . fmap fst . toFlatList++--------------------------------------------------------------------------------+-- Intersection+--------------------------------------------------------------------------------++intersection+    :: (Ord k1, Ord k2, MonoidNull v, GCDMonoid v)+    => NestedMonoidMap k1 k2 v+    -> NestedMonoidMap k1 k2 v+    -> NestedMonoidMap k1 k2 v+intersection (NestedMonoidMap m1) (NestedMonoidMap m2) = NestedMonoidMap $+    MonoidMap.intersection m1 m2++intersectionWith+    :: (Ord k1, Ord k2, MonoidNull v)+    => (v -> v -> v)+    -> NestedMonoidMap k1 k2 v+    -> NestedMonoidMap k1 k2 v+    -> NestedMonoidMap k1 k2 v+intersectionWith f (NestedMonoidMap m1) (NestedMonoidMap m2) = NestedMonoidMap $+    MonoidMap.intersectionWith (MonoidMap.intersectionWith f) m1 m2++--------------------------------------------------------------------------------+-- Union+--------------------------------------------------------------------------------++union+    :: (Ord k1, Ord k2, MonoidNull v, LCMMonoid v)+    => NestedMonoidMap k1 k2 v+    -> NestedMonoidMap k1 k2 v+    -> NestedMonoidMap k1 k2 v+union (NestedMonoidMap m1) (NestedMonoidMap m2) = NestedMonoidMap $+    MonoidMap.union m1 m2++unionWith+    :: (Ord k1, Ord k2, MonoidNull v)+    => (v -> v -> v)+    -> NestedMonoidMap k1 k2 v+    -> NestedMonoidMap k1 k2 v+    -> NestedMonoidMap k1 k2 v+unionWith f (NestedMonoidMap m1) (NestedMonoidMap m2) = NestedMonoidMap $+    MonoidMap.unionWith (MonoidMap.unionWith f) m1 m2++--------------------------------------------------------------------------------+-- Comparison+--------------------------------------------------------------------------------++isSubmapOf+    :: (Ord k1, Ord k2, MonoidNull v, Reductive v)+    => NestedMonoidMap k1 k2 v+    -> NestedMonoidMap k1 k2 v+    -> Bool+isSubmapOf (NestedMonoidMap m1) (NestedMonoidMap m2) =+    MonoidMap.isSubmapOf m1 m2++isSubmapOfBy+    :: (Ord k1, Ord k2, MonoidNull v, Reductive v)+    => (v -> v -> Bool)+    -> NestedMonoidMap k1 k2 v+    -> NestedMonoidMap k1 k2 v+    -> Bool+isSubmapOfBy f (NestedMonoidMap m1) (NestedMonoidMap m2) =+    MonoidMap.isSubmapOfBy (MonoidMap.isSubmapOfBy f) m1 m2++disjoint+    :: (Ord k1, Ord k2, MonoidNull v, GCDMonoid v)+    => NestedMonoidMap k1 k2 v+    -> NestedMonoidMap k1 k2 v+    -> Bool+disjoint (NestedMonoidMap m1) (NestedMonoidMap m2) =+    MonoidMap.disjoint m1 m2++disjointBy+    :: (Ord k1, Ord k2, MonoidNull v, GCDMonoid v)+    => (v -> v -> Bool)+    -> NestedMonoidMap k1 k2 v+    -> NestedMonoidMap k1 k2 v+    -> Bool+disjointBy f (NestedMonoidMap m1) (NestedMonoidMap m2) =+    MonoidMap.disjointBy (MonoidMap.disjointBy f) m1 m2
+ src/examples/Examples/RecoveredMap.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+-- An ordinary left-biased map similar to 'Map', implemented in terms of+-- 'MonoidMap'.+--+module Examples.RecoveredMap where++import Prelude hiding+    ( map )++import Control.DeepSeq+    ( NFData )+import Data.Maybe+    ( mapMaybe )+import Data.Monoid+    ( First (..) )+import Data.MonoidMap+    ( MonoidMap )+import Data.Set+    ( Set )++import qualified Data.MonoidMap as MonoidMap++newtype Map k v = Map+    --  'First' is used to mimic the left-biased nature of 'Data.Map':+    {unMap :: MonoidMap k (First v)}+    deriving newtype (Eq, NFData, Semigroup, Monoid)++instance (Show k, Show v) => Show (Map k v) where+    show = ("fromList " <>) . show . toList++instance Functor (Map k) where+    fmap = map++empty :: Map k v+empty = Map MonoidMap.empty++singleton :: Ord k => k -> v -> Map k v+singleton k = Map . MonoidMap.singleton k . pure++fromList :: Ord k => [(k, v)] -> Map k v+fromList = Map . MonoidMap.fromListWith (const id) . fmap (fmap pure)++toList :: Map k v -> [(k, v)]+toList = mapMaybe (getFirst . sequenceA) . MonoidMap.toList . unMap++delete :: Ord k => k -> Map k v -> Map k v+delete k = Map . MonoidMap.nullify k . unMap++insert :: Ord k => k -> v -> Map k v -> Map k v+insert k v = Map . MonoidMap.set k (pure v) . unMap++keysSet :: Map k v -> Set k+keysSet = MonoidMap.nonNullKeys . unMap++lookup :: Ord k => k -> Map k v -> Maybe v+lookup k = getFirst . MonoidMap.get k . unMap++member :: Ord k => k -> Map k v -> Bool+member k = MonoidMap.nonNullKey k . unMap++map :: (v1 -> v2) -> Map k v1 -> Map k v2+map f = Map . MonoidMap.map (fmap f) . unMap
+ src/internal/Data/MonoidMap/Internal.hs view
@@ -0,0 +1,3038 @@+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{- HLINT ignore "Avoid lambda" -}+{- HLINT ignore "Avoid lambda using `infix`" -}+{- HLINT ignore "Redundant bracket" -}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+-- Provides /internal/ operations for the 'MonoidMap' type.+--+module Data.MonoidMap.Internal+    (+    -- * Types+      MonoidMap (..)+    , NonNull (..)++    -- * General operations++    -- ** Construction+    , empty+    , fromList+    , fromListWith+    , fromMap+    , singleton++    -- ** Deconstruction+    , toList+    , toMap++    -- ** Lookup+    , get++    -- ** Modification+    , set+    , adjust+    , nullify++    -- ** Membership+    , null+    , nullKey+    , nonNull+    , nonNullCount+    , nonNullKey+    , nonNullKeys++    -- ** Slicing+    , take+    , drop+    , splitAt++    -- ** Filtering+    , filter+    , filterKeys+    , filterWithKey++    -- ** Partitioning+    , partition+    , partitionKeys+    , partitionWithKey++    -- ** Mapping+    , map+    , mapKeys+    , mapKeysWith++    -- * Monoidal operations++    -- ** Association+    , append++    -- ** Subtraction+    , minus+    , minusMaybe+    , monus++    -- ** Inversion+    , invert++    -- ** Exponentiation+    , power++    -- ** Comparison+    , isSubmapOf+    , isSubmapOfBy+    , disjoint+    , disjointBy++    -- ** Intersection+    , intersection+    , intersectionWith+    , intersectionWithA++    -- ** Union+    , union+    , unionWith+    , unionWithA++    -- ** Prefixes+    , isPrefixOf+    , stripPrefix+    , commonPrefix+    , stripCommonPrefix++    -- ** Suffixes+    , isSuffixOf+    , stripSuffix+    , commonSuffix+    , stripCommonSuffix++    -- ** Overlap+    , overlap+    , stripPrefixOverlap+    , stripSuffixOverlap+    , stripOverlap+    )+    where++import Prelude hiding+    ( drop, filter, lookup, map, null, splitAt, subtract, take )++import Control.DeepSeq+    ( NFData )+import Data.Bifoldable+    ( Bifoldable )+import Data.Coerce+    ( coerce )+import Data.Function+    ( (&) )+import Data.Functor.Classes+    ( Eq1, Eq2, Show1, Show2 )+import Data.Functor.Identity+    ( Identity (..) )+import Data.Group+    ( Abelian, Group )+import Data.Map.Strict+    ( Map, lookup )+import Data.Maybe+    ( fromMaybe, isJust )+import Data.Monoid.GCD+    ( DistributiveGCDMonoid+    , GCDMonoid+    , LeftDistributiveGCDMonoid+    , LeftGCDMonoid+    , OverlappingGCDMonoid+    , RightDistributiveGCDMonoid+    , RightGCDMonoid+    )+import Data.Monoid.LCM+    ( DistributiveLCMMonoid, LCMMonoid )+import Data.Monoid.Monus+    ( Monus (..) )+import Data.Monoid.Null+    ( MonoidNull, PositiveMonoid )+import Data.Semigroup.Cancellative+    ( Cancellative+    , Commutative+    , LeftCancellative+    , LeftReductive+    , Reductive (..)+    , RightCancellative+    , RightReductive+    )+import Data.Set+    ( Set )+import GHC.Exts+    ( IsList (Item) )+import NoThunks.Class+    ( NoThunks )+import Text.Read+    ( Read (..) )++import qualified Data.Bifunctor as B+import qualified Data.Foldable as F+import qualified Data.List as L+import qualified Data.List.NonEmpty as NE+import qualified Data.Map.Merge.Strict as Map+import qualified Data.Map.Strict as Map+import qualified Data.Set as Set+import qualified GHC.Exts as GHC++import qualified Data.Group as C+import qualified Data.Monoid.GCD as C+import qualified Data.Monoid.LCM as C+import qualified Data.Monoid.Null as C+import qualified Data.Semigroup.Cancellative as C++--------------------------------------------------------------------------------+-- Type+--------------------------------------------------------------------------------++newtype MonoidMap k v = MonoidMap+    { unMonoidMap :: Map k (NonNull v) }+    deriving (Eq, Show, NFData, NoThunks)+        via Map k v+    deriving (Eq1, Show1, Foldable)+        via Map k+    deriving (Eq2, Show2, Bifoldable)+        via Map++--------------------------------------------------------------------------------+-- Non-null values+--------------------------------------------------------------------------------++newtype NonNull v = UnsafeNonNull {getNonNull :: v}++maybeNonNull :: MonoidNull v => v -> Maybe (NonNull v)+maybeNonNull !v+    | C.null  v = Nothing+    | otherwise = Just (UnsafeNonNull v)+{-# INLINE maybeNonNull #-}++applyNonNull :: (v -> a) -> (NonNull v -> a)+applyNonNull = coerce+{-# INLINE applyNonNull #-}++applyNonNull2 :: (v1 -> v2 -> a) -> (NonNull v1 -> NonNull v2 -> a)+applyNonNull2 = coerce+{-# INLINE applyNonNull2 #-}++--------------------------------------------------------------------------------+-- Instances+--------------------------------------------------------------------------------++instance (Ord k, MonoidNull v) =>+    IsList (MonoidMap k v)+  where+    type Item (MonoidMap k v) = (k, v)+    fromList = fromList+    toList = toList++instance (Ord k, Read k, MonoidNull v, Read v) =>+    Read (MonoidMap k v)+  where+    readPrec = fromMap <$> readPrec++--------------------------------------------------------------------------------+-- Instances: Semigroup and subclasses+--------------------------------------------------------------------------------++instance (Ord k, MonoidNull v) =>+    Semigroup (MonoidMap k v)+  where+    (<>) = append++instance (Ord k, MonoidNull v, Commutative v) =>+    Commutative (MonoidMap k v)++instance (Ord k, MonoidNull v, LeftReductive v) =>+    LeftReductive (MonoidMap k v)+  where+    isPrefixOf = isPrefixOf+    stripPrefix = stripPrefix++instance (Ord k, MonoidNull v, RightReductive v) =>+    RightReductive (MonoidMap k v)+  where+    isSuffixOf = isSuffixOf+    stripSuffix = stripSuffix++instance (Ord k, MonoidNull v, Reductive v) =>+    Reductive (MonoidMap k v)+  where+    (</>) = minusMaybe++instance (Ord k, MonoidNull v, LeftCancellative v) =>+    LeftCancellative (MonoidMap k v)++instance (Ord k, MonoidNull v, RightCancellative v) =>+    RightCancellative (MonoidMap k v)++instance (Ord k, MonoidNull v, Cancellative v) =>+    Cancellative (MonoidMap k v)++--------------------------------------------------------------------------------+-- Instances: Monoid and subclasses+--------------------------------------------------------------------------------++instance (Ord k, MonoidNull v) =>+    Monoid (MonoidMap k v)+  where+    mempty = empty++instance (Ord k, MonoidNull v) =>+    MonoidNull (MonoidMap k v)+  where+    null = null++instance (Ord k, PositiveMonoid v) =>+    PositiveMonoid (MonoidMap k v)++instance (Ord k, MonoidNull v, LeftGCDMonoid v) =>+    LeftGCDMonoid (MonoidMap k v)+  where+    commonPrefix = commonPrefix++instance (Ord k, MonoidNull v, LeftDistributiveGCDMonoid v) =>+    LeftDistributiveGCDMonoid (MonoidMap k v)++instance (Ord k, MonoidNull v, RightGCDMonoid v) =>+    RightGCDMonoid (MonoidMap k v)+  where+    commonSuffix = commonSuffix++instance (Ord k, MonoidNull v, RightDistributiveGCDMonoid v) =>+    RightDistributiveGCDMonoid (MonoidMap k v)++instance (Ord k, MonoidNull v, OverlappingGCDMonoid v) =>+    OverlappingGCDMonoid (MonoidMap k v)+  where+    overlap = overlap+    stripPrefixOverlap = stripPrefixOverlap+    stripSuffixOverlap = stripSuffixOverlap+    stripOverlap = stripOverlap++instance (Ord k, MonoidNull v, GCDMonoid v) =>+    GCDMonoid (MonoidMap k v)+  where+    gcd = intersection++instance (Ord k, MonoidNull v, DistributiveGCDMonoid v) =>+    DistributiveGCDMonoid (MonoidMap k v)++instance (Ord k, MonoidNull v, LCMMonoid v) =>+    LCMMonoid (MonoidMap k v)+  where+    lcm = union++instance (Ord k, MonoidNull v, DistributiveLCMMonoid v) =>+    DistributiveLCMMonoid (MonoidMap k v)++instance (Ord k, MonoidNull v, Monus v) =>+    Monus (MonoidMap k v)+  where+    (<\>) = monus++--------------------------------------------------------------------------------+-- Instances: Group and subclasses+--------------------------------------------------------------------------------++instance (Ord k, MonoidNull v, Group v) =>+    Group (MonoidMap k v)+  where+    invert = invert+    (~~) = minus+    pow = power++instance (Ord k, MonoidNull v, Abelian v) =>+    Abelian (MonoidMap k v)++--------------------------------------------------------------------------------+-- Construction+--------------------------------------------------------------------------------++-- | \(O(1)\). The empty 'MonoidMap'.+--+-- Satisfies the following property for all possible keys __@k@__:+--+-- @+-- 'get' k 'empty' == 'mempty'+-- @+--+-- Provides the definition of 'mempty' for the 'MonoidMap' instance of+-- 'Monoid'.+--+empty :: MonoidMap k v+empty = MonoidMap Map.empty++-- | \(O(n \log n)\). Constructs a 'MonoidMap' from a list of key-value pairs.+--+-- If the list contains more than one value for the same key, values are+-- combined together in the order that they appear with the '(<>)' operator.+--+-- Satisfies the following property for all possible keys __@k@__:+--+-- @+-- 'get' k ('fromList' kvs) '=='+--     'foldMap' 'snd' ('L.filter' (('==' k) . fst) kvs)+-- @+--+-- Satisfies the following round-trip property:+--+-- @+-- 'fromList' ('toList' m) '==' m+-- @+--+-- === __Examples__+--+-- With 'String' values:+--+-- @+-- >>> 'fromList' [(1,"a"), (2,"x"), (1,"b"), (2,"y"), (1,"c"), (2,"z")]+-- 'fromList' [(1,"abc"), (2,"xyz")]+-- @+--+fromList :: (Ord k, MonoidNull v) => [(k, v)] -> MonoidMap k v+fromList = fromListWith (<>)++-- | \(O(n \log n)\). Constructs a 'MonoidMap' from a list of key-value pairs,+--   with a combining function for values.+--+-- If the list contains more than one value for the same key, values are+-- combined together in the order that they appear with the given combining+-- function.+--+-- Satisfies the following property for all possible keys __@k@__:+--+-- @+-- 'get' k ('fromListWith' f kvs) '=='+--     'maybe' 'mempty' ('F.foldl1' f)+--         ('NE.nonEmpty' ('snd' '<$>' 'L.filter' (('==' k) . fst) kvs))+-- @+--+fromListWith+    :: (Ord k, MonoidNull v)+    => (v -> v -> v)+    -- ^ Function with which to combine values for duplicate keys.+    -> [(k, v)]+    -> MonoidMap k v+fromListWith f =+    -- The 'Map.fromListWith' function combines values for duplicate keys in+    -- /reverse order/, so we must flip the provided combining function.+    fromMap . Map.fromListWith (flip f)++-- | \(O(n)\). Constructs a 'MonoidMap' from an ordinary 'Map'.+--+-- Satisfies the following property for all possible keys __@k@__:+--+-- @+-- 'get' k ('fromMap' m) '==' 'Map.findWithDefault' 'mempty' 'k' m+-- @+--+-- This function performs canonicalisation of 'C.null' values, and has a time+-- complexity that is linear in the length of the list.+--+fromMap :: MonoidNull v => Map k v -> MonoidMap k v+fromMap = MonoidMap . Map.mapMaybe maybeNonNull++-- | \(O(1)\). Constructs a 'MonoidMap' from a single key-value pair.+--+-- Satisfies the following property:+--+-- @+-- 'get' 'k' ('singleton' k v) '==' v+-- @+--+-- Nullifying the value for key __@k@__ produces an 'empty' map:+--+-- @+-- 'nullify' 'k' ('singleton' k v) '==' 'empty'+-- @+--+singleton :: (Ord k, MonoidNull v) => k -> v -> MonoidMap k v+singleton k v = set k v mempty++--------------------------------------------------------------------------------+-- Deconstruction+--------------------------------------------------------------------------------++-- | \(O(n)\). Converts a 'MonoidMap' to a list of key-value pairs, where the+--   keys are in ascending order.+--+-- The result only includes entries with values that are not 'C.null'.+--+-- Satisfies the following round-trip property:+--+-- @+-- 'fromList' ('toList' m) '==' m+-- @+--+-- The resulting list is sorted in ascending key order:+--+-- @+-- 'L.sortOn' 'fst' ('toList' m) '==' 'toList' m+-- @+--+toList :: MonoidMap k v -> [(k, v)]+toList = Map.toAscList . toMap++-- | \(O(1)\). Converts a 'MonoidMap' to an ordinary 'Map'.+--+-- The result only includes entries with values that are not 'C.null'.+--+-- Satisfies the following round-trip property:+--+-- @+-- 'fromMap' ('toMap' m) == m+-- @+--+toMap :: forall k v. MonoidMap k v -> Map k v+toMap = coerce++--------------------------------------------------------------------------------+-- Lookup+--------------------------------------------------------------------------------++-- | \(O(\log n)\). Gets the value associated with the given key.+--+-- By default, every key in an 'empty' map is associated with a value of+-- 'mempty':+--+-- @+-- ∀ k. 'get' k 'empty' '==' 'mempty'+-- @+--+get :: (Ord k, Monoid v) => k -> MonoidMap k v -> v+get k m = fromMaybe mempty $ Map.lookup k $ toMap m++--------------------------------------------------------------------------------+-- Modification+--------------------------------------------------------------------------------++-- | \(O(\log n)\). Sets the value associated with the given key.+--+-- Satisfies the following property:+--+-- @+-- 'get' k ('set' k v m) '==' v+-- @+--+set :: (Ord k, MonoidNull v) => k -> v -> MonoidMap k v -> MonoidMap k v+set k v (MonoidMap m) = MonoidMap $ case maybeNonNull v of+    Just v0 -> Map.insert k v0 m+    Nothing -> Map.delete k    m++-- | \(O(\log n)\). Adjusts the value associated with the given key.+--+-- Satisfies the following property:+--+-- @+-- 'adjust' f k m '==' 'set' k (f ('get' k m)) m+-- @+--+adjust+    :: (Ord k, MonoidNull v)+    => (v -> v)+    -> k+    -> MonoidMap k v+    -> MonoidMap k v+adjust f k (MonoidMap m) = MonoidMap $+    Map.alter (maybeNonNull . maybe (f mempty) (applyNonNull f)) k m++-- | \(O(\log n)\). Sets the value associated with the given key to 'mempty'.+--+-- Satisfies the following property:+--+-- @+-- 'get' k ('nullify' k m) '==' 'mempty'+-- @+--+nullify :: Ord k => k -> MonoidMap k v -> MonoidMap k v+nullify k (MonoidMap m) = MonoidMap $ Map.delete k m++--------------------------------------------------------------------------------+-- Membership+--------------------------------------------------------------------------------++-- | \(O(1)\). Returns 'True' if (and only if) all values in the map are+--   'C.null'.+--+-- Satisfies the following property:+--+-- @+-- 'null' m '==' (∀ k. 'nullKey' k m)+-- @+--+-- Provides the definition of 'C.null' for the 'MonoidMap' instance of+-- 'MonoidNull'.+--+null :: MonoidMap k v -> Bool+null = Map.null . toMap++-- | \(O(\log n)\). Returns 'True' if (and only if) the given key is associated+--   with a value that is 'C.null'.+--+-- Satisfies the following property:+--+-- @+-- 'nullKey' k m '==' 'C.null' ('get' k m)+-- @+--+nullKey :: Ord k => k -> MonoidMap k v -> Bool+nullKey k = Map.notMember k . toMap++-- | \(O(1)\). Returns 'True' if (and only if) the map contains at least one+--   value that is not 'C.null'.+--+-- Satisfies the following property:+--+-- @+-- 'nonNull' m '==' (∃ k. 'nonNullKey' k m)+-- @+--+nonNull :: MonoidMap k v -> Bool+nonNull = not . null++-- | \(O(1)\). Returns a count of all values in the map that are not 'C.null'.+--+-- Satisfies the following property:+--+-- @+-- 'nonNullCount' m '==' 'Set.size' ('nonNullKeys' m)+-- @+--+nonNullCount :: MonoidMap k v -> Int+nonNullCount = Map.size . toMap++-- | \(O(\log n)\). Returns 'True' if (and only if) the given key is associated+--   with a value that is not 'C.null'.+--+-- Satisfies the following property:+--+-- @+-- 'nonNullKey' k m '==' 'not' ('C.null' ('get' k m))+-- @+--+nonNullKey :: Ord k => k -> MonoidMap k v -> Bool+nonNullKey k = Map.member k . toMap++-- | \(O(n)\). Returns the set of keys associated with values that are not+--   'C.null'.+--+-- Satisfies the following property:+--+-- @+-- k '`Set.member`' ('nonNullKeys' m) '==' 'nonNullKey' k m+-- @+--+nonNullKeys :: MonoidMap k v -> Set k+nonNullKeys = Map.keysSet . toMap++--------------------------------------------------------------------------------+-- Slicing+--------------------------------------------------------------------------------++-- | \(O(\log n)\). /Takes/ a slice from a map.+--+-- This function takes a given number of non-'C.null' entries from a map,+-- producing a new map from the entries that were /taken/.+--+-- Entries are taken in /key order/, beginning with the /smallest/ keys.+--+-- Satifies the following property:+--+-- @+-- 'take' n '==' 'fromList' . 'Prelude.take' n . 'toList'+-- @+--+take :: Int -> MonoidMap k v -> MonoidMap k v+take i (MonoidMap m) = MonoidMap (Map.take i m)++-- | \(O(\log n)\). /Drops/ a slice from a map.+--+-- This function drops a given number of non-'C.null' entries from a map,+-- producing a new map from the entries that /remain/.+--+-- Entries are dropped in /key order/, beginning with the /smallest/ keys.+--+-- Satifies the following property:+--+-- @+-- 'drop' n '==' 'fromList' . 'Prelude.drop' n . 'toList'+-- @+--+drop :: Int -> MonoidMap k v -> MonoidMap k v+drop i (MonoidMap m) = MonoidMap (Map.drop i m)++-- | \(O(\log n)\). /Splits/ a map into /two/ slices.+--+-- This function is equivalent to a combination of 'take' and 'drop':+--+-- @+-- 'splitAt' n m '==' ('take' n m, 'drop' n m)+-- @+--+-- The resulting maps can be combined to reproduce the original map:+--+-- @+-- 'splitAt' n m '&'+--     \\(m1, m2) -> m1 '<>' m2 '==' m+-- @+--+-- The resulting maps have disjoint sets of non-'C.null' entries:+--+-- @+-- 'splitAt' n m '&'+--     \\(m1, m2) -> 'Set.disjoint' ('nonNullKeys' m1) ('nonNullKeys' m2)+-- @+--+splitAt :: Int -> MonoidMap k a -> (MonoidMap k a, MonoidMap k a)+splitAt i m = (take i m, drop i m)++--------------------------------------------------------------------------------+-- Filtering+--------------------------------------------------------------------------------++-- | \(O(n)\). Filters a map according to a predicate on /values/.+--+-- Satisfies the following property for all possible keys __@k@__:+--+-- @+-- 'get' k ('filter' f m) '=='+--     if f ('get' k m)+--     then 'get' k m+--     else 'mempty'+-- @+--+-- The resulting map is identical to that obtained by constructing a map from a+-- filtered list of key-value pairs:+--+-- @+-- 'filter' f m '==' 'fromList' ('L.filter' (f . 'snd') ('toList' m))+-- @+--+filter :: (v -> Bool) -> MonoidMap k v -> MonoidMap k v+filter f (MonoidMap m) = MonoidMap $ Map.filter (applyNonNull f) m++-- | \(O(n)\). Filters a map according to a predicate on /keys/.+--+-- Satisfies the following property for all possible keys __@k@__:+--+-- @+-- 'get' k ('filterKeys' f m) '=='+--     if f k+--     then 'get' k m+--     else 'mempty'+-- @+--+-- The resulting map is identical to that obtained by constructing a map from a+-- filtered list of key-value pairs:+--+-- @+-- 'filter' f m '==' 'fromList' ('L.filter' (f . 'fst') ('toList' m))+-- @+--+filterKeys :: (k -> Bool) -> MonoidMap k v -> MonoidMap k v+filterKeys f (MonoidMap m) = MonoidMap $ Map.filterWithKey (\k _ -> f k) m++-- | \(O(n)\). Filters a map according to a predicate on /keys and values/.+--+-- Satisfies the following property for all possible keys __@k@__:+--+-- @+-- 'get' k ('filterWithKey' f m) '=='+--     if f k ('get' k m)+--     then 'get' k m+--     else 'mempty'+-- @+--+-- The resulting map is identical to that obtained by constructing a map from a+-- filtered list of key-value pairs:+--+-- @+-- 'filterWithKey' f m '==' 'fromList' ('L.filter' ('uncurry' f) ('toList' m))+-- @+--+filterWithKey :: (k -> v -> Bool) -> MonoidMap k v -> MonoidMap k v+filterWithKey f (MonoidMap m) =+    MonoidMap $ Map.filterWithKey (applyNonNull . f) m++--------------------------------------------------------------------------------+-- Partitioning+--------------------------------------------------------------------------------++-- | \(O(n)\). Partitions a map according to a predicate on /values/.+--+-- Satisfies the following property:+--+-- @+-- 'partition' f m '=='+--     ( 'filter'  \   \   f  m+--     , 'filter' ('not' . f) m+--     )+-- @+--+-- The resulting maps can be combined to reproduce the original map:+--+-- @+-- 'partition' f m '&' \\(m1, m2) ->+--     m1 '<>' m2 '==' m+-- @+--+-- The resulting maps have disjoint sets of non-'C.null' entries:+--+-- @+-- 'partition' f m '&' \\(m1, m2) ->+--     'Set.disjoint'+--         ('nonNullKeys' m1)+--         ('nonNullKeys' m2)+-- @+--+partition :: (v -> Bool) -> MonoidMap k v -> (MonoidMap k v, MonoidMap k v)+partition f (MonoidMap m) =+    B.bimap MonoidMap MonoidMap $ Map.partition (applyNonNull f) m++-- | \(O(n)\). Partitions a map according to a predicate on /keys/.+--+-- Satisfies the following property:+--+-- @+-- 'partitionKeys' f m '=='+--     ( 'filterKeys'  \   \   f  m+--     , 'filterKeys' ('not' . f) m+--     )+-- @+--+-- The resulting maps can be combined to reproduce the original map:+--+-- @+-- 'partitionKeys' f m '&' \\(m1, m2) ->+--     m1 '<>' m2 '==' m+-- @+--+-- The resulting maps have disjoint sets of non-'C.null' entries:+--+-- @+-- 'partitionKeys' f m '&' \\(m1, m2) ->+--     'Set.disjoint'+--         ('nonNullKeys' m1)+--         ('nonNullKeys' m2)+-- @+--+partitionKeys+    :: (k -> Bool) -> MonoidMap k v -> (MonoidMap k v, MonoidMap k v)+partitionKeys f (MonoidMap m) =+    B.bimap MonoidMap MonoidMap $ Map.partitionWithKey (\k _ -> f k) m++-- | \(O(n)\). Partitions a map according to a predicate on /keys and values/.+--+-- Satisfies the following property:+--+-- @+-- 'partitionWithKey' f m '=='+--     ( 'filterWithKey'   \    \   \    \  \   \ f  m+--     , 'filterWithKey' (('fmap' . 'fmap') 'not' f) m+--     )+-- @+--+-- The resulting maps can be combined to reproduce the original map:+--+-- @+-- 'partitionWithKey' f m '&' \\(m1, m2) ->+--     m1 '<>' m2 '==' m+-- @+--+-- The resulting maps have disjoint sets of non-'C.null' entries:+--+-- @+-- 'partitionWithKey' f m '&' \\(m1, m2) ->+--     'Set.disjoint'+--         ('nonNullKeys' m1)+--         ('nonNullKeys' m2)+-- @+--+partitionWithKey+    :: (k -> v -> Bool) -> MonoidMap k v -> (MonoidMap k v, MonoidMap k v)+partitionWithKey f (MonoidMap m) =+    B.bimap MonoidMap MonoidMap $ Map.partitionWithKey (applyNonNull . f) m++--------------------------------------------------------------------------------+-- Mapping+--------------------------------------------------------------------------------++-- | \(O(n)\). Applies a function to all non-'C.null' values of a 'MonoidMap'.+--+-- Satisfies the following properties for all functions __@f@__:+--+-- @+-- ('get' k m '==' 'mempty') ==> ('get' k ('map' f m) '==' 'mempty'     )+-- ('get' k m '/=' 'mempty') ==> ('get' k ('map' f m) '==' f ('get' k m))+-- @+--+-- === Conditional properties+--+-- If applying function __@f@__ to 'mempty' produces 'mempty', then the+-- following additional properties hold:+--+-- @+-- (f 'mempty' '==' 'mempty')+--     ==>+--     (∀ k. 'get' k ('map' f m) '==' f ('get' k m))+-- @+--+-- @+-- (f 'mempty' '==' 'mempty')+--     ==>+--     (∀ g. 'map' (f . g) m '==' 'map' f ('map' g m))+-- @+--+map+    :: MonoidNull v2+    => (v1 -> v2)+    -> MonoidMap k v1+    -> MonoidMap k v2+map f (MonoidMap m) =+    MonoidMap $ Map.mapMaybe (maybeNonNull . applyNonNull f) m++-- | \(O(n \log n)\). Applies a function to all the keys of a 'MonoidMap' that+--   are associated with non-'C.null' values.+--+-- If the resultant map would contain more than one value for the same key,+-- values are combined together in ascending key order with the '(<>)'+-- operator.+--+-- Satisfies the following property for all possible keys __@k@__:+--+-- @+-- 'get' k ('mapKeys' f m) '=='+--     'F.foldMap'+--         ('`get`' m)+--         ('Set.filter' (('==') k . f) ('nonNullKeys' m))+-- @+--+mapKeys+    :: (Ord k2, MonoidNull v)+    => (k1 -> k2)+    -> MonoidMap k1 v+    -> MonoidMap k2 v+mapKeys = mapKeysWith (<>)++-- | \(O(n \log n)\). Applies a function to all the keys of a 'MonoidMap' that+--   are associated with non-'C.null' values, with a combining function for+--   values.+--+-- If the resultant map would contain more than one value for the same key,+-- values are combined together in ascending key order with the given+-- combining function.+--+-- Satisfies the following property:+--+-- @+-- 'mapKeysWith' c f '==' 'fromListWith' c . 'fmap' ('B.first' f) . 'toList'+-- @+--+mapKeysWith+    :: (Ord k2, MonoidNull v)+    => (v -> v -> v)+    -- ^ Function with which to combine values for duplicate keys.+    -> (k1 -> k2)+    -> MonoidMap k1 v+    -> MonoidMap k2 v+mapKeysWith combine fk = fromListWith combine . fmap (B.first fk) . toList++--------------------------------------------------------------------------------+-- Comparison+--------------------------------------------------------------------------------++-- | Indicates whether or not the first map is a /submap/ of the second.+--+-- Map __@m1@__ is a submap of map __@m2@__ if (and only if) __@m1@__ can be+-- subtracted from __@m2@__ with the 'minusMaybe' operation:+--+-- @+-- m1 '`isSubmapOf`' m2 '==' 'isJust' (m2 '`minusMaybe`' m1)+-- @+--+-- Equivalently, map __@m1@__ is a submap of map __@m2@__ if (and only if) for+-- all possible keys __@k@__, the value for __@k@__ in __@m1@__ can be+-- subtracted from the value for __@k@__ in __@m2@__ with the '(</>)' operator:+--+-- @+-- m1 '`isSubmapOf`' m2 '==' (∀ k. 'isJust' ('get' k m2 '</>' 'get' k m1))+-- @+--+isSubmapOf+    :: (Ord k, Monoid v, Reductive v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Bool+isSubmapOf = isSubmapOfBy $ \v1 v2 -> isJust (v2 </> v1)+{-# INLINE isSubmapOf #-}++-- | Indicates whether or not the first map is a /submap/ of the second, using+--   the given function to compare values for matching keys.+--+-- Satisfies the following property:+--+-- @+-- 'isSubmapOfBy' f m1 m2 '=='+--     'all' (\\k -> f ('get' k m1) ('get' k m2)) ('nonNullKeys' m1)+-- @+--+-- === Conditional totality+--+-- /If/ the given comparison function __@f@__ /always/ evaluates to 'True'+-- when its first argument is 'mempty':+--+-- @+-- ∀ v. f 'mempty' v+-- @+--+-- /Then/ the following property holds:+--+-- @+-- 'isSubmapOfBy' f m1 m2 '==' (∀ k. f ('get' k m1) ('get' k m2))+-- @+--+isSubmapOfBy+    :: (Ord k, Monoid v1, Monoid v2)+    => (v1 -> v2 -> Bool)+    -- ^ Function with which to compare values for matching keys.+    -> MonoidMap k v1+    -> MonoidMap k v2+    -> Bool+isSubmapOfBy leq m1 m2 =+    all+        (\k -> get k m1 `leq` get k m2)+        (nonNullKeys m1)+{-# INLINE isSubmapOfBy #-}++-- | Indicates whether or not a pair of maps are /disjoint/.+--+-- Maps __@m1@__ and __@m2@__ are disjoint if (and only if) their intersection+-- is empty:+--+-- @+-- 'disjoint' m1 m2 '==' ('intersection' m1 m2 '==' 'mempty')+-- @+--+-- Equivalently, maps __@m1@__ and __@m2@__ are disjoint if (and only if) for+-- all possible keys __@k@__, the values for __@k@__ in __@m1@__ and __@m2@__+-- have a 'C.gcd' that is 'C.null':+--+-- @+-- 'disjoint' m1 m2 '==' (∀ k. 'C.null' ('C.gcd' ('get' k m1) ('get' k m2)))+-- @+--+disjoint+    :: (Ord k, GCDMonoid v, MonoidNull v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Bool+disjoint = disjointBy (\v1 v2 -> C.null (C.gcd v1 v2))+{-# INLINE disjoint #-}++-- | Indicates whether or not a pair of maps are /disjoint/ using the given+--   indicator function to test pairs of values for matching keys.+--+-- Satisfies the following property:+--+-- @+-- 'disjointBy' f m1 m2 '=='+--     'all'+--         (\\k -> f ('get' k m1) ('get' k m2))+--         ('Set.intersection' ('nonNullKeys' m1) ('nonNullKeys' m2))+-- @+--+-- === Conditional totality+--+-- /If/ the given indicator function __@f@__ /always/ evaluates to 'True'+-- when /either/ or /both/ of its arguments are 'mempty':+--+-- @+-- ∀ v. (f v 'mempty') '&&' (f 'mempty' v)+-- @+--+-- /Then/ the following property holds:+--+-- @+-- 'disjointBy' f m1 m2 '==' (∀ k. f ('get' k m1) ('get' k m2))+-- @+--+disjointBy+    :: (Ord k, Monoid v1, Monoid v2)+    => (v1 -> v2 -> Bool)+    -- ^ Function with which to test pairs of values for matching keys.+    -> MonoidMap k v1+    -> MonoidMap k v2+    -> Bool+disjointBy f m1 m2 =+    all+        (\k -> f (get k m1) (get k m2))+        (Set.intersection (nonNullKeys m1) (nonNullKeys m2))+{-# INLINE disjointBy #-}++--------------------------------------------------------------------------------+-- Association+--------------------------------------------------------------------------------++-- | Appends a pair of maps together.+--+-- Uses the 'Semigroup' operator '(<>)' to append each value in the first map+-- to its matching value in the second map.+--+-- Satisfies the following property for all possible keys __@k@__:+--+-- @+-- 'get' k ('append' m1 m2) '==' 'get' k m1 '<>' 'get' k m2+-- @+--+-- This function provides the definition of '(<>)' for the 'MonoidMap' instance+-- of 'Semigroup'.+--+-- === __Examples__+--+-- With 'String' values:+--+-- @+-- >>> m1 = 'fromList' [(1, "abc"), (2, "ij" ), (3, "p"  )            ]+-- >>> m2 = 'fromList' [            (2, "  k"), (3,  "qr"), (4, "xyz")]+-- >>> m3 = 'fromList' [(1, "abc"), (2, "ijk"), (3, "pqr"), (4, "xyz")]+-- @+-- @+-- >>> 'append' m1 m2 '==' m3+-- 'True'+-- @+--+-- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values:+--+-- @+-- >>> m1 = 'fromList' [("a", 4), ("b", 2), ("c", 1)          ]+-- >>> m2 = 'fromList' [          ("b", 1), ("c", 2), ("d", 4)]+-- >>> m3 = 'fromList' [("a", 4), ("b", 3), ("c", 3), ("d", 4)]+-- @+-- @+-- >>> 'append' m1 m2 '==' m3+-- 'True'+-- @+--+append+    :: (Ord k, MonoidNull v)+    => MonoidMap k v+    -> MonoidMap k v+    -> MonoidMap k v+append = merge MergeStrategy+    { withNonNullL =+        keepNonNull+        -- Justification:+        --+        -- v <> mempty ≡ v++    , withNonNullR =+        keepNonNull+        -- Justification:+        --+        -- mempty <> v ≡ v++    , withNonNullP =+        withBoth (<>)+    }+{-# INLINE append #-}++--------------------------------------------------------------------------------+-- Prefixes and suffixes+--------------------------------------------------------------------------------++-- | Indicates whether or not the first map is a /prefix/ of the second.+--+-- 'MonoidMap' __@m1@__ is a /prefix/ of 'MonoidMap' __@m2@__ if (and only if)+-- for all possible keys __@k@__, the value for __@k@__ in __@m1@__ is a+-- /prefix/ of the value for __@k@__ in __@m2@__:+--+-- @+-- m1 '`isPrefixOf`' m2 '==' (∀ k. 'get' k m1 '`C.isPrefixOf`' 'get' k m2)+-- @+--+-- This function provides the definition of 'C.isPrefixOf' for the 'MonoidMap'+-- instance of 'LeftReductive'.+--+-- === __Examples__+--+-- With 'String' values:+--+-- @+-- >>> m1 = 'fromList' [(1, "a"  ), (2, "p"  ), (3, "x"  )]+-- >>> m2 = 'fromList' [(1, "abc"), (2, "pqr"), (3, "xyz")]+-- >>> m1 '`isPrefixOf`' m2+-- 'True'+-- @+--+-- @+-- >>> m1 = 'fromList' [            (2, "p"  )            ]+-- >>> m2 = 'fromList' [(1, "abc"), (2, "pqr"), (3, "xyz")]+-- >>> m1 '`isPrefixOf`' m2+-- 'True'+-- @+--+-- @+-- >>> m1 = 'fromList' [(1, "abc"), (2, "p"  ), (3, "x"  )]+-- >>> m2 = 'fromList' [(1, "a"  ), (2, "pqr"), (3, "xyz")]+-- >>> m1 '`isPrefixOf`' m2+-- 'False'+-- @+--+-- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values:+--+-- @+-- >>> m1 = 'fromList' [("a", 1), ("b", 1), ("c", 1)]+-- >>> m2 = 'fromList' [("a", 2), ("b", 4), ("c", 8)]+-- >>> m1 '`isPrefixOf`' m2+-- 'True'+-- @+--+-- @+-- >>> m1 = 'fromList' [          ("b", 1)          ]+-- >>> m2 = 'fromList' [("a", 2), ("b", 4), ("c", 8)]+-- >>> m1 '`isPrefixOf`' m2+-- 'True'+-- @+--+-- @+-- >>> m1 = 'fromList' [("a", 2), ("b", 1), ("c", 1)]+-- >>> m2 = 'fromList' [("a", 1), ("b", 4), ("c", 8)]+-- >>> m1 '`isPrefixOf`' m2+-- 'False'+-- @+--+isPrefixOf+    :: (Ord k, Monoid v, LeftReductive v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Bool+isPrefixOf = isSubmapOfBy C.isPrefixOf+    -- Note that in practice, it's sufficient to check the following property:+    --+    -- @+    -- m1 '`isPrefixOf`' m2 '=='+    --     'all'+    --         (\\k -> 'get' k m1 '`C.isPrefixOf`' 'get' k m2)+    --         ('nonNullKeys' m1)+    -- @+    --+    -- ==== Justification+    --+    -- According to the laws for 'LeftReductive':+    --+    -- @+    -- ∀ a b. b '`C.isPrefixOf`' (b '<>' a)+    -- @+    --+    -- Substituting 'mempty' for @b@:+    --+    -- @+    -- ∀ a. 'mempty' '`C.isPrefixOf`' ('mempty' '<>' a)+    -- @+    --+    -- According to the left identity law for 'Monoid':+    --+    -- @+    -- ∀ a. 'mempty' '<>' a '==' a+    -- @+    --+    -- We can therefore assert that:+    --+    -- @+    -- ∀ a. 'mempty' '`C.isPrefixOf`' a+    -- @+    --+    -- Since 'mempty' is /always/ a valid prefix, we only need to consider+    -- values in 'm1' that are /not/ 'mempty'.+    --+    -- The 'nonNullKeys' function, when applied to 'm1', gives us /precisely/+    -- the set of keys that are not associated with 'mempty' in 'm1':+    --+    -- @+    -- (k '`Data.Set.member`' 'nonNullKeys' m1) '==' ('get' k m1 '/=' 'mempty')+    -- @+    --+{-# INLINE isPrefixOf #-}++-- | Indicates whether or not the first map is a /suffix/ of the second.+--+-- 'MonoidMap' __@m1@__ is a /suffix/ of 'MonoidMap' __@m2@__ if (and only if)+-- for all possible keys __@k@__, the value for __@k@__ in __@m1@__ is a+-- /suffix/ of the value for __@k@__ in __@m2@__:+--+-- @+-- m1 '`isSuffixOf`' m2 '==' (∀ k. 'get' k m1 '`C.isSuffixOf`' 'get' k m2)+-- @+--+-- This function provides the definition of 'C.isSuffixOf' for the 'MonoidMap'+-- instance of 'RightReductive'.+--+-- === __Examples__+--+-- With 'String' values:+--+-- @+-- >>> m1 = 'fromList' [(1,   "c"), (2,   "r"), (3,   "z")]+-- >>> m2 = 'fromList' [(1, "abc"), (2, "pqr"), (3, "xyz")]+-- >>> m1 '`isSuffixOf`' m2+-- 'True'+-- @+--+-- @+-- >>> m1 = 'fromList' [            (2,   "r")            ]+-- >>> m2 = 'fromList' [(1, "abc"), (2, "pqr"), (3, "xyz")]+-- >>> m1 '`isSuffixOf`' m2+-- 'True'+-- @+--+-- @+-- >>> m1 = 'fromList' [(1, "abc"), (2,   "r"), (3,   "z")]+-- >>> m2 = 'fromList' [(1,   "c"), (2, "pqr"), (3, "xyz")]+-- >>> m1 '`isSuffixOf`' m2+-- 'False'+-- @+--+-- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values:+--+-- @+-- >>> m1 = 'fromList' [("a", 1), ("b", 1), ("c", 1)]+-- >>> m2 = 'fromList' [("a", 2), ("b", 4), ("c", 8)]+-- >>> m1 '`isSuffixOf`' m2+-- 'True'+-- @+--+-- @+-- >>> m1 = 'fromList' [          ("b", 1)          ]+-- >>> m2 = 'fromList' [("a", 2), ("b", 4), ("c", 8)]+-- >>> m1 '`isSuffixOf`' m2+-- 'True'+-- @+--+-- @+-- >>> m1 = 'fromList' [("a", 2), ("b", 1), ("c", 1)]+-- >>> m2 = 'fromList' [("a", 1), ("b", 4), ("c", 8)]+-- >>> m1 '`isSuffixOf`' m2+-- 'False'+-- @+--+isSuffixOf+    :: (Ord k, Monoid v, RightReductive v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Bool+isSuffixOf = isSubmapOfBy C.isSuffixOf+    -- Note that in practice, it's sufficient to check the following property:+    --+    -- @+    -- m1 '`isSuffixOf`' m2 '=='+    --     'all'+    --         (\\k -> 'get' k m1 '`C.isSuffixOf`' 'get' k m2)+    --         ('nonNullKeys' m1)+    -- @+    --+    -- ==== Justification+    --+    -- According to the laws for 'RightReductive':+    --+    -- @+    -- ∀ a b. b '`C.isSuffixOf`' (a '<>' b)+    -- @+    --+    -- Substituting 'mempty' for @b@:+    --+    -- @+    -- ∀ a. 'mempty' '`C.isSuffixOf`' (a '<>' 'mempty')+    -- @+    --+    -- According to the right identity law for 'Monoid':+    --+    -- @+    -- ∀ a. a '<>' 'mempty' '==' a+    -- @+    --+    -- We can therefore assert that:+    --+    -- @+    -- ∀ a. 'mempty' '`C.isSuffixOf`' a+    -- @+    --+    -- Since 'mempty' is /always/ a valid suffix, we only need to consider+    -- values in 'm1' that are /not/ 'mempty'.+    --+    -- The 'nonNullKeys' function, when applied to 'm1', gives us /precisely/+    -- the set of keys that are not associated with 'mempty' in 'm1':+    --+    -- @+    -- (k '`Data.Set.member`' 'nonNullKeys' m1) '==' ('get' k m1 '/=' 'mempty')+    -- @+    --+{-# INLINE isSuffixOf #-}++-- | Strips a /prefix/ from a 'MonoidMap'.+--+-- If map __@m1@__ is a /prefix/ of map __@m2@__, then 'stripPrefix' __@m1@__+-- __@m2@__ will produce a /reduced/ map where prefix __@m1@__ is /stripped/+-- from __@m2@__.+--+-- === Properties+--+-- The 'stripPrefix' function, when applied to maps __@m1@__ and __@m2@__,+-- produces a result if (and only if) __@m1@__ is a prefix of __@m2@__:+--+-- @+-- 'isJust' ('stripPrefix' m1 m2) '==' m1 '`isPrefixOf`' m2+-- @+--+-- The value for any key __@k@__ in the result is /identical/ to the result of+-- stripping the value for __@k@__ in map __@m1@__ from the value for __@k@__+-- in map __@m2@__:+--+-- @+-- 'all'+--    (\\r -> 'Just' ('get' k r) '==' 'C.stripPrefix' ('get' k m1) ('get' k m2))+--    ('stripPrefix' m1 m2)+-- @+--+-- If we append prefix __@m1@__ to the /left-hand/ side of the result, we can+-- always recover the original map __@m2@__:+--+-- @+-- 'all'+--    (\\r -> m1 '<>' r '==' m2)+--    ('stripPrefix' m1 m2)+-- @+--+-- This function provides the definition of 'C.stripPrefix' for the 'MonoidMap'+-- instance of 'LeftReductive'.+--+-- === __Examples__+--+-- With 'String' values:+--+-- @+-- >>> __m1__ = 'fromList' [(1, ""   ), (2, "i"  ), (3, "pq" ), (4, "xyz")]+-- >>> __m2__ = 'fromList' [(1, "abc"), (2, "ijk"), (3, "pqr"), (4, "xyz")]+-- >>> __m3__ = 'fromList' [(1, "abc"), (2,  "jk"), (3,   "r"), (4,    "")]+-- @+-- @+-- >>> 'stripPrefix' __m1__ __m2__ '==' 'Just' __m3__+-- 'True'+-- @+-- @+-- >>> 'stripPrefix' __m2__ __m1__ '==' 'Nothing'+-- 'True'+-- @+--+-- With 'Data.Monoid.Sum' 'Numeric.Natural' values:+--+-- @+-- >>> __m1__ = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)]+-- >>> __m2__ = 'fromList' [("a", 3), ("b", 3), ("c", 3), ("d", 3)]+-- >>> __m3__ = 'fromList' [("a", 3), ("b", 2), ("c", 1), ("d", 0)]+-- @+-- @+-- >>> 'stripPrefix' __m1__ __m2__ '==' 'Just' __m3__+-- 'True'+-- @+-- @+-- >>> 'stripPrefix' __m2__ __m1__ '==' 'Nothing'+-- 'True'+-- @+--+stripPrefix+    :: (Ord k, MonoidNull v, LeftReductive v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Maybe (MonoidMap k v)+stripPrefix = mergeA MergeStrategy+    { withNonNullL =+        withNonNullA (\v -> C.stripPrefix v mempty)++    , withNonNullR =+        keepNonNull+        -- Justification:+        --+        -- stripPrefix mempty a ≡ a++    , withNonNullP =+        withBothA C.stripPrefix+    }+{-# INLINE stripPrefix #-}++-- | Strips a /suffix/ from a 'MonoidMap'.+--+-- If map __@m1@__ is a /suffix/ of map __@m2@__, then 'stripSuffix' __@m1@__+-- __@m2@__ will produce a /reduced/ map where suffix __@m1@__ is /stripped/+-- from __@m2@__.+--+-- === Properties+--+-- The 'stripSuffix' function, when applied to maps __@m1@__ and __@m2@__,+-- produces a result if (and only if) __@m1@__ is a suffix of __@m2@__:+--+-- @+-- 'isJust' ('stripSuffix' m1 m2) '==' m1 '`isSuffixOf`' m2+-- @+--+-- The value for any key __@k@__ in the result is /identical/ to the result of+-- stripping the value for __@k@__ in map __@m1@__ from the value for __@k@__+-- in map __@m2@__:+--+-- @+-- 'all'+--    (\\r -> 'Just' ('get' k r) '==' 'C.stripSuffix' ('get' k m1) ('get' k m2))+--    ('stripSuffix' m1 m2)+-- @+--+-- If we append suffix __@m1@__ to the /right-hand/ side of the result, we can+-- always recover the original map __@m2@__:+--+-- @+-- 'all'+--    (\\r -> r '<>' m1 '==' m2)+--    ('stripSuffix' m1 m2)+-- @+--+-- This function provides the definition of 'C.stripSuffix' for the 'MonoidMap'+-- instance of 'RightReductive'.+--+-- === __Examples__+--+-- With 'String' values:+--+-- @+-- >>> __m1__ = 'fromList' [(1,    ""), (2,   "k"), (3,  "qr"), (4, "xyz")]+-- >>> __m2__ = 'fromList' [(1, "abc"), (2, "ijk"), (3, "pqr"), (4, "xyz")]+-- >>> __m3__ = 'fromList' [(1, "abc"), (2, "ij" ), (3, "p"  ), (4, ""   )]+-- @+-- @+-- >>> 'stripSuffix' __m1__ __m2__ '==' 'Just' __m3__+-- 'True'+-- @+-- @+-- >>> 'stripSuffix' __m2__ __m1__ '==' 'Nothing'+-- 'True'+-- @+--+-- With 'Data.Monoid.Sum' 'Numeric.Natural' values:+--+-- @+-- >>> __m1__ = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)]+-- >>> __m2__ = 'fromList' [("a", 3), ("b", 3), ("c", 3), ("d", 3)]+-- >>> __m3__ = 'fromList' [("a", 3), ("b", 2), ("c", 1), ("d", 0)]+-- @+-- @+-- >>> 'stripSuffix' __m1__ __m2__ '==' 'Just' __m3__+-- 'True'+-- @+-- @+-- >>> 'stripSuffix' __m2__ __m1__ '==' 'Nothing'+-- 'True'+-- @+--+stripSuffix+    :: (Ord k, MonoidNull v, RightReductive v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Maybe (MonoidMap k v)+stripSuffix = mergeA MergeStrategy+    { withNonNullL =+        withNonNullA (\v -> C.stripSuffix v mempty)++    , withNonNullR =+        keepNonNull+        -- Justification:+        --+        -- stripSuffix mempty a ≡ a++    , withNonNullP =+        withBothA C.stripSuffix+    }+{-# INLINE stripSuffix #-}++-- | Finds the /greatest common prefix/ of two maps.+--+-- Satisfies the following property for all possible keys __@k@__:+--+-- @+-- 'get' k ('commonPrefix' m1 m2)+--     '==' 'C.commonPrefix' ('get' k m1) ('get' k m2)+-- @+--+-- This function provides the definition of 'C.commonPrefix' for the+-- 'MonoidMap' instance of 'LeftGCDMonoid'.+--+-- === __Examples__+--+-- With 'String' values:+--+-- @+-- >>> __m1__ = 'fromList' [(1, "+++"), (2, "b++"), (3, "cc+"), (4, "ddd")]+-- >>> __m2__ = 'fromList' [(1, "---"), (2, "b--"), (3, "cc-"), (4, "ddd")]+-- >>> __m3__ = 'fromList' [(1, ""   ), (2, "b"  ), (3, "cc" ), (4, "ddd")]+-- @+-- @+-- >>> 'commonPrefix' __m1__ __m2__ '==' __m3__+-- 'True'+-- @+--+-- With 'Data.Monoid.Sum' 'Numeric.Natural' values:+--+-- @+-- >>> __m1__ = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)]+-- >>> __m2__ = 'fromList' [("a", 2), ("b", 2), ("c", 2), ("d", 2)]+-- >>> __m3__ = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 2)]+-- @+-- @+-- >>> 'commonPrefix' __m1__ __m2__ '==' __m3__+-- 'True'+-- @+--+commonPrefix+    :: (Ord k, MonoidNull v, LeftGCDMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> MonoidMap k v+commonPrefix = merge MergeStrategy+    { withNonNullL =+        keepNull+        -- Justification:+        --+        -- commonPrefix a mempty ≡ mempty++    , withNonNullR =+        keepNull+        -- Justification:+        --+        -- commonPrefix mempty a ≡ mempty++    , withNonNullP =+        withBoth C.commonPrefix+    }+{-# INLINE commonPrefix #-}++-- | Finds the /greatest common suffix/ of two maps.+--+-- Satisfies the following property for all possible keys __@k@__:+--+-- @+-- 'get' k ('commonSuffix' m1 m2)+--     '==' 'C.commonSuffix' ('get' k m1) ('get' k m2)+-- @+--+-- This function provides the definition of 'C.commonSuffix' for the+-- 'MonoidMap' instance of 'RightGCDMonoid'.+--+-- === __Examples__+--+-- With 'String' values:+--+-- @+-- >>> __m1__ = 'fromList' [(1, "+++"), (2, "++b"), (3, "+cc"), (4, "ddd")]+-- >>> __m2__ = 'fromList' [(1, "---"), (2, "--b"), (3, "-cc"), (4, "ddd")]+-- >>> __m3__ = 'fromList' [(1,    ""), (2,   "b"), (3,  "cc"), (4, "ddd")]+-- @+-- @+-- >>> 'commonSuffix' __m1__ __m2__ '==' __m3__+-- 'True'+-- @+--+-- With 'Data.Monoid.Sum' 'Numeric.Natural' values:+--+-- @+-- >>> __m1__ = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)]+-- >>> __m2__ = 'fromList' [("a", 2), ("b", 2), ("c", 2), ("d", 2)]+-- >>> __m3__ = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 2)]+-- @+-- @+-- >>> 'commonSuffix' __m1__ __m2__ '==' __m3__+-- 'True'+-- @+--+commonSuffix+    :: (Ord k, MonoidNull v, RightGCDMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> MonoidMap k v+commonSuffix = merge MergeStrategy+    { withNonNullL =+        keepNull+        -- Justification:+        --+        -- commonSuffix a mempty ≡ mempty++    , withNonNullR =+        keepNull+        -- Justification:+        --+        -- commonSuffix mempty a ≡ mempty++    , withNonNullP =+        withBoth C.commonSuffix+    }+{-# INLINE commonSuffix #-}++-- | Strips the /greatest common prefix/ from a pair of maps.+--+-- Given two maps __@m1@__ and __@m2@__, 'stripCommonPrefix' produces a+-- tuple __@(p, r1, r2)@__, where:+--+--  - __@p@__ is the /greatest common prefix/ of __@m1@__ and __@m2@__+--  - __@r1@__ is the /remainder/ of stripping prefix __@p@__ from __@m1@__+--  - __@r2@__ is the /remainder/ of stripping prefix __@p@__ from __@m2@__+--+-- The resulting prefix __@p@__ can be appended to the /left-hand/ side of+-- either remainder __@r1@__ or __@r2@__ to /reproduce/ either of the original+-- maps __@m1@__ or __@m2@__ respectively:+--+-- @+-- 'stripCommonPrefix' m1 m2+--    '&' \\(p, r1, _) -> p '<>' r1 '==' m1+-- 'stripCommonPrefix' m1 m2+--    '&' \\(p, _, r2) -> p '<>' r2 '==' m2+-- @+--+-- Prefix __@p@__ is /identical/ to the result of applying 'commonPrefix' to+-- __@m1@__ and __@m2@__:+--+-- @+-- 'stripCommonPrefix' m1 m2+--    '&' \\(p, _, _) -> p '==' 'commonPrefix' m1 m2+-- @+--+-- Remainders __@r1@__ and __@r2@__ are /identical/ to the results of applying+-- 'stripPrefix' to __@p@__ and __@m1@__ or to __@p@__ and __@m2@__+-- respectively:+--+-- @+-- 'stripCommonPrefix' m1 m2+--    '&' \\(p, r1, _) -> 'Just' r1 '==' 'stripPrefix' p m1+-- 'stripCommonPrefix' m1 m2+--    '&' \\(p, _, r2) -> 'Just' r2 '==' 'stripPrefix' p m2+-- @+--+-- This function provides the definition of 'C.stripCommonPrefix' for the+-- 'MonoidMap' instance of 'LeftGCDMonoid'.+--+-- === __Examples__+--+-- With 'String' values:+--+-- @+-- >>> m1 = 'fromList' [(1, "+++"), (2, "a++"), (3, "aa+"), (4, "aaa")]+-- >>> m2 = 'fromList' [(1, "---"), (2, "a--"), (3, "aa-"), (4, "aaa")]+-- @+-- @+-- >>> p  = 'fromList' [(1, ""   ), (2, "a"  ), (3, "aa" ), (4, "aaa")]+-- >>> r1 = 'fromList' [(1, "+++"), (2,  "++"), (3,   "+"), (4,    "")]+-- >>> r2 = 'fromList' [(1, "---"), (2,  "--"), (3,   "-"), (4,    "")]+-- @+-- @+-- >>> 'stripCommonPrefix' m1 m2 '==' (p, r1, r2)+-- 'True'+-- @+--+-- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values:+--+-- @+-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3), ("e", 4)]+-- >>> m2 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 1), ("e", 0)]+-- @+-- @+-- >>> p  = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 1), ("e", 0)]+-- >>> r1 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 2), ("e", 4)]+-- >>> r2 = 'fromList' [("a", 4), ("b", 2), ("c", 0), ("d", 0), ("e", 0)]+-- @+-- @+-- >>> 'stripCommonPrefix' m1 m2 '==' (p, r1, r2)+-- 'True'+-- @+--+stripCommonPrefix+    :: (Ord k, MonoidNull v, LeftGCDMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> (MonoidMap k v, MonoidMap k v, MonoidMap k v)+stripCommonPrefix = C.stripCommonPrefix++-- | Strips the /greatest common suffix/ from a pair of maps.+--+-- Given two maps __@m1@__ and __@m2@__, 'stripCommonSuffix' produces a+-- tuple __@(r1, r2, s)@__, where:+--+--  - __@s@__ is the /greatest common suffix/ of __@m1@__ and __@m2@__+--  - __@r1@__ is the /remainder/ of stripping suffix __@s@__ from __@m1@__+--  - __@r2@__ is the /remainder/ of stripping suffix __@s@__ from __@m2@__+--+-- The resulting suffix __@s@__ can be appended to the /right-hand/ side of+-- either remainder __@r1@__ or __@r2@__ to /reproduce/ either of the original+-- maps __@m1@__ or __@m2@__ respectively:+--+-- @+-- 'stripCommonSuffix' m1 m2+--    '&' \\(r1, _, s) -> r1 '<>' s '==' m1+-- 'stripCommonSuffix' m1 m2+--    '&' \\(_, r2, s) -> r2 '<>' s '==' m2+-- @+--+-- Suffix __@s@__ is /identical/ to the result of applying 'commonSuffix' to+-- __@m1@__ and __@m2@__:+--+-- @+-- 'stripCommonSuffix' m1 m2+--    '&' \\(_, _, s) -> s '==' 'commonSuffix' m1 m2+-- @+--+-- Remainders __@r1@__ and __@r2@__ are /identical/ to the results of applying+-- 'stripSuffix' to __@s@__ and __@m1@__ or to __@s@__ and __@m2@__+-- respectively:+--+-- @+-- 'stripCommonSuffix' m1 m2+--    '&' \\(r1, _, s) -> 'Just' r1 '==' 'stripSuffix' s m1+-- 'stripCommonSuffix' m1 m2+--    '&' \\(_, r2, s) -> 'Just' r2 '==' 'stripSuffix' s m2+-- @+--+-- This function provides the definition of 'C.stripCommonSuffix' for the+-- 'MonoidMap' instance of 'RightGCDMonoid'.+--+-- === __Examples__+--+-- With 'String' values:+--+-- @+-- >>> m1 = 'fromList' [(1, "+++"), (2, "++a"), (3, "+aa"), (4, "aaa")]+-- >>> m2 = 'fromList' [(1, "---"), (2, "--a"), (3, "-aa"), (4, "aaa")]+-- @+-- @+-- >>> r1 = 'fromList' [(1, "+++"), (2, "++" ), (3, "+"  ), (4, ""   )]+-- >>> r2 = 'fromList' [(1, "---"), (2, "--" ), (3, "-"  ), (4, ""   )]+-- >>> s  = 'fromList' [(1,    ""), (2,   "a"), (3,  "aa"), (4, "aaa")]+-- @+-- @+-- >>> 'stripCommonSuffix' m1 m2 '==' (r1, r2, s)+-- 'True'+-- @+--+-- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values:+--+-- @+-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3), ("e", 4)]+-- >>> m2 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 1), ("e", 0)]+-- @+-- @+-- >>> r1 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 2), ("e", 4)]+-- >>> r2 = 'fromList' [("a", 4), ("b", 2), ("c", 0), ("d", 0), ("e", 0)]+-- >>> s  = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 1), ("e", 0)]+-- @+-- @+-- >>> 'stripCommonSuffix' m1 m2 '==' (r1, r2, s)+-- 'True'+-- @+--+stripCommonSuffix+    :: (Ord k, MonoidNull v, RightGCDMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> (MonoidMap k v, MonoidMap k v, MonoidMap k v)+stripCommonSuffix = C.stripCommonSuffix++--------------------------------------------------------------------------------+-- Overlap+--------------------------------------------------------------------------------++-- | Finds the /greatest overlap/ of two maps.+--+-- The /greatest overlap/ __@o@__ of maps __@m1@__ and __@m2@__ is the /unique/+-- greatest map that is both a /suffix/ of __@m1@__ and a /prefix/ of __@m2@__:+--+-- @+-- m1 '==' r1 '<>' o \  \+-- m2 '=='    \  \ o '<>' r2+-- @+--+-- Where:+--+--  - __@r1@__ is the /remainder/ obtained by stripping /suffix overlap/+--    __@o@__ from __@m1@__.+--+--      (see 'stripSuffixOverlap')+--+--  - __@r2@__ is the /remainder/ obtained by stripping /prefix overlap/+--    __@o@__ from __@m2@__.+--+--      (see 'stripPrefixOverlap')+--+-- This function satisfies the following property:+--+-- @+-- 'get' k ('overlap' m1 m2) '==' 'C.overlap' ('get' k m1) ('get' k m2)+-- @+--+-- This function provides the definition of 'C.overlap' for the 'MonoidMap'+-- instance of 'OverlappingGCDMonoid'.+--+-- === __Examples__+--+-- With 'String' values:+--+-- @+-- >>> m1 = 'fromList' [(1,"abc"   ), (2,"abcd"  ), (3,"abcde "), (4,"abcdef")]+-- >>> m2 = 'fromList' [(1,   "def"), (2,  "cdef"), (3," bcdef"), (4,"abcdef")]+-- >>> m3 = 'fromList' [(1,   ""   ), (2,  "cd"  ), (3," bcde" ), (4,"abcdef")]+-- @+-- @+-- >>> 'overlap' m1 m2 '==' m3+-- 'True'+-- @+--+-- With 'Data.Monoid.Sum' 'Numeric.Natural' values:+--+-- @+-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3), ("e", 4)]+-- >>> m2 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 1), ("e", 0)]+-- >>> m3 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 1), ("e", 0)]+-- @+-- @+-- >>> 'overlap' m1 m2 '==' m3+-- 'True'+-- @+--+overlap+    :: (Ord k, MonoidNull v, OverlappingGCDMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> MonoidMap k v+overlap = merge MergeStrategy+    { withNonNullL =+        keepNull+        -- Justification:+        --+        -- overlap a mempty ≡ mempty++    , withNonNullR =+        keepNull+        -- Justification:+        --+        -- overlap mempty a ≡ mempty++    , withNonNullP =+        withBoth C.overlap+    }+{-# INLINE overlap #-}++-- | /Strips/ from the second map its /greatest prefix overlap/ with suffixes+--   of the first map.+--+-- Evaluating 'stripPrefixOverlap' __@m1@__ __@m2@__ produces the /remainder/+-- __@r2@__:+--+-- @+-- m1 '==' r1 '<>' o \  \+-- m2 '=='    \  \ o '<>' r2+-- @+--+-- Where __@o@__ is the /greatest overlap/ of maps __@m1@__ and __@m2@__: the+-- /unique/ greatest map that is both a /suffix/ of __@m1@__ and a /prefix/ of+-- __@m2@__.+--+-- This function satisfies the following property:+--+-- @+-- 'get' k ('stripPrefixOverlap' m1 m2)+--     '==' 'C.stripPrefixOverlap' ('get' k m1) ('get' k m2)+-- @+--+-- This function provides the definition of 'C.stripPrefixOverlap' for the+-- 'MonoidMap' instance of 'OverlappingGCDMonoid'.+--+-- === __Examples__+--+-- With 'String' values:+--+-- @+-- >>> m1 = 'fromList' [(1,"abc"   ), (2,"abcd"  ), (3,"abcde" ), (4,"abcdef")]+-- >>> m2 = 'fromList' [(1,   "def"), (2,  "cdef"), (3, "bcdef"), (4,"abcdef")]+-- >>> m3 = 'fromList' [(1,   "def"), (2,    "ef"), (3,     "f"), (4,      "")]+-- @+-- @+-- >>> 'stripPrefixOverlap' m1 m2 '==' m3+-- 'True'+-- @+--+-- With 'Data.Monoid.Sum' 'Numeric.Natural' values:+--+-- @+-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3), ("e", 4)]+-- >>> m2 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 1), ("e", 0)]+-- >>> m3 = 'fromList' [("a", 4), ("b", 2), ("c", 0), ("d", 0), ("e", 0)]+-- @+-- @+-- >>> 'stripPrefixOverlap' m1 m2 '==' m3+-- 'True'+-- @+--+stripPrefixOverlap+    :: (Ord k, MonoidNull v, OverlappingGCDMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> MonoidMap k v+stripPrefixOverlap = merge MergeStrategy+    { withNonNullL =+        keepNull+        -- Justification:+        --+        -- overlap a b      <> stripPrefixOverlap a b      ≡ b+        -- overlap a mempty <> stripPrefixOverlap a mempty ≡ mempty+        --           mempty <> stripPrefixOverlap a mempty ≡ mempty+        --                     stripPrefixOverlap a mempty ≡ mempty++    , withNonNullR =+        keepNonNull+        -- Justification:+        --+        -- overlap a      b <> stripPrefixOverlap a      b ≡ b+        -- overlap mempty b <> stripPrefixOverlap mempty b ≡ b+        --         mempty   <> stripPrefixOverlap mempty b ≡ b+        --                     stripPrefixOverlap mempty b ≡ b++    , withNonNullP =+        withBoth C.stripPrefixOverlap+    }+{-# INLINE stripPrefixOverlap #-}++-- | /Strips/ from the second map its /greatest suffix overlap/ with prefixes+--   of the first map.+--+-- Evaluating 'stripSuffixOverlap' __@m2@__ __@m1@__ produces the /remainder/+-- __@r1@__:+--+-- @+-- m1 '==' r1 '<>' o \  \+-- m2 '=='    \  \ o '<>' r2+-- @+--+-- Where __@o@__ is the /greatest overlap/ of maps __@m1@__ and __@m2@__: the+-- /unique/ greatest map that is both a /suffix/ of __@m1@__ and a /prefix/ of+-- __@m2@__.+--+-- This function satisfies the following property:+--+-- @+-- 'get' k ('stripSuffixOverlap' m2 m1)+--     '==' 'C.stripSuffixOverlap' ('get' k m2) ('get' k m1)+-- @+--+-- This function provides the definition of 'C.stripSuffixOverlap' for the+-- 'MonoidMap' instance of 'OverlappingGCDMonoid'.+--+-- === __Examples__+--+-- With 'String' values:+--+-- @+-- >>> m1 = 'fromList' [(1,"abc"   ), (2,"abcd"  ), (3,"abcde" ), (4,"abcdef")]+-- >>> m2 = 'fromList' [(1,   "def"), (2,  "cdef"), (3, "bcdef"), (4,"abcdef")]+-- >>> m3 = 'fromList' [(1,"abc"   ), (2,"ab"    ), (3,"a"     ), (4,""      )]+-- @+-- @+-- >>> 'stripSuffixOverlap' m2 m1 '==' m3+-- 'True'+-- @+--+-- With 'Data.Monoid.Sum' 'Numeric.Natural' values:+--+-- @+-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3), ("e", 4)]+-- >>> m2 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 1), ("e", 0)]+-- >>> m3 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 2), ("e", 4)]+-- @+-- @+-- >>> 'stripSuffixOverlap' m2 m1 '==' m3+-- 'True'+-- @+--+stripSuffixOverlap+    :: (Ord k, MonoidNull v, OverlappingGCDMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> MonoidMap k v+stripSuffixOverlap = merge MergeStrategy+    { withNonNullL =+        keepNull+        -- Justification:+        --+        -- stripSuffixOverlap b a      <> overlap a      b ≡ a+        -- stripSuffixOverlap b mempty <> overlap mempty b ≡ mempty+        -- stripSuffixOverlap b mempty <>         mempty   ≡ mempty+        -- stripSuffixOverlap b mempty                     ≡ mempty++    , withNonNullR =+        keepNonNull+        -- Justification:+        --+        -- stripSuffixOverlap b      a <> overlap a b      ≡ a+        -- stripSuffixOverlap mempty a <> overlap a mempty ≡ a+        -- stripSuffixOverlap mempty a <>           mempty ≡ a+        -- stripSuffixOverlap mempty a                     ≡ a++    , withNonNullP =+        withBoth C.stripSuffixOverlap+    }+{-# INLINE stripSuffixOverlap #-}++-- | Finds the /greatest overlap/ of two maps and /strips/ it from both maps.+--+-- Evaluating 'stripOverlap' __@m1@__ __@m2@__ produces the tuple+-- __@(r1, o, r2)@__, where:+--+-- @+-- m1 '==' r1 '<>' o \  \+-- m2 '=='    \  \ o '<>' r2+-- @+--+-- Where:+--+--  - __@o@__ is the /greatest overlap/ of maps __@m1@__ and __@m2@__: the+--    /unique/ greatest map that is both a /suffix/ of __@m1@__ and a /prefix/+--    of __@m2@__.+--+--      (see 'overlap')+--+--  - __@r1@__ is the /remainder/ obtained by stripping /suffix overlap/+--    __@o@__ from __@m1@__.+--+--      (see 'stripSuffixOverlap')+--+--  - __@r2@__ is the /remainder/ obtained by stripping /prefix overlap/+--    __@o@__ from __@m2@__.+--+--      (see 'stripPrefixOverlap')+--+-- This function satisfies the following property:+--+-- @+-- 'stripOverlap' m1 m2 '=='+--    ( 'stripSuffixOverlap' m2 m1+--    , 'overlap' m1 m2+--    , 'stripPrefixOverlap' m1 m2+--    )+-- @+--+-- This function provides the definition of 'C.stripOverlap' for the+-- 'MonoidMap' instance of 'OverlappingGCDMonoid'.+--+stripOverlap+    :: (Ord k, MonoidNull v, OverlappingGCDMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> (MonoidMap k v, MonoidMap k v, MonoidMap k v)+stripOverlap m1 m2 =+    ( stripSuffixOverlap m2 m1+    , m1 `overlap` m2+    , stripPrefixOverlap m1 m2+    )++--------------------------------------------------------------------------------+-- Intersection+--------------------------------------------------------------------------------++-- | Finds the /intersection/ of two maps.+--+-- The intersection of maps __@m1@__ and __@m2@__ is the greatest single map+-- __@m@__ that is a /submap/ of both __@m1@__ /and/ __@m2@__:+--+-- @+-- 'intersection' m1 m2 '`isSubmapOf`' m1+-- 'intersection' m1 m2 '`isSubmapOf`' m2+-- @+--+-- The intersection is /unique/:+--+-- @+-- 'and'+--     [ 'intersection' m1 m2 '`isSubmapOf`' m+--     , \            \       \            \ m '`isSubmapOf`' m1+--     , \            \       \            \ m '`isSubmapOf`' m2+--     ]+-- ==>+--     (m '==' 'intersection' m1 m2)+-- @+--+-- The following property holds for all possible keys __@k@__:+--+-- @+-- 'get' k ('intersection' m1 m2) '==' 'C.gcd' ('get' k m1) ('get' k m2)+-- @+--+-- This function provides the definition of 'C.gcd' for the 'MonoidMap'+-- instance of 'GCDMonoid'.+--+-- === __Examples__+--+-- With 'Data.Monoid.Product' 'Numeric.Natural.Natural' values, this function+-- computes the /greatest common divisor/ of each pair of matching values:+--+-- @+-- >>> m1 = 'fromList' [("a", 2), ("b",  6), ("c", 15), ("d", 35)]+-- >>> m2 = 'fromList' [("a", 6), ("b", 15), ("c", 35), ("d", 77)]+-- >>> m3 = 'fromList' [("a", 2), ("b",  3), ("c",  5), ("d",  7)]+-- @+-- @+-- >>> 'intersection' m1 m2 '==' m3+-- 'True'+-- @+--+-- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values, this function+-- computes the /minimum/ of each pair of matching values:+--+-- @+-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)]+-- >>> m2 = 'fromList' [("a", 3), ("b", 2), ("c", 1), ("d", 0)]+-- >>> m3 = 'fromList' [("a", 0), ("b", 1), ("c", 1), ("d", 0)]+-- @+-- @+-- >>> 'intersection' m1 m2 '==' m3+-- 'True'+-- @+--+-- With 'Set' 'Numeric.Natural.Natural' values, this function computes the+-- /set/ /intersection/ of each pair of matching values:+--+-- @+-- f xs = 'fromList' ('Set.fromList' '<$>' xs)+-- @+--+-- @+-- >>> m1 = f [("a", [0,1,2]), ("b", [0,1,2  ]), ("c", [0,1,2    ])]+-- >>> m2 = f [("a", [0,1,2]), ("b", [  1,2,3]), ("c", [    2,3,4])]+-- >>> m3 = f [("a", [0,1,2]), ("b", [  1,2  ]), ("c", [    2    ])]+-- @+-- @+-- >>> 'intersection' m1 m2 '==' m3+-- 'True'+-- @+--+intersection+    :: (Ord k, MonoidNull v, GCDMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> MonoidMap k v+intersection = merge MergeStrategy+    { withNonNullL =+        keepNull+        -- Justification:+        --+        -- gcd a mempty ≡ mempty++    , withNonNullR =+        keepNull+        -- Justification:+        --+        -- gcd mempty b ≡ mempty++    , withNonNullP =+        withBoth C.gcd+    }+{-# INLINE intersection #-}++--------------------------------------------------------------------------------+-- Union+--------------------------------------------------------------------------------++-- | Finds the /union/ of two maps.+--+-- The union of maps __@m1@__ and __@m2@__ is the smallest single map __@m@__+-- that includes both __@m1@__ /and/ __@m2@__ as /submaps/:+--+-- @+-- m1 '`isSubmapOf`' 'union' m1 m2+-- m2 '`isSubmapOf`' 'union' m1 m2+-- @+--+-- The union is /unique/:+--+-- @+-- 'and'+--     [ m1 '`isSubmapOf`' m+--     , m2 '`isSubmapOf`' m+--     ,    \            \ m '`isSubmapOf`' 'union' m1 m2+--     ]+-- ==>+--     (m '==' 'union' m1 m2)+-- @+--+-- The following property holds for all possible keys __@k@__:+--+-- @+-- 'get' k ('union' m1 m2) '==' 'C.lcm' ('get' k m1) ('get' k m2)+-- @+--+-- This function provides the definition of 'C.lcm' for the 'MonoidMap'+-- instance of 'LCMMonoid'.+--+-- === __Examples__+--+-- With 'Data.Monoid.Product' 'Numeric.Natural.Natural' values, this function+-- computes the /least common multiple/ of each pair of matching values:+--+-- @+-- >>> m1 = 'fromList' [("a", 2), ("b",  6), ("c",  15), ("d",  35)]+-- >>> m2 = 'fromList' [("a", 6), ("b", 15), ("c",  35), ("d",  77)]+-- >>> m3 = 'fromList' [("a", 6), ("b", 30), ("c", 105), ("d", 385)]+-- @+-- @+-- >>> 'union' m1 m2 '==' m3+-- 'True'+-- @+--+-- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values, this function+-- computes the /maximum/ of each pair of matching values:+--+-- @+-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)]+-- >>> m2 = 'fromList' [("a", 3), ("b", 2), ("c", 1), ("d", 0)]+-- >>> m3 = 'fromList' [("a", 3), ("b", 2), ("c", 2), ("d", 3)]+-- @+-- @+-- >>> 'union' m1 m2 '==' m3+-- 'True'+-- @+--+-- With 'Set' 'Numeric.Natural.Natural' values, this function computes the+-- /set/ /union/ of each pair of matching values:+--+-- @+-- f xs = 'fromList' ('Set.fromList' '<$>' xs)+-- @+--+-- @+-- >>> m1 = f [("a", [0,1,2]), ("b", [0,1,2  ]), ("c", [0,1,2    ])]+-- >>> m2 = f [("a", [0,1,2]), ("b", [  1,2,3]), ("c", [    2,3,4])]+-- >>> m3 = f [("a", [0,1,2]), ("b", [0,1,2,3]), ("c", [0,1,2,3,4])]+-- @+-- @+-- >>> 'union' m1 m2 '==' m3+-- 'True'+-- @+--+union+    :: (Ord k, MonoidNull v, LCMMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> MonoidMap k v+union = merge MergeStrategy+    { withNonNullL =+        keepNonNull+        -- Justification:+        --+        -- lcm a mempty ≡ a++    , withNonNullR =+        keepNonNull+        -- Justification:+        --+        -- lcm mempty a ≡ a++    , withNonNullP =+        withBoth C.lcm+    }+{-# INLINE union #-}++--------------------------------------------------------------------------------+-- Subtraction+--------------------------------------------------------------------------------++-- | Performs /group subtraction/ of the second map from the first.+--+-- Uses the 'Group' subtraction operator '(C.~~)' to subtract each value in the+-- second map from its matching value in the first map.+--+-- Satisfies the following property for all possible keys __@k@__:+--+-- @+-- 'get' k (m1 '`minus`' m2) '==' 'get' k m1 'C.~~' 'get' k m2+-- @+--+-- This function provides the definition of '(C.~~)' for the 'MonoidMap'+-- instance of 'Group'.+--+-- === __Examples__+--+-- With 'Data.Monoid.Sum' 'Integer' values, this function performs normal+-- integer subtraction of matching values:+--+-- @+-- >>> m1 = 'fromList' [("a", (-1)), ("b",   0 ), ("c", 1)]+-- >>> m2 = 'fromList' [("a",   1 ), ("b",   1 ), ("c", 1)]+-- >>> m3 = 'fromList' [("a", (-2)), ("b", (-1)), ("c", 0)]+-- @+-- @+-- >>> m1 '`minus`' m2 '==' m3+-- 'True'+-- @+--+-- @+-- >>> m1 = 'fromList' [("a", (-1)), ("b",   0 ), ("c",   1 )]+-- >>> m2 = 'fromList' [("a", (-1)), ("b", (-1)), ("c", (-1))]+-- >>> m3 = 'fromList' [("a",   0 ), ("b",   1 ), ("c",   2 )]+-- @+-- @+-- >>> m1 '`minus`' m2 '==' m3+-- 'True'+-- @+--+minus+    :: (Ord k, MonoidNull v, Group v)+    => MonoidMap k v+    -> MonoidMap k v+    -> MonoidMap k v+minus = merge MergeStrategy+    { withNonNullL =+        keepNonNull+        -- Justification:+        --+        -- a ~~ mempty ≡ a++    , withNonNullR =+        withNonNull C.invert+        -- Justification:+        --+        -- a      ~~ b ≡ a      <> invert b+        -- mempty ~~ b ≡ mempty <> invert b+        -- mempty ~~ b ≡           invert b++    , withNonNullP =+        withBoth (C.~~)+    }+{-# INLINE minus #-}++-- | Performs /reductive subtraction/ of the second map from the first.+--+-- Uses the 'Reductive' subtraction operator '(</>)' to subtract each value in+-- the second map from its matching value in the first map.+--+-- This function produces a result if (and only if) for all possible keys+-- __@k@__, it is possible to subtract the value for __@k@__ in the second map+-- from the value for __@k@__ in the first map:+--+-- @+-- 'isJust' (m1 '`minusMaybe`' m2)+--     '==' (∀ k. 'isJust' ('get' k m1 '</>' 'get' k m2))+-- @+--+-- Otherwise, this function returns 'Nothing'.+--+-- This function satisfies the following property:+--+-- @+-- 'all'+--    (\\r -> 'Just' ('get' k r) '==' 'get' k m1 '</>' 'get' k m2)+--    (m1 '`minusMaybe`' m2)+-- @+--+-- This function provides the definition of '(</>)' for the 'MonoidMap'+-- instance of 'Reductive'.+--+-- === __Examples__+--+-- With 'Set' 'Numeric.Natural.Natural' values, this function performs /set/+-- /subtraction/ of matching values, succeeding if (and only if) each value+-- from the second map is a subset of its matching value from the first map:+--+-- @+-- f xs = 'fromList' ('Set.fromList' '<$>' xs)+-- @+--+-- @+-- >>> m1 = f [("a", [0,1,2]), ("b", [0,1,2])]+-- >>> m2 = f [("a", [     ]), ("b", [0,1,2])]+-- >>> m3 = f [("a", [0,1,2]), ("b", [     ])]+-- @+-- @+-- >>> m1 '`minusMaybe`' m2 '==' 'Just' m3+-- 'True'+-- @+--+-- @+-- >>> m1 = f [("a", [0,1,2]), ("b", [0,1,2]), ("c", [0,1,2])]+-- >>> m2 = f [("a", [0    ]), ("b", [  1  ]), ("c", [    2])]+-- >>> m3 = f [("a", [  1,2]), ("b", [0,  2]), ("c", [0,1  ])]+-- @+-- @+-- >>> m1 '`minusMaybe`' m2 '==' 'Just' m3+-- 'True'+-- @+--+-- @+-- >>> m1 = f [("a", [0,1,2    ]), ("b", [0,1,2    ]), ("c", [0,1,2    ])]+-- >>> m2 = f [("a", [    2,3,4]), ("b", [  1,2,3,4]), ("c", [0,1,2,3,4])]+-- @+-- @+-- >>> m1 '`minusMaybe`' m2 '==' 'Nothing'+-- 'True'+-- @+--+-- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values, this function+-- performs /ordinary/ /subtraction/ of matching values, succeeding if (and only+-- if) each value from the second map is less than or equal to its matching+-- value from the first map:+--+-- @+-- >>> m1 = 'fromList' [("a", 2), ("b", 3), ("c", 5), ("d", 8)]+-- >>> m2 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 0)]+-- >>> m3 = 'fromList' [("a", 2), ("b", 3), ("c", 5), ("d", 8)]+-- @+-- @+-- >>> m1 '`minusMaybe`' m2 '==' 'Just' m3+-- 'True'+-- @+--+-- @+-- >>> m1 = 'fromList' [("a", 2), ("b", 3), ("c", 5), ("d", 8)]+-- >>> m2 = 'fromList' [("a", 1), ("b", 2), ("c", 3), ("d", 5)]+-- >>> m3 = 'fromList' [("a", 1), ("b", 1), ("c", 2), ("d", 3)]+-- @+-- @+-- >>> m1 '`minusMaybe`' m2 '==' 'Just' m3+-- 'True'+-- @+--+-- @+-- >>> m1 = 'fromList' [("a", 2), ("b", 3), ("c", 5), ("d", 8)]+-- >>> m2 = 'fromList' [("a", 2), ("b", 3), ("c", 5), ("d", 8)]+-- >>> m3 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 0)]+-- @+-- @+-- >>> m1 '`minusMaybe`' m2 '==' 'Just' m3+-- 'True'+-- @+--+-- @+-- >>> m1 = 'fromList' [("a", 2), ("b", 3), ("c", 5), ("d", 8)]+-- >>> m2 = 'fromList' [("a", 3), ("b", 3), ("c", 5), ("d", 8)]+-- @+-- @+-- >>> m1 '`minusMaybe`' m2 '==' 'Nothing'+-- 'True'+-- @+--+minusMaybe+    :: (Ord k, MonoidNull v, Reductive v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Maybe (MonoidMap k v)+minusMaybe = mergeA MergeStrategy+    { withNonNullL =+        keepNonNull+        -- Justification:+        --+        -- According to laws for Reductive:+        -- maybe a (b      <>) (a </> b     ) ≡       a+        -- maybe a (mempty <>) (a </> mempty) ≡       a+        -- maybe a (id       ) (a </> mempty) ≡       a+        --                     (a </> mempty) ∈ {Just a, Nothing}+        --+        -- According to laws for LeftReductive and RightReductive:+        -- isJust (a </> b     ) ≡ b      `isPrefixOf` a ≡ b      `isSuffixOf` a+        -- isJust (a </> mempty) ≡ mempty `isPrefixOf` a ≡ mempty `isSuffixOf` a+        --+        -- According to laws for LeftReductive and RightReductive:+        -- b      `isPrefixOf` (b      <> a)+        -- mempty `isPrefixOf` (mempty <> a)+        -- mempty `isPrefixOf`            a+        --+        -- Therefore:+        -- a </> mempty ≡ Just a++    , withNonNullR =+        withNonNullA (\v -> mempty </> v)++    , withNonNullP =+        withBothA (</>)+    }+{-# INLINE minusMaybe #-}++-- | Performs /monus subtraction/ of the second map from the first.+--+-- Uses the 'Monus' subtraction operator '(<\>)' to subtract each value in+-- the second map from its matching value in the first map.+--+-- Satisfies the following property for all possible keys __@k@__:+--+-- @+-- 'get' k (m1 '`monus`' m2) '==' 'get' k m1 '<\>' 'get' k m2+-- @+--+-- This function provides the definition of '(<\>)' for the 'MonoidMap'+-- instance of 'Monus'.+--+-- === __Examples__+--+-- With 'Set' 'Numeric.Natural.Natural' values, this function performs /set/+-- /subtraction/ of matching values:+--+-- @+-- f xs = 'fromList' ('Set.fromList' '<$>' xs)+-- @+--+-- @+-- >>> m1 = f [("a", [0,1,2]), ("b", [0,1,2])]+-- >>> m2 = f [("a", [     ]), ("b", [0,1,2])]+-- >>> m3 = f [("a", [0,1,2]), ("b", [     ])]+-- @+-- @+-- >>> m1 '`monus`' m2 '==' m3+-- 'True'+-- @+--+-- @+-- >>> m1 = f [("a", [0,1,2]), ("b", [0,1,2]), ("c", [0,1,2])]+-- >>> m2 = f [("a", [0    ]), ("b", [  1  ]), ("c", [    2])]+-- >>> m3 = f [("a", [  1,2]), ("b", [0,  2]), ("c", [0,1  ])]+-- @+-- @+-- >>> m1 '`monus`' m2 '==' m3+-- 'True'+-- @+--+-- @+-- >>> m1 = f [("a", [0,1,2    ]), ("b", [0,1,2    ]), ("c", [0,1,2    ])]+-- >>> m2 = f [("a", [    2,3,4]), ("b", [  1,2,3,4]), ("c", [0,1,2,3,4])]+-- >>> m3 = f [("a", [0,1      ]), ("b", [0        ]), ("c", [         ])]+-- @+-- @+-- >>> m1 '`monus`' m2 '==' m3+-- 'True'+-- @+--+-- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values, this function+-- performs /truncated/ /subtraction/ of matching values:+--+-- @+-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)]+-- >>> m2 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 0)]+-- >>> m3 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)]+-- @+-- @+-- >>> m1 '`monus`' m2 '==' m3+-- 'True'+-- @+--+-- @+-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)]+-- >>> m2 = 'fromList' [("a", 1), ("b", 1), ("c", 1), ("d", 1)]+-- >>> m3 = 'fromList' [("a", 0), ("b", 0), ("c", 1), ("d", 2)]+-- @+-- @+-- >>> m1 '`monus`' m2 '==' m3+-- 'True'+-- @+--+-- @+-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)]+-- >>> m2 = 'fromList' [("a", 2), ("b", 2), ("c", 2), ("d", 2)]+-- >>> m3 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 1)]+-- @+-- @+-- >>> m1 '`monus`' m2 '==' m3+-- 'True'+-- @+--+-- @+-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)]+-- >>> m2 = 'fromList' [("a", 4), ("b", 4), ("c", 4), ("d", 4)]+-- >>> m3 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 0)]+-- @+-- @+-- >>> m1 '`monus`' m2 '==' m3+-- 'True'+-- @+--+monus+    :: (Ord k, MonoidNull v, Monus v)+    => MonoidMap k v+    -> MonoidMap k v+    -> MonoidMap k v+monus = merge MergeStrategy+    { withNonNullL =+        keepNonNull+        -- Justification:+        --+        -- a      <> (b <\> a     ) ≡ b <> (a      <\> b)+        -- mempty <> (b <\> mempty) ≡ b <> (mempty <\> a)+        --            b <\> mempty  ≡ b <> (mempty <\> a)+        --            b <\> mempty  ≡ b <>  mempty+        --            b <\> mempty  ≡ b++    , withNonNullR =+        keepNull+        -- Justification:+        --+        -- mempty <\> a ≡ mempty++    , withNonNullP =+        withBoth (<\>)+    }+{-# INLINE monus #-}++--------------------------------------------------------------------------------+-- Inversion+--------------------------------------------------------------------------------++-- | Inverts every value in a map.+--+-- Applies the 'Group' method 'C.invert' to every value in a map.+--+-- Satisfies the following property for all possible keys __@k@__:+--+-- @+-- 'get' k ('invert' m) '==' 'C.invert' ('get' k m)+-- @+--+-- This function provides the definition of 'C.invert' for the 'MonoidMap'+-- instance of 'Group'.+--+-- === __Examples__+--+-- With 'Data.Monoid.Sum' 'Integer' values, this function performs negation+-- of values:+--+-- @+-- >>> m1 = 'fromList' [("a", (-1)), ("b", 0), ("c",   1) ]+-- >>> m2 = 'fromList' [("a",   1 ), ("b", 0), ("c", (-1))]+-- @+-- @+-- >>> 'negate' m1 '==' m2+-- 'True'+-- @+--+invert+    :: (MonoidNull v, Group v)+    => MonoidMap k v+    -> MonoidMap k v+invert = map C.invert+{-# INLINE invert #-}++--------------------------------------------------------------------------------+-- Exponentiation+--------------------------------------------------------------------------------++-- | Performs exponentiation of every value in a map.+--+-- Uses the 'Group' exponentiation method 'C.pow' to raise every value in a map+-- to the power of the given exponent.+--+-- Satisfies the following property for all possible keys __@k@__:+--+-- @+-- 'get' k (m '`power`' i) '==' 'get' k m '`C.pow`' i+-- @+--+-- This function provides the definition of 'C.pow' for the 'MonoidMap'+-- instance of 'Group'.+--+-- === __Examples__+--+-- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values, this function+-- performs /ordinary multiplication/ of all values by the given exponent:+--+-- @+-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)]+-- >>> m2 = 'fromList' [("a", 0), ("b", 2), ("c", 4), ("d", 6)]+-- @+-- @+-- >>> m1 '`power`' 2 '==' m2+-- 'True'+-- @+--+-- @+-- >>> m1 = 'fromList' [("a", 0), ("b",   1 ), ("c",   2 ), ("d",   3 )]+-- >>> m2 = 'fromList' [("a", 0), ("b", (-1)), ("c", (-2)), ("d", (-3))]+-- @+-- @+-- >>> m1 '`power`' (-1) '==' m2+-- 'True'+-- @+--+power+    :: (Integral i, MonoidNull v, Group v)+    => MonoidMap k v+    -> i+    -> MonoidMap k v+power m i = map (`C.pow` i) m+{-# INLINE power #-}++--------------------------------------------------------------------------------+-- Intersection+--------------------------------------------------------------------------------++-- | Computes the /intersection/ of a pair of maps using the given function+--   to combine values for matching keys.+--+-- Satisfies the following property for all possible keys __@k@__:+--+-- @+-- 'get' k ('intersectionWith' f m1 m2) '=='+--     if k '`Set.member`'+--         'Set.intersection'+--             ('nonNullKeys' m1)+--             ('nonNullKeys' m2)+--     then f ('get' k m1) ('get' k m2)+--     else 'mempty'+-- @+--+-- === Conditional totality+--+-- /If/ the given combining function __@f@__ /always/ produces 'mempty' when+-- /either/ or /both/ of its arguments are 'mempty':+--+-- @+-- (f v      'mempty' '==' 'mempty') '&&'+-- (f 'mempty' v      '==' 'mempty')+-- @+--+-- /Then/ the following property holds for all possible keys __@k@__:+--+-- @+-- 'get' k ('intersectionWith' f m1 m2) '==' f ('get' k m1) ('get' k m2)+-- @+--+-- === __Examples__+--+-- With the 'Prelude.min' function applied to 'Data.Monoid.Sum'+-- 'Numeric.Natural.Natural' values:+--+-- @+-- >>> m1 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 1)          ]+-- >>> m2 = 'fromList' [          ("b", 1), ("c", 2), ("d", 3), ("e", 4)]+-- >>> m3 = 'fromList' [          ("b", 1), ("c", 2), ("d", 1)          ]+-- @+-- @+-- >>> 'intersectionWith' 'Prelude.min' m1 m2 '==' m3+-- 'True'+-- @+--+intersectionWith+    :: (Ord k, MonoidNull v3)+    => (v1 -> v2 -> v3)+    -- ^ Function with which to combine values for matching keys.+    -> MonoidMap k v1+    -> MonoidMap k v2+    -> MonoidMap k v3+intersectionWith f = merge MergeStrategy+    { withNonNullL =+        keepNull+    , withNonNullR =+        keepNull+    , withNonNullP =+        withBoth f+    }+{-# INLINE intersectionWith #-}++-- | An /applicative/ version of 'intersectionWith'.+--+-- Satisfies the following property:+--+-- @+-- 'runIdentity' ('intersectionWithA' (('fmap' . 'fmap') 'Identity' f) m1 m2)+--          '==' ('intersectionWith'    \    \   \    \  \        \ f  m1 m2)+-- @+--+intersectionWithA+    :: (Applicative f, Ord k, MonoidNull v3)+    => (v1 -> v2 -> f v3)+    -- ^ Function with which to combine values for matching keys.+    -> MonoidMap k v1+    -> MonoidMap k v2+    -> f (MonoidMap k v3)+intersectionWithA f = mergeA MergeStrategy+    { withNonNullL =+        keepNull+    , withNonNullR =+        keepNull+    , withNonNullP =+        withBothA f+    }+{-# INLINE intersectionWithA #-}++--------------------------------------------------------------------------------+-- Union+--------------------------------------------------------------------------------++-- | Computes the /union/ of a pair of maps using the given function to combine+--   values for matching keys.+--+-- Satisfies the following property for all possible keys __@k@__:+--+-- @+-- 'get' k ('unionWith' f m1 m2) '=='+--     if k '`Set.member`'+--         'Set.union'+--             ('nonNullKeys' m1)+--             ('nonNullKeys' m2)+--     then f ('get' k m1) ('get' k m2)+--     else 'mempty'+-- @+--+-- === Conditional totality+--+-- /If/ the given combining function __@f@__ /always/ produces 'mempty' when+-- /both/ of its arguments are 'mempty':+--+-- @+-- f 'mempty' 'mempty' '==' 'mempty'+-- @+--+-- /Then/ the following property holds for all possible keys __@k@__:+--+-- @+-- 'get' k ('unionWith' f m1 m2) '==' f ('get' k m1) ('get' k m2)+-- @+--+-- === __Examples__+--+-- With the 'Prelude.max' function applied to 'Data.Monoid.Sum'+-- 'Numeric.Natural.Natural' values:+--+-- @+-- >>> m1 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 1)          ]+-- >>> m2 = 'fromList' [          ("b", 1), ("c", 2), ("d", 3), ("e", 4)]+-- >>> m3 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 3), ("e", 4)]+-- @+-- @+-- >>> 'unionWith' 'Prelude.max' m1 m2 '==' m3+-- 'True'+-- @+--+unionWith+    :: (Ord k, Monoid v1, Monoid v2, MonoidNull v3)+    => (v1 -> v2 -> v3)+    -- ^ Function with which to combine values for matching keys.+    -> MonoidMap k v1+    -> MonoidMap k v2+    -> MonoidMap k v3+unionWith f = merge MergeStrategy+    { withNonNullL =+        withNonNull (\v -> f v mempty)+    , withNonNullR =+        withNonNull (\v -> f mempty v)+    , withNonNullP =+        withBoth f+    }+{-# INLINE unionWith #-}++-- | An /applicative/ version of 'unionWith'.+--+-- Satisfies the following property:+--+-- @+-- 'runIdentity' ('unionWithA' (('fmap' . 'fmap') 'Identity' f) m1 m2)+--          '==' ('unionWith'    \    \   \    \  \        \ f  m1 m2)+-- @+--+unionWithA+    :: (Applicative f, Ord k, Monoid v1, Monoid v2, MonoidNull v3)+    => (v1 -> v2 -> f v3)+    -- ^ Function with which to combine values for matching keys.+    -> MonoidMap k v1+    -> MonoidMap k v2+    -> f (MonoidMap k v3)+unionWithA f = mergeA MergeStrategy+    { withNonNullL =+        withNonNullA (\v -> f v mempty)+    , withNonNullR =+        withNonNullA (\v -> f mempty v)+    , withNonNullP =+        withBothA f+    }+{-# INLINE unionWithA #-}++--------------------------------------------------------------------------------+-- Merging+--------------------------------------------------------------------------------++type WhenOneSideNull f k          vx                        vr+   = Map.WhenMissing f k (NonNull vx)              (NonNull vr)+type WhenBothNonNull f k          v1           v2           vr+   = Map.WhenMatched f k (NonNull v1) (NonNull v2) (NonNull vr)++data MergeStrategy f k v1 v2 v3 = MergeStrategy+    { withNonNullL :: !(WhenOneSideNull f k v1    v3)+    , withNonNullR :: !(WhenOneSideNull f k    v2 v3)+    , withNonNullP :: !(WhenBothNonNull f k v1 v2 v3)+    }++merge+    :: Ord k+    => MergeStrategy Identity k v1 v2 v3+    -> MonoidMap k v1+    -> MonoidMap k v2+    -> MonoidMap k v3+merge (MergeStrategy nnl nnr nnp) (MonoidMap m1) (MonoidMap m2) =+    MonoidMap $ Map.merge nnl nnr nnp m1 m2+{-# INLINE merge #-}++mergeA+    :: (Applicative f, Ord k)+    => MergeStrategy f k v1 v2 v3+    -> MonoidMap k v1+    -> MonoidMap k v2+    -> f (MonoidMap k v3)+mergeA (MergeStrategy nnl nnr nnp) (MonoidMap m1) (MonoidMap m2) =+    MonoidMap <$> Map.mergeA nnl nnr nnp m1 m2+{-# INLINE mergeA #-}++keepNull+    :: Applicative f+    => WhenOneSideNull f k v1 v2+keepNull = Map.dropMissing+{-# INLINE keepNull #-}++keepNonNull+    :: Applicative f+    => WhenOneSideNull f k v v+keepNonNull = Map.preserveMissing+{-# INLINE keepNonNull #-}++withNonNull+    :: (Applicative f, MonoidNull v2)+    => (v1 -> v2)+    -> WhenOneSideNull f k v1 v2+withNonNull f+    = Map.mapMaybeMissing+    $ \_k v -> maybeNonNull $ applyNonNull f v+{-# INLINE withNonNull #-}++withNonNullA+    :: (Applicative f, MonoidNull v2)+    => (v1 -> f v2)+    -> WhenOneSideNull f k v1 v2+withNonNullA f+    = Map.traverseMaybeMissing+    $ \_k v -> maybeNonNull <$> applyNonNull f v+{-# INLINE withNonNullA #-}++withBoth+    :: (Applicative f, MonoidNull v3)+    => (v1 -> v2 -> v3)+    -> WhenBothNonNull f k v1 v2 v3+withBoth f+    = Map.zipWithMaybeMatched+    $ \_k v1 v2 -> maybeNonNull $ applyNonNull2 f v1 v2+{-# INLINE withBoth #-}++withBothA+    :: (Applicative f, MonoidNull v3)+    => (v1 -> v2 -> f v3)+    -> WhenBothNonNull f k v1 v2 v3+withBothA f+    = Map.zipWithMaybeAMatched+    $ \_k v1 v2 -> maybeNonNull <$> applyNonNull2 f v1 v2+{-# INLINE withBothA #-}
+ src/internal/Data/MonoidMap/Unsafe.hs view
@@ -0,0 +1,50 @@+{-# OPTIONS_GHC -fno-warn-unused-imports #-}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+-- Provides /unsafe/ operations for the 'MonoidMap' type.+--+module Data.MonoidMap.Unsafe+    (+    -- * Construction+      unsafeFromMap+    )+    where++import Prelude++import Data.Coerce+    ( coerce )+import Data.Map.Strict+    ( Map )+import Data.MonoidMap.Internal+    ( MonoidMap (..), NonNull (..), fromMap )++import qualified Data.Foldable as F+import qualified Data.Monoid.Null as Null+import qualified Data.MonoidMap.Internal as Internal++--------------------------------------------------------------------------------+-- Unsafe construction+--------------------------------------------------------------------------------++-- | \(O(1)\). /Unsafely/ constructs a 'MonoidMap' from an ordinary 'Map'.+--+-- Constructs a 'MonoidMap' in /constant time/, without imposing the burden+-- of a canonicalisation step to remove 'null' values.+--+-- When applied to a given 'Map' @m@, this function /expects/ but does /not/+-- check the following pre-condition:+--+-- @+-- 'F.all' ('not' . 'Null.null') m+-- @+--+-- Not satisfying this pre-condition will result in undefined behaviour.+--+-- See 'fromMap' for a safe version of this function.+--+unsafeFromMap :: Map k v -> MonoidMap k v+unsafeFromMap = coerce
+ src/public/Data/MonoidMap.hs view
@@ -0,0 +1,388 @@+{-# OPTIONS_GHC -fno-warn-unused-imports #-}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Data.MonoidMap+    (+    -- * Introduction+    -- $_introduction+    -- $_totality+    -- $_encoding+    -- $_monoidal_operations++    -- * Type+      MonoidMap++    -- * General operations++    -- ** Construction+    , empty+    , fromList+    , fromListWith+    , fromMap+    , singleton++    -- ** Deconstruction+    , toList+    , toMap++    -- ** Lookup+    , get++    -- ** Modification+    , set+    , adjust+    , nullify++    -- ** Membership+    , null+    , nullKey+    , nonNull+    , nonNullCount+    , nonNullKey+    , nonNullKeys++    -- ** Slicing+    , take+    , drop+    , splitAt++    -- ** Filtering+    , filter+    , filterKeys+    , filterWithKey++    -- ** Partitioning+    , partition+    , partitionKeys+    , partitionWithKey++    -- ** Mapping+    , map+    , mapKeys+    , mapKeysWith++    -- * Monoidal operations++    -- | See the section on [monoidal operations](#_monoidal_operations) within+    -- the [introduction](#_introduction).++    -- ** Association+    , append++    -- ** Subtraction+    , minus+    , minusMaybe+    , monus++    -- ** Inversion+    , invert++    -- ** Exponentiation+    , power++    -- ** Comparison+    , isSubmapOf+    , isSubmapOfBy+    , disjoint+    , disjointBy++    -- ** Intersection+    , intersection+    , intersectionWith+    , intersectionWithA++    -- ** Union+    , union+    , unionWith+    , unionWithA++    -- ** Prefixes+    , isPrefixOf+    , stripPrefix+    , commonPrefix+    , stripCommonPrefix++    -- ** Suffixes+    , isSuffixOf+    , stripSuffix+    , commonSuffix+    , stripCommonSuffix++    -- ** Overlap+    , overlap+    , stripPrefixOverlap+    , stripSuffixOverlap+    , stripOverlap+    )+    where++import Data.MonoidMap.Internal++-- Imports for module documentation:++import Data.Eq+    ( Eq (..) )+import Data.Group+    ( Group ((~~)) )+import Data.Map.Strict+    ( Map )+import Data.Maybe+    ( Maybe (Just, Nothing) )+import Data.Monoid+    ( Monoid (mempty) )+import Data.Monoid.GCD+    ( GCDMonoid )+import Data.Monoid.LCM+    ( LCMMonoid )+import Data.Monoid.Monus+    ( Monus ((<\>)) )+import Data.Monoid.Null+    ( MonoidNull )+import Data.Ord+    ( Ord )+import Data.Semigroup+    ( Semigroup ((<>)) )++import qualified Data.Map.Strict as SMap+import qualified Data.MonoidMap.Internal as MMap++import qualified Data.Group as C+import qualified Data.Monoid.GCD as C+import qualified Data.Monoid.LCM as C+import qualified Data.Monoid.Null as C++--------------------------------------------------------------------------------+-- Introduction+--------------------------------------------------------------------------------++-- $_introduction+-- #_introduction#+--+-- This module provides the 'MonoidMap' type, which:+--+--  - models a [__total function__](#_totality) with+--    [__finite support__](https://wikipedia.org/wiki/Support_\(mathematics\))+--    from keys to [__monoidal values__]("Data.Monoid"), with a default value+--    of 'mempty'.+--+--  - encodes key-value mappings with a [__minimal encoding__](#_encoding) that+--    only includes values /not/ equal to 'mempty'.+--+--  - provides a comprehensive set of+--    [__monoidal operations__](#_monoidal_operations) for transforming,+--    combining, and comparing maps.+--+-- The documentation in this module serves as __reference guide__ to the+-- 'MonoidMap' type and its operations.+--+-- See the+-- [@README@](https://github.com/jonathanknowles/monoidmap/blob/main/README.md)+-- file for:+--+--  - a __deeper introduction__ to the design of the 'MonoidMap' type.+--+--  - worked examples of using 'MonoidMap' to implement more specialised+--    monoidal data structures.+--+--  - detailed comparisons between 'MonoidMap' and other map types.++--------------------------------------------------------------------------------+-- Totality+--------------------------------------------------------------------------------++-- $_totality+-- #_totality#+--+-- = Relationship between keys and values+--+-- A 'MonoidMap' of key type __@k@__ and value type __@v@__ associates /every/+-- possible key of type __@k@__ with a value of type __@v@__:+--+-- @+-- 'get' :: ('Ord' k, 'Monoid' v) => k -> 'MonoidMap' k v -> v+-- @+--+-- The 'empty' map associates every key __@k@__ with a default value of+-- 'mempty':+--+-- @+-- ∀ k. 'get' k 'empty' '==' 'mempty'+-- @+--+-- == Comparison with standard 'Map' type+--+-- The 'MonoidMap' type differs from the standard 'Map' type in how it relates+-- keys to values:+--+-- +---------------------------+---------------------------------------------++-- | Type                      | Models a total function with finite support |+-- +===========================+=============================================++-- | @       'Map'@__@ k v @__ | from keys of type __@k@__                   |+-- |                           | to values of type __@'Maybe' v@__.          |+-- +---------------------------+---------------------------------------------++-- | @ 'MonoidMap'@__@ k v @__ | from keys of type __@k@__                   |+-- |                           | to values of type __@v@__.                  |+-- +---------------------------+---------------------------------------------++--+-- This difference can be illustrated by comparing the type signatures of+-- operations to query a key for its value, for both types:+--+-- @+--       'Map'.'SMap.lookup' :: \      \      k ->       'Map' k v -> 'Maybe' v+-- 'MonoidMap'.'MMap.get'    :: 'Monoid' v => k -> 'MonoidMap' k v -> \     \ v+-- @+--+-- Whereas a standard 'Map' has a default value of 'Nothing', a 'MonoidMap' has+-- a default value of 'mempty':+--+-- @+-- ∀ k.       'Map'.'SMap.lookup' k       'Map'.'SMap.empty' '==' 'Nothing'+-- ∀ k. 'MonoidMap'.'MMap.get'    k 'MonoidMap'.'MMap.empty' '==' 'mempty'+-- @+--+-- In practice, the standard 'Map' type uses 'Maybe' to indicate the /presence/+-- or /absence/ of a value for a particular key. This representation is+-- necessary because the 'Map' type imposes no constraints on value types.+--+-- However, /monoidal/ types already have a natural way to represent null or+-- empty values: the 'mempty' constant, which represents the /neutral/ or+-- /identity/ element of a 'Monoid'.+--+-- Consequently, using a standard 'Map' with a /monoidal/ value type gives rise+-- to two distinct representations for null or empty values:+--+-- +-------------------------+--------------------------------------------++-- | @                       |                                            |+-- | 'Map'.'SMap.lookup' k m | Interpretation                             |+-- | @                       |                                            |+-- +=========================+============================================++-- | @                       | 'Map' __@m@__ has /no/ entry               |+-- | 'Nothing'               | for key __@k@__.                           |+-- | @                       |                                            |+-- +-------------------------+--------------------------------------------++-- | @                       | 'Map' __@m@__ has an entry                 |+-- | 'Just' 'mempty'         | for key __@k@__, but the value is /empty/. |+-- | @                       |                                            |+-- +-------------------------+--------------------------------------------++--+-- In constrast, the 'MonoidMap' type provides a single, /canonical/+-- representation for null or empty values, according to the following+-- conceptual mapping:+--+-- +------------------------------------+---+------------------------------++-- | @                                  |   | @                            |+-- | 'Map'.'SMap.lookup' k m            |   | 'MonoidMap'.'MMap.get' k m   |+-- | @                                  |   | @                            |+-- +====================================+===+==============================++-- | @                                  |   | @                            |+-- | 'Nothing'                          | ⟼ | 'mempty'                     |+-- | @                                  |   | @                            |+-- +--------------+---------------------+---+------------------------------++-- | @            | @                   |   | @                            |+-- | 'Just' __v__ | __v__ '==' 'mempty' | ⟼ | 'mempty'                     |+-- | @            | @                   |   | @                            |+-- +--------------+---------------------+---+------------------------------++-- | @            | @                   |   | @                            |+-- | 'Just' __v__ | __v__ '/=' 'mempty' | ⟼ | __v__                        |+-- | @            | @                   |   | @                            |+-- +--------------+---------------------+---+------------------------------+++--------------------------------------------------------------------------------+-- Encoding+--------------------------------------------------------------------------------++-- $_encoding+-- #_encoding#+--+-- = Encoding+--+-- A 'MonoidMap' only encodes mappings from keys to values that are /not/ equal+-- to 'mempty'.+--+-- The total function \(T\) modelled by a 'MonoidMap' is encoded as a+-- __support__ __map__ \(S\), where \(S\) is the finite subset of key-value+-- mappings in \(T\) for which values are not equal to 'mempty' (denoted by+-- \(\varnothing\)):+--+-- \( \quad S = \{ (k, v) \in T \ | \ v \ne \varnothing \} \)+--+-- == Automatic minimisation+--+-- All 'MonoidMap' operations perform __automatic minimisation__ of the support+-- map, so that 'mempty' values do not appear in:+--+--   - any encoding of a 'MonoidMap'+--   - any traversal of a 'MonoidMap'+--+-- == Constraints on values+--+-- 'MonoidMap' operations require the monoidal value type to be an instance of+-- 'MonoidNull'.+--+-- Instances of 'MonoidNull' must provide a 'C.null' indicator function that+-- satisfies the following law:+--+-- @+-- ∀ v. 'MonoidNull'.'C.null' v '==' (v '==' 'mempty')+-- @+--+-- 'MonoidMap' operations use the 'C.null' indicator function to detect and+-- exclude 'mempty' values from the support map.+--+-- Note that it is /not/ generally necessary for the value type to be an+-- instance of 'Eq'.++--------------------------------------------------------------------------------+-- Monoidal operations+--------------------------------------------------------------------------------++-- $_monoidal_operations+-- #_monoidal_operations#+--+-- = Monoidal operations+--+-- The 'MonoidMap' type provides a comprehensive set of __monoidal operations__+-- for transforming, combining, and comparing maps.+--+-- Instances for several __subclasses__ of 'Semigroup' and 'Monoid' are+-- provided, including classes from the following libraries:+--+--  - [groups](https://hackage.haskell.org/package/groups)+--  - [monoid-subclasses](https://hackage.haskell.org/package/monoid-subclasses)+--+-- At the root of this hierarchy of subclasses is the 'Semigroup' class, whose+-- instance for 'MonoidMap' is defined in terms of the /underlying value type/,+-- so that applying `(<>)` to a /pair of maps/ is equivalent to applying `(<>)`+-- to all /pairs of values/ for matching keys:+--+-- @+-- ∀ k. 'get' k (m1 '<>' m2) '==' 'get' k m1 '<>' 'get' k m2+-- @+--+-- In general, operations for subclasses of 'Semigroup' and 'Monoid' are+-- defined /analogously/ to the 'Semigroup' instance, so that:+--+-- - /unary/ operations on /individual maps/ are defined in terms of their+--   distributive application to all values.+--+-- - /binary/ operations on /pairs of maps/ are defined in terms of their+--   distributive application to all /pairs of values/ for matching keys.+--+-- Unary monoidal operations typically satisfy a property similar to:+--+-- @+-- ∀ k. 'get' k (f m) '==' f ('get' k m)+-- @+--+-- Binary monoidal operations typically satisfy a property similar to:+--+-- @+-- ∀ k. 'get' k (f m1 m2) '==' f ('get' k m1) ('get' k m2)+-- @+--+-- Defining monoidal operations in this way makes it possible to transform,+-- combine, and compare maps in ways that are consistent with the algebraic+-- properties of the underlying monoidal value type.
+ src/test/Data/MonoidMap/AccessSpec.hs view
@@ -0,0 +1,165 @@+{- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Use camelCase" -}+{- HLINT ignore "Use null" -}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Data.MonoidMap.AccessSpec+    ( spec+    ) where++import Prelude++import Control.Monad+    ( forM_ )+import Data.Function+    ( (&) )+import Data.MonoidMap+    ( MonoidMap )+import Data.Proxy+    ( Proxy (..) )+import Test.Common+    ( Key, Test, TestType (TestType), makeSpec, property, testTypesMonoidNull )+import Test.Hspec+    ( Spec, describe, it )+import Test.QuickCheck+    ( Fun, Property, applyFun, cover, (===) )++import qualified Data.Monoid.Null as Null+import qualified Data.MonoidMap as MonoidMap+import qualified Data.Set as Set++spec :: Spec+spec = describe "Accessors" $ do++    forM_ testTypesMonoidNull $ \(TestType p) -> specFor (Proxy @Key) p++specFor :: forall k v. Test k v => Proxy k -> Proxy v -> Spec+specFor = makeSpec $ do++    describe "Get" $ do+        it "prop_get_nonNullKey" $+            prop_get_nonNullKey+                @k @v & property+        it "prop_get_nonNullKeys" $+            prop_get_nonNullKeys+                @k @v & property++    describe "Set" $ do+        it "prop_set_get" $+            prop_set_get+                @k @v & property+        it "prop_set_nonNullKey" $+            prop_set_nonNullKey+                @k @v & property+        it "prop_set_nonNullKeys" $+            prop_set_nonNullKeys+                @k @v & property+        it "prop_set_toList" $+            prop_set_toList+                @k @v & property++    describe "Adjust" $ do+        it "prop_adjust_get_set" $+            prop_adjust_get_set+                @k @v & property++--------------------------------------------------------------------------------+-- Get+--------------------------------------------------------------------------------++prop_get_nonNullKey+    :: Test k v => MonoidMap k v -> k -> Property+prop_get_nonNullKey m k =+    MonoidMap.nonNullKey k m === (MonoidMap.get k m /= mempty)+    & cover 2+        (MonoidMap.nonNullKey k m)+        "MonoidMap.nonNullKey k m"+    & cover 2+        (not (MonoidMap.nonNullKey k m))+        "not (MonoidMap.nonNullKey k m)"++prop_get_nonNullKeys+    :: Test k v => MonoidMap k v -> k -> Property+prop_get_nonNullKeys m k =+    Set.member k (MonoidMap.nonNullKeys m) === (MonoidMap.get k m /= mempty)+    & cover 2+        (MonoidMap.nonNullKey k m)+        "MonoidMap.nonNullKey k m"+    & cover 2+        (not (MonoidMap.nonNullKey k m))+        "not (MonoidMap.nonNullKey k m)"++--------------------------------------------------------------------------------+-- Set+--------------------------------------------------------------------------------++prop_set_get+    :: Test k v => MonoidMap k v -> k -> v -> Property+prop_set_get m k v =+    MonoidMap.get k (MonoidMap.set k v m) === v+    & cover 2+        (MonoidMap.nonNullKey k m)+        "MonoidMap.nonNullKey k m"+    & cover 2+        (not (MonoidMap.nonNullKey k m))+        "not (MonoidMap.nonNullKey k m)"++prop_set_nonNullKey+    :: Test k v => MonoidMap k v -> k -> v -> Property+prop_set_nonNullKey m k v =+    MonoidMap.nonNullKey k (MonoidMap.set k v m) ===+        (v /= mempty)+    & cover 2+        (v == mempty)+        "v == mempty"+    & cover 2+        (v /= mempty)+        "v /= mempty"++prop_set_nonNullKeys+    :: Test k v => MonoidMap k v -> k -> v -> Property+prop_set_nonNullKeys m k v =+    Set.member k (MonoidMap.nonNullKeys (MonoidMap.set k v m)) ===+        (v /= mempty)+    & cover 2+        (v == mempty)+        "v == mempty"+    & cover 2+        (v /= mempty)+        "v /= mempty"++prop_set_toList+    :: Test k v => MonoidMap k v -> k -> v -> Property+prop_set_toList m k v =+    filter ((== k) . fst) (MonoidMap.toList (MonoidMap.set k v m)) ===+        [(k, v) | v /= mempty]+    & cover 2+        (v == mempty)+        "v == mempty"+    & cover 2+        (v /= mempty)+        "v /= mempty"++--------------------------------------------------------------------------------+-- Adjust+--------------------------------------------------------------------------------++prop_adjust_get_set+    :: Test k v => MonoidMap k v -> Fun v v -> k -> Property+prop_adjust_get_set m (applyFun -> f) k =+    MonoidMap.adjust f k m === MonoidMap.set k (f (MonoidMap.get k m)) m+    & cover 1+        (MonoidMap.nullKey k m && Null.null (f mempty))+        "MonoidMap.nullKey k m && Null.null (f mempty)"+    & cover 1+        (MonoidMap.nullKey k m && not (Null.null (f mempty)))+        "MonoidMap.nullKey k m && not (Null.null (f mempty))"+    & cover 0.1+        (MonoidMap.nonNullKey k m && Null.null (f (MonoidMap.get k m)))+        "MonoidMap.nonNullKey k m && Null.null (f (MonoidMap.get k m))"+    & cover 0.1+        (MonoidMap.nonNullKey k m && not (Null.null (f (MonoidMap.get k m))))+        "MonoidMap.nonNullKey k m && not (Null.null (f (MonoidMap.get k m)))"
+ src/test/Data/MonoidMap/ClassSpec.hs view
@@ -0,0 +1,369 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Data.MonoidMap.ClassSpec+    where++import Prelude++import Data.Group+    ( Group )+import Data.Maybe+    ( mapMaybe )+import Data.Monoid+    ( Product (..), Sum (..) )+import Data.Monoid.Null+    ( MonoidNull )+import Data.MonoidMap+    ( MonoidMap )+import Data.Proxy+    ( Proxy (..) )+import Data.Semigroup.Cancellative+    ( Commutative )+import Data.Set+    ( Set )+import Data.Typeable+    ( Typeable, typeRep )+import GHC.Exts+    ( IsList (..) )+import Numeric.Natural+    ( Natural )+import Test.Hspec+    ( Spec, describe )+import Test.QuickCheck+    ( Arbitrary (..), listOf, scale, shrinkMapBy, suchThatMap )+import Test.QuickCheck.Classes+    ( eqLaws+    , isListLaws+    , monoidLaws+    , semigroupLaws+    , semigroupMonoidLaws+    , showReadLaws+    )+import Test.QuickCheck.Classes.Group+    ( groupLaws )+import Test.QuickCheck.Classes.Hspec+    ( testLawsMany )+import Test.QuickCheck.Classes.Monoid.GCD+    ( distributiveGCDMonoidLaws+    , gcdMonoidLaws+    , leftDistributiveGCDMonoidLaws+    , leftGCDMonoidLaws+    , overlappingGCDMonoidLaws+    , rightDistributiveGCDMonoidLaws+    , rightGCDMonoidLaws+    )+import Test.QuickCheck.Classes.Monoid.LCM+    ( distributiveLCMMonoidLaws, lcmMonoidLaws )+import Test.QuickCheck.Classes.Monoid.Monus+    ( monusLaws )+import Test.QuickCheck.Classes.Monoid.Null+    ( monoidNullLaws, positiveMonoidLaws )+import Test.QuickCheck.Classes.Semigroup.Cancellative+    ( cancellativeLaws+    , commutativeLaws+    , leftCancellativeLaws+    , leftReductiveLaws+    , reductiveLaws+    , rightCancellativeLaws+    , rightReductiveLaws+    )+import Test.QuickCheck.Instances.Natural+    ()+import Test.QuickCheck.Instances.Text+    ()++import qualified Data.MonoidMap as MonoidMap++spec :: Spec+spec = do+    describe "Class laws" $ do+        -- Test against a variety of key types, in ascending order of+        -- cardinality:+        specLawsFor (Proxy @Bool)+        specLawsFor (Proxy @Ordering)+        specLawsFor (Proxy @Int)+        specLawsFor (Proxy @Integer)++specLawsFor+    :: forall k. () =>+        ( Arbitrary k+        , Ord k+        , Read k+        , Show k+        , Typeable k+        )+    => Proxy k+    -> Spec+specLawsFor keyType = do+    let description = "Class laws for key type " <> show (typeRep keyType)+    describe description $ do+        testLawsMany @(MonoidMap k String)+            [ eqLaws+            , isListLaws+            , leftCancellativeLaws+            , leftDistributiveGCDMonoidLaws+            , leftGCDMonoidLaws+            , leftReductiveLaws+            , monoidLaws+            , monoidNullLaws+            , overlappingGCDMonoidLaws+            , positiveMonoidLaws+            , rightCancellativeLaws+            , rightDistributiveGCDMonoidLaws+            , rightGCDMonoidLaws+            , rightReductiveLaws+            , semigroupLaws+            , semigroupMonoidLaws+            , showReadLaws+            ]+        testLawsMany @(MonoidMap k (Product Integer))+            [ commutativeLaws+            , eqLaws+            , isListLaws+            , leftReductiveLaws+            , monoidLaws+            , monoidNullLaws+            , reductiveLaws+            , rightReductiveLaws+            , semigroupLaws+            , semigroupMonoidLaws+            , showReadLaws+            ]+        testLawsMany @(MonoidMap k (Product Natural))+            [ commutativeLaws+            , distributiveGCDMonoidLaws+            , distributiveLCMMonoidLaws+            , eqLaws+            , gcdMonoidLaws+            , lcmMonoidLaws+            , isListLaws+            , leftDistributiveGCDMonoidLaws+            , leftGCDMonoidLaws+            , leftReductiveLaws+            , monoidLaws+            , monoidNullLaws+            , monusLaws+            , overlappingGCDMonoidLaws+            , positiveMonoidLaws+            , reductiveLaws+            , rightDistributiveGCDMonoidLaws+            , rightGCDMonoidLaws+            , rightReductiveLaws+            , semigroupLaws+            , semigroupMonoidLaws+            , showReadLaws+            ]+        testLawsMany @(MonoidMap k (Wrapped (Product Rational)))+            [ commutativeLaws+            , eqLaws+            , groupLaws+            , isListLaws+            , monoidLaws+            , monoidNullLaws+            , semigroupLaws+            , semigroupMonoidLaws+            , showReadLaws+            ]+        testLawsMany @(MonoidMap k (Sum Integer))+            [ cancellativeLaws+            , commutativeLaws+            , eqLaws+            , groupLaws+            , isListLaws+            , leftCancellativeLaws+            , leftReductiveLaws+            , monoidLaws+            , monoidNullLaws+            , reductiveLaws+            , rightCancellativeLaws+            , rightReductiveLaws+            , semigroupLaws+            , semigroupMonoidLaws+            , showReadLaws+            ]+        testLawsMany @(MonoidMap k (Sum Natural))+            [ cancellativeLaws+            , commutativeLaws+            , distributiveGCDMonoidLaws+            , distributiveLCMMonoidLaws+            , eqLaws+            , gcdMonoidLaws+            , lcmMonoidLaws+            , isListLaws+            , leftCancellativeLaws+            , leftDistributiveGCDMonoidLaws+            , leftGCDMonoidLaws+            , leftReductiveLaws+            , monoidLaws+            , monoidNullLaws+            , monusLaws+            , overlappingGCDMonoidLaws+            , positiveMonoidLaws+            , reductiveLaws+            , rightCancellativeLaws+            , rightDistributiveGCDMonoidLaws+            , rightGCDMonoidLaws+            , rightReductiveLaws+            , semigroupLaws+            , semigroupMonoidLaws+            , showReadLaws+            ]+        testLawsMany @(MonoidMap k (Set ()))+            [ commutativeLaws+            , distributiveGCDMonoidLaws+            , distributiveLCMMonoidLaws+            , eqLaws+            , gcdMonoidLaws+            , lcmMonoidLaws+            , isListLaws+            , leftDistributiveGCDMonoidLaws+            , leftGCDMonoidLaws+            , leftReductiveLaws+            , monoidLaws+            , monoidNullLaws+            , monusLaws+            , overlappingGCDMonoidLaws+            , positiveMonoidLaws+            , reductiveLaws+            , rightDistributiveGCDMonoidLaws+            , rightGCDMonoidLaws+            , rightReductiveLaws+            , semigroupLaws+            , semigroupMonoidLaws+            , showReadLaws+            ]+        testLawsMany @(MonoidMap k (Set k))+            [ commutativeLaws+            , distributiveGCDMonoidLaws+            , distributiveLCMMonoidLaws+            , eqLaws+            , gcdMonoidLaws+            , lcmMonoidLaws+            , isListLaws+            , leftDistributiveGCDMonoidLaws+            , leftGCDMonoidLaws+            , leftReductiveLaws+            , monoidLaws+            , monoidNullLaws+            , monusLaws+            , overlappingGCDMonoidLaws+            , positiveMonoidLaws+            , reductiveLaws+            , rightDistributiveGCDMonoidLaws+            , rightGCDMonoidLaws+            , rightReductiveLaws+            , semigroupLaws+            , semigroupMonoidLaws+            , showReadLaws+            ]+        testLawsMany @(MonoidMap k (Set Ordering))+            [ commutativeLaws+            , distributiveGCDMonoidLaws+            , distributiveLCMMonoidLaws+            , eqLaws+            , gcdMonoidLaws+            , lcmMonoidLaws+            , isListLaws+            , leftDistributiveGCDMonoidLaws+            , leftGCDMonoidLaws+            , leftReductiveLaws+            , monoidLaws+            , monoidNullLaws+            , monusLaws+            , overlappingGCDMonoidLaws+            , positiveMonoidLaws+            , reductiveLaws+            , rightDistributiveGCDMonoidLaws+            , rightGCDMonoidLaws+            , rightReductiveLaws+            , semigroupLaws+            , semigroupMonoidLaws+            , showReadLaws+            ]+        testLawsMany @(MonoidMap k (Set Int))+            [ commutativeLaws+            , distributiveGCDMonoidLaws+            , distributiveLCMMonoidLaws+            , eqLaws+            , gcdMonoidLaws+            , lcmMonoidLaws+            , isListLaws+            , leftDistributiveGCDMonoidLaws+            , leftGCDMonoidLaws+            , leftReductiveLaws+            , monoidLaws+            , monoidNullLaws+            , monusLaws+            , overlappingGCDMonoidLaws+            , positiveMonoidLaws+            , reductiveLaws+            , rightDistributiveGCDMonoidLaws+            , rightGCDMonoidLaws+            , rightReductiveLaws+            , semigroupLaws+            , semigroupMonoidLaws+            , showReadLaws+            ]+        testLawsMany @(MonoidMap k (MonoidMap k (Sum Natural)))+            [ cancellativeLaws+            , commutativeLaws+            , distributiveGCDMonoidLaws+            , distributiveLCMMonoidLaws+            , eqLaws+            , gcdMonoidLaws+            , lcmMonoidLaws+            , isListLaws+            , leftCancellativeLaws+            , leftDistributiveGCDMonoidLaws+            , leftGCDMonoidLaws+            , leftReductiveLaws+            , monoidLaws+            , monoidNullLaws+            , monusLaws+            , overlappingGCDMonoidLaws+            , positiveMonoidLaws+            , reductiveLaws+            , rightCancellativeLaws+            , rightDistributiveGCDMonoidLaws+            , rightGCDMonoidLaws+            , rightReductiveLaws+            , semigroupLaws+            , semigroupMonoidLaws+            , showReadLaws+            ]++--------------------------------------------------------------------------------+-- Arbitrary instances+--------------------------------------------------------------------------------++newtype Wrapped a = Wrapped a+    deriving newtype (Eq, Num, Read, Show, IsList)+    deriving newtype (Semigroup, Commutative, Monoid, MonoidNull, Group)++instance Arbitrary (Wrapped (Product Rational)) where+    -- Here we restrict the generator and shrinker so that they can never+    -- produce zero values, to avoid running into cases of ArithException+    -- caused by operations that may produce zero demoninators:+    arbitrary = Wrapped <$> suchThatMap arbitrary maybeNonZero+    shrink = mapMaybe maybeNonZero . shrink++instance (Arbitrary k, Ord k, Arbitrary v, MonoidNull v) =>+    Arbitrary (MonoidMap k v)+  where+    arbitrary =+        fromList <$> scale (`mod` 16) (listOf ((,) <$> arbitrary <*> arbitrary))+    shrink =+        shrinkMapBy MonoidMap.fromMap MonoidMap.toMap shrink++--------------------------------------------------------------------------------+-- Utilities+--------------------------------------------------------------------------------++maybeNonZero :: (Eq a, Num a) => a -> Maybe a+maybeNonZero p+    | p == 0 = Nothing+    | otherwise = Just p
+ src/test/Data/MonoidMap/ComparisonSpec.hs view
@@ -0,0 +1,278 @@+{- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Use camelCase" -}+{- HLINT ignore "Use null" -}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Data.MonoidMap.ComparisonSpec+    ( spec+    ) where++import Prelude++import Control.Monad+    ( forM_ )+import Data.Function+    ( (&) )+import Data.Maybe+    ( isJust )+import Data.Monoid.Cancellative+    ( Reductive (..) )+import Data.Monoid.GCD+    ( GCDMonoid )+import Data.MonoidMap+    ( MonoidMap )+import Data.Proxy+    ( Proxy (..) )+import Test.Common+    ( Key+    , Test+    , TestType (TestType)+    , makeSpec+    , property+    , testTypesGCDMonoid+    , testTypesMonoidNull+    , testTypesReductive+    )+import Test.Hspec+    ( Spec, describe, it )+import Test.QuickCheck+    ( Fun (..), Property, applyFun2, cover, expectFailure, (.||.), (===) )++import qualified Data.Monoid.GCD as GCDMonoid+    ( GCDMonoid (..) )+import qualified Data.Monoid.Null as Null+    ( MonoidNull (..) )+import qualified Data.MonoidMap as MonoidMap+import qualified Data.Set as Set++spec :: Spec+spec = describe "Comparison" $ do++    forM_ testTypesGCDMonoid $+        \(TestType p) -> specGCDMonoid+            (Proxy @Key) p++    forM_ testTypesReductive $+        \(TestType p) -> specReductive+            (Proxy @Key) p++    forM_ testTypesMonoidNull $+        \(TestType p) -> specMonoidNull+            (Proxy @Key) p++specGCDMonoid+    :: forall k v. (Test k v, GCDMonoid v) => Proxy k -> Proxy v -> Spec+specGCDMonoid = makeSpec $ do+    it "prop_disjoint_gcd" $+        prop_disjoint_gcd+            @k @v & property+    it "prop_disjoint_intersection" $+        prop_disjoint_intersection+            @k @v & property++specReductive+    :: forall k v. (Test k v, Reductive v) => Proxy k -> Proxy v -> Spec+specReductive = makeSpec $ do+    it "prop_isSubmapOf_minusMaybe" $+        prop_isSubmapOf_minusMaybe+            @k @v & property+    it "prop_isSubmapOf_reduce" $+        prop_isSubmapOf_reduce+            @k @v & property++specMonoidNull+    :: forall k v. Test k v => Proxy k -> Proxy v -> Spec+specMonoidNull = makeSpec $ do+    it "prop_disjointBy_get_total" $+        prop_disjointBy_get_total+            @k @v & property+    it "prop_disjointBy_get_total_failure" $+        prop_disjointBy_get_total_failure+            @k @v & property+    it "prop_isSubmapOfBy_get_total" $+        prop_isSubmapOfBy_get_total+            @k @v & property+    it "prop_isSubmapOfBy_get_total_failure" $+        prop_isSubmapOfBy_get_total_failure+            @k @v & property++prop_disjoint_gcd+    :: (Test k v, GCDMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> k+    -> Property+prop_disjoint_gcd m1 m2 k =+    MonoidMap.disjoint m1 m2 ==>+        (Null.null (GCDMonoid.gcd (MonoidMap.get k m1) (MonoidMap.get k m2)))+    & cover 8+        (MonoidMap.disjoint m1 m2)+        "MonoidMap.disjoint m1 m2"+    & cover 8+        (not (MonoidMap.disjoint m1 m2))+        "not (MonoidMap.disjoint m1 m2)"++prop_disjoint_intersection+    :: (Test k v, GCDMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Property+prop_disjoint_intersection m1 m2 =+    MonoidMap.disjoint m1 m2 === (MonoidMap.intersection m1 m2 == mempty)+    & cover 8+        (MonoidMap.disjoint m1 m2)+        "MonoidMap.disjoint m1 m2"+    & cover 8+        (not (MonoidMap.disjoint m1 m2))+        "not (MonoidMap.disjoint m1 m2)"++prop_disjointBy_get_total+    :: Test k v+    => Fun (v, v) Bool+    -> MonoidMap k v+    -> MonoidMap k v+    -> k+    -> Property+prop_disjointBy_get_total (applyFun2 -> f0) m1 m2 k =+    MonoidMap.disjointBy f m1 m2+        ==>+        f (MonoidMap.get k m1) (MonoidMap.get k m2)+    & cover 8+        (m1 /= mempty && m2 /= mempty && MonoidMap.disjointBy f m1 m2)+        "m1 /= mempty && m2 /= mempty && MonoidMap.disjointBy f m1 m2"+    & cover 2+        (keyWithinIntersection)+        "keyWithinIntersection"+    & cover 2+        (not keyWithinIntersection)+        "not keyWithinIntersection"+  where+    keyWithinIntersection =+        k `Set.member` Set.intersection+            (MonoidMap.nonNullKeys m1)+            (MonoidMap.nonNullKeys m2)+    f v1 v2+        | Null.null v1 = True+        | Null.null v2 = True+        | otherwise = f0 v1 v2++prop_disjointBy_get_total_failure+    :: Test k v+    => Fun (v, v) Bool+    -> MonoidMap k v+    -> MonoidMap k v+    -> k+    -> Property+prop_disjointBy_get_total_failure (applyFun2 -> f) m1 m2 k =+    expectFailure $+    MonoidMap.disjointBy f m1 m2+        ==>+        f (MonoidMap.get k m1) (MonoidMap.get k m2)++prop_isSubmapOf_minusMaybe+    :: (Test k v, Reductive v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Property+prop_isSubmapOf_minusMaybe m1 m2 =+    MonoidMap.isSubmapOf m1 m2+        ==> isJust (m2 `MonoidMap.minusMaybe` m1)+    & cover 0.01+        (nonTrivialSubmap)+        "nonTrivialSubmap"+  where+    nonTrivialSubmap =+        MonoidMap.isSubmapOf m1 m2+        && m1 /= mempty+        && m2 /= mempty+        && m1 /= m2++prop_isSubmapOf_reduce+    :: (Test k v, Reductive v)+    => MonoidMap k v+    -> MonoidMap k v+    -> k+    -> Property+prop_isSubmapOf_reduce m1 m2 k =+    MonoidMap.isSubmapOf m1 m2+        ==> isJust (MonoidMap.get k m2 </> MonoidMap.get k m1)+    & cover 0.001+        (nonTrivialSubmap && nonNullKeyL && nonNullKeyR)+        "nonTrivialSubmap && nonNullKeyL && nonNullKeyR"+    & cover 0.001+        (nonTrivialSubmap && nullKeyL && nonNullKeyR)+        "nonTrivialSubmap && nullKeyL && nonNullKeyR"+    & cover 0.001+        (nonTrivialSubmap && nullKeyL && nullKeyR)+        "nonTrivialSubmap && nullKeyL && nullKeyR"+  where+    nonTrivialSubmap =+        MonoidMap.isSubmapOf m1 m2+        && m1 /= mempty+        && m2 /= mempty+        && m1 /= m2+    nonNullKeyL = MonoidMap.nonNullKey k m1+    nonNullKeyR = MonoidMap.nonNullKey k m2+    nullKeyL = MonoidMap.nullKey k m1+    nullKeyR = MonoidMap.nullKey k m2++prop_isSubmapOfBy_get_total+    :: Test k v+    => Fun (v, v) Bool+    -> MonoidMap k v+    -> MonoidMap k v+    -> k+    -> Property+prop_isSubmapOfBy_get_total (applyFun2 -> f0) m1 m2 k =+    MonoidMap.isSubmapOfBy f m1 m2+        ==>+        f (MonoidMap.get k m1) (MonoidMap.get k m2)+    & cover 0.01+        (nonTrivialSubmap && nonNullKeyL && nonNullKeyR)+        "nonTrivialSubmap && nonNullKeyL && nonNullKeyR"+    & cover 0.1+        (nonTrivialSubmap && nullKeyL && nonNullKeyR)+        "nonTrivialSubmap && nullKeyL && nonNullKeyR"+    & cover 0.1+        (nonTrivialSubmap && nonNullKeyL && nullKeyR)+        "nonTrivialSubmap && nonNullKeyL && nullKeyR"+    & cover 0.1+        (nonTrivialSubmap && nullKeyL && nullKeyR)+        "nonTrivialSubmap && nullKeyL && nullKeyR"+  where+    f v1 v2+        | Null.null v1 = True+        | otherwise = f0 v1 v2+    nonTrivialSubmap =+        MonoidMap.isSubmapOfBy f m1 m2+        && m1 /= mempty+        && m2 /= mempty+        && m1 /= m2+    nonNullKeyL = MonoidMap.nonNullKey k m1+    nonNullKeyR = MonoidMap.nonNullKey k m2+    nullKeyL = MonoidMap.nullKey k m1+    nullKeyR = MonoidMap.nullKey k m2++prop_isSubmapOfBy_get_total_failure+    :: Test k v+    => Fun (v, v) Bool+    -> MonoidMap k v+    -> MonoidMap k v+    -> k+    -> Property+prop_isSubmapOfBy_get_total_failure (applyFun2 -> f) m1 m2 k =+    expectFailure $+    MonoidMap.isSubmapOfBy f m1 m2+        ==>+        f (MonoidMap.get k m1) (MonoidMap.get k m2)++--------------------------------------------------------------------------------+-- Utilities+--------------------------------------------------------------------------------++infixr 3 ==>+(==>) :: Bool -> Bool -> Property+a ==> b = not a .||. b
+ src/test/Data/MonoidMap/ConversionSpec.hs view
@@ -0,0 +1,188 @@+{- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Use camelCase" -}+{- HLINT ignore "Use null" -}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Data.MonoidMap.ConversionSpec+    ( spec+    ) where++import Prelude++import Control.Monad+    ( forM_ )+import Data.Function+    ( (&) )+import Data.Map.Strict+    ( Map )+import Data.MonoidMap+    ( MonoidMap, nonNullCount )+import Data.Proxy+    ( Proxy (..) )+import Test.Common+    ( Key, Test, TestType (TestType), makeSpec, property, testTypesMonoidNull )+import Test.Hspec+    ( Spec, describe, it )+import Test.QuickCheck+    ( Fun (..), Property, applyFun2, cover, (===) )++import qualified Data.Foldable as F+import qualified Data.List as List+import qualified Data.List.NonEmpty as NE+import qualified Data.Map.Strict as Map+import qualified Data.MonoidMap as MonoidMap++spec :: Spec+spec = describe "Conversions" $ do++    forM_ testTypesMonoidNull $ \(TestType p) -> specFor (Proxy @Key) p++specFor :: forall k v. Test k v => Proxy k -> Proxy v -> Spec+specFor = makeSpec $ do++    describe "Conversion to and from lists" $ do+        it "prop_fromList_get" $+            prop_fromList_get+                @k @v & property+        it "prop_fromList_toMap" $+            prop_fromList_toMap+                @k @v & property+        it "prop_fromList_toList" $+            prop_fromList_toList+                @k @v & property+        it "prop_toList_fromList" $+            prop_toList_fromList+                @k @v & property+        it "prop_toList_sort" $+            prop_toList_sort+                @k @v & property+        it "prop_fromListWith_get" $+            prop_fromListWith_get+                @k @v & property++    describe "Conversion to and from ordinary maps" $ do+        it "prop_fromMap_toMap" $+            prop_fromMap_toMap+                @k @v & property+        it "prop_toMap_fromMap" $+            prop_toMap_fromMap+                @k @v & property++--------------------------------------------------------------------------------+-- Conversion to and from lists+--------------------------------------------------------------------------------++prop_fromList_get+    :: Test k v => [(k, v)] -> k -> Property+prop_fromList_get kvs k =+    MonoidMap.get k (MonoidMap.fromList kvs)+        ===+        F.foldMap snd (filter ((== k) . fst) kvs)+    & cover 2+        (matchingKeyCount == 0)+        "matchingKeyCount == 0"+    & cover 2+        (matchingKeyCount == 1)+        "matchingKeyCount == 1"+    & cover 2+        (matchingKeyCount == 2)+        "matchingKeyCount == 2"+    & cover 2+        (matchingKeyCount >= 3)+        "matchingKeyCount >= 3"+  where+    matchingKeyCount =+        length $ filter ((== k) . fst) kvs++prop_fromList_toMap+    :: Test k v => [(k, v)] -> Property+prop_fromList_toMap kvs =+    MonoidMap.toMap m === Map.filter (/= mempty) o+    & cover 2+        (MonoidMap.nonNull m && nonNullCount m /= Map.size o)+        "MonoidMap.nonNull m && nonNullCount m /= Map.size o"+    & cover 2+        (MonoidMap.nonNull m && nonNullCount m == Map.size o)+        "MonoidMap.nonNull m && nonNullCount m == Map.size o"+  where+    m = MonoidMap.fromList kvs+    o = Map.fromListWith (flip (<>)) kvs++prop_fromList_toList+    :: Test k v => [(k, v)] -> Property+prop_fromList_toList kvs =+    MonoidMap.toList m === Map.toList (Map.filter (/= mempty) o)+    & cover 2+        (MonoidMap.nonNull m && nonNullCount m /= Map.size o)+        "MonoidMap.nonNull m && nonNullCount m /= Map.size o"+    & cover 2+        (MonoidMap.nonNull m && nonNullCount m == Map.size o)+        "MonoidMap.nonNull m && nonNullCount m == Map.size o"+  where+    m = MonoidMap.fromList kvs+    o = Map.fromListWith (flip (<>)) kvs++prop_toList_fromList+    :: Test k v => MonoidMap k v -> Property+prop_toList_fromList m =+    MonoidMap.fromList (MonoidMap.toList m) === m+    & cover 2+        (MonoidMap.nonNull m)+        "MonoidMap.nonNull m"++prop_toList_sort+    :: Test k v => MonoidMap k v -> Property+prop_toList_sort m =+    List.sortOn fst (MonoidMap.toList m) === MonoidMap.toList m+    & cover 2+        (MonoidMap.nonNull m)+        "MonoidMap.nonNull m"++prop_fromListWith_get+    :: Test k v => Fun (v, v) v -> [(k, v)] -> k -> Property+prop_fromListWith_get (applyFun2 -> f) kvs k =+    MonoidMap.get k (MonoidMap.fromListWith f kvs)+        ===+        maybe mempty+            (F.foldl1 f)+            (NE.nonEmpty (snd <$> filter ((== k) . fst) kvs))+    & cover 2+        (matchingKeyCount == 0)+        "matchingKeyCount == 0"+    & cover 2+        (matchingKeyCount == 1)+        "matchingKeyCount == 1"+    & cover 2+        (matchingKeyCount == 2)+        "matchingKeyCount == 2"+    & cover 2+        (matchingKeyCount >= 3)+        "matchingKeyCount >= 3"+  where+    matchingKeyCount =+        length $ filter ((== k) . fst) kvs++--------------------------------------------------------------------------------+-- Conversion to and from ordinary maps+--------------------------------------------------------------------------------++prop_fromMap_toMap+    :: Test k v => Map k v -> Property+prop_fromMap_toMap o =+    MonoidMap.toMap m === Map.filter (/= mempty) o+    & cover 2+        (MonoidMap.nonNull m && nonNullCount m /= Map.size o)+        "MonoidMap.nonNull m && nonNullCount m /= Map.size o"+    & cover 2+        (MonoidMap.nonNull m && nonNullCount m == Map.size o)+        "MonoidMap.nonNull m && nonNullCount m == Map.size o"+  where+    m = MonoidMap.fromMap o++prop_toMap_fromMap+    :: Test k v => MonoidMap k v -> Property+prop_toMap_fromMap m =+    MonoidMap.fromMap (MonoidMap.toMap m) === m
+ src/test/Data/MonoidMap/DistributivitySpec.hs view
@@ -0,0 +1,230 @@+{-# LANGUAGE RankNTypes #-}+{- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Use camelCase" -}+{- HLINT ignore "Use null" -}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Data.MonoidMap.DistributivitySpec+    ( spec+    ) where++import Prelude++import Control.Monad+    ( forM_ )+import Data.Data+    ( typeRep )+import Data.Function+    ( (&) )+import Data.Maybe+    ( isJust )+import Data.MonoidMap+    ( MonoidMap, get )+import Data.Proxy+    ( Proxy (..) )+import Test.Common+    ( Key+    , Test+    , TestType (..)+    , TestValue+    , property+    , testTypesGCDMonoid+    , testTypesGroup+    , testTypesLCMMonoid+    , testTypesLeftGCDMonoid+    , testTypesLeftReductive+    , testTypesMonoidNull+    , testTypesMonus+    , testTypesOverlappingGCDMonoid+    , testTypesReductive+    , testTypesRightGCDMonoid+    , testTypesRightReductive+    )+import Test.Hspec+    ( Spec, describe, it )+import Test.QuickCheck+    ( Property, cover, (===) )++import qualified Data.Group as Group+    ( Group (..) )+import qualified Data.Monoid.GCD as LeftGCDMonoid+    ( LeftGCDMonoid (..) )+import qualified Data.Monoid.GCD as RightGCDMonoid+    ( RightGCDMonoid (..) )+import qualified Data.Monoid.GCD as OverlappingGCDMonoid+    ( OverlappingGCDMonoid (..) )+import qualified Data.Monoid.GCD as GCDMonoid+    ( GCDMonoid (..) )+import qualified Data.Monoid.LCM as LCMMonoid+    ( LCMMonoid (..) )+import qualified Data.Monoid.Monus as Monus+    ( Monus (..) )+import qualified Data.Semigroup as Semigroup+    ( Semigroup (..) )+import qualified Data.Semigroup.Cancellative as LeftReductive+    ( LeftReductive (..) )+import qualified Data.Semigroup.Cancellative as RightReductive+    ( RightReductive (..) )+import qualified Data.Semigroup.Cancellative as Reductive+    ( Reductive (..) )++spec :: Spec+spec = do+    specDistributiveGet+    specDistributiveGetMaybe++specDistributiveGet :: Spec+specDistributiveGet = do+    specForAll+        testTypesMonoidNull+        "Semigroup.<>"+        (Semigroup.<>)+        (Semigroup.<>)+    specForAll+        testTypesLeftGCDMonoid+        "LeftGCDMonoid.commonPrefix"+        (LeftGCDMonoid.commonPrefix)+        (LeftGCDMonoid.commonPrefix)+    specForAll+        testTypesRightGCDMonoid+        "RightGCDMonoid.commonSuffix"+        (RightGCDMonoid.commonSuffix)+        (RightGCDMonoid.commonSuffix)+    specForAll+        testTypesOverlappingGCDMonoid+        "OverlappingGCDMonoid.overlap"+        (OverlappingGCDMonoid.overlap)+        (OverlappingGCDMonoid.overlap)+    specForAll+        testTypesGCDMonoid+        "GCDMonoid.gcd"+        (GCDMonoid.gcd)+        (GCDMonoid.gcd)+    specForAll+        testTypesLCMMonoid+        "LCMMonoid.lcm"+        (LCMMonoid.lcm)+        (LCMMonoid.lcm)+    specForAll+        testTypesGroup+        "Group.minus"+        (Group.~~)+        (Group.~~)+    specForAll+        testTypesMonus+        "Monus.monus"+        (Monus.<\>)+        (Monus.<\>)+  where+    specForAll+        :: [TestType c]+        -> String+        -> (forall k v m. (Test k v, c v, m ~ MonoidMap k v) => (m -> m -> m))+        -> (forall v. (TestValue v, c v) => (v -> v -> v))+        -> Spec+    specForAll testTypes funName f g =+        describe description $ forM_ testTypes $ specFor f g+      where+        description = "Distributivity of 'get' with '" <> funName <> "'"++    specFor+        :: (forall k v m. (Test k v, c v, m ~ MonoidMap k v) => (m -> m -> m))+        -> (forall v. (TestValue v, c v) => (v -> v -> v))+        -> TestType c+        -> Spec+    specFor f g (TestType (_ :: Proxy v)) =+        it description $ property $ propDistributiveGet @Key @v f g+      where+        description = show $ typeRep $ Proxy @(MonoidMap Key v)++specDistributiveGetMaybe :: Spec+specDistributiveGetMaybe = do+    specForAll+        testTypesLeftReductive+        "LeftReductive.stripPrefix"+        (LeftReductive.stripPrefix)+        (LeftReductive.stripPrefix)+    specForAll+        testTypesRightReductive+        "RightReductive.stripSuffix"+        (RightReductive.stripSuffix)+        (RightReductive.stripSuffix)+    specForAll+        testTypesReductive+        "Reductive.minusMaybe"+        (Reductive.</>)+        (Reductive.</>)+  where+    specForAll+        :: [TestType c]+        -> String+        -> (forall k v m. (Test k v, c v, m ~ MonoidMap k v)+            => (m -> m -> Maybe m))+        -> (forall v. (TestValue v, c v)+            => (v -> v -> Maybe v))+        -> Spec+    specForAll testTypes funName f g =+        describe description $ forM_ testTypes $ specFor f g+      where+        description = "Distributivity of 'get' with '" <> funName <> "'"++    specFor+        :: (forall k v m. (Test k v, c v, m ~ MonoidMap k v)+            => (m -> m -> Maybe m))+        -> (forall v. (TestValue v, c v)+            => (v -> v -> Maybe v))+        -> TestType c+        -> Spec+    specFor f g (TestType (_ :: Proxy v)) =+        it description $ property $ propDistributiveGetMaybe @Key @v f g+      where+        description = show $ typeRep $ Proxy @(MonoidMap Key v)++propDistributiveGet+    :: Test k v+    => (MonoidMap k v -> MonoidMap k v -> MonoidMap k v)+    -> (v -> v -> v)+    -> k+    -> MonoidMap k v+    -> MonoidMap k v+    -> Property+propDistributiveGet f g k m1 m2 =+    get k (f m1 m2) === g (get k m1) (get k m2)+    & cover 2+        (get k (f m1 m2) == mempty)+        "get k (f m1 m2) == mempty"+    & cover 2+        (get k (f m1 m2) /= mempty)+        "get k (f m1 m2) /= mempty"+    & cover 2+        (get k m1 == mempty && get k m2 == mempty)+        "get k m1 == mempty && get k m2 == mempty"+    & cover 2+        (get k m1 == mempty && get k m2 /= mempty)+        "get k m1 == mempty && get k m2 /= mempty"+    & cover 2+        (get k m1 /= mempty && get k m2 == mempty)+        "get k m1 /= mempty && get k m2 == mempty"+    & cover 2+        (get k m1 /= mempty && get k m2 /= mempty)+        "get k m1 /= mempty && get k m2 /= mempty"++propDistributiveGetMaybe+    :: Test k v+    => (MonoidMap k v -> MonoidMap k v -> Maybe (MonoidMap k v))+    -> (v -> v -> Maybe v)+    -> k+    -> MonoidMap k v+    -> MonoidMap k v+    -> Property+propDistributiveGetMaybe f g k m1 m2 = property $+    all (\m -> g (get k m1) (get k m2) == Just (get k m)) (f m1 m2)+    & cover 2+        (isJust (f m1 m2) && g (get k m1) (get k m2) == Just mempty)+        "isJust (f m1 m2) && g (get k m1) (get k m2) == Just mempty"+    & cover 2+        (isJust (f m1 m2) && g (get k m1) (get k m2) /= Just mempty)+        "isJust (f m1 m2) && g (get k m1) (get k m2) /= Just mempty"
+ src/test/Data/MonoidMap/ExampleSpec.hs view
@@ -0,0 +1,1740 @@+{-# LANGUAGE OverloadedLists #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Use camelCase" -}+{- HLINT ignore "Use null" -}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Data.MonoidMap.ExampleSpec+    where++import Prelude hiding+    ( gcd, lcm )++import Data.Function+    ( (&) )+import Data.Group+    ( Group (..) )+import Data.Monoid+    ( Product (..), Sum (..) )+import Data.Monoid.GCD+    ( GCDMonoid (..), LeftGCDMonoid (..), RightGCDMonoid (..) )+import Data.Monoid.LCM+    ( LCMMonoid (..) )+import Data.Monoid.Monus+    ( OverlappingGCDMonoid (..), (<\>) )+import Data.MonoidMap+    ( MonoidMap )+import Data.Ratio+    ( (%) )+import Data.Semigroup.Cancellative+    ( LeftReductive (..), RightReductive (..) )+import Data.Set+    ( Set )+import Numeric.Natural+    ( Natural )+import Test.Hspec+    ( Spec, describe )+import Test.Hspec.Unit+    ( UnitTestData1+    , UnitTestData2+    , unitTestData1+    , unitTestData2+    , unitTestSpec+    )+import Test.QuickCheck.Instances.Natural+    ()+import Test.QuickCheck.Instances.Text+    ()++import qualified Data.MonoidMap as MonoidMap+import qualified Data.Set as Set++spec :: Spec+spec = describe "Examples" $ do++    describe "Conversion" $ do++        exampleSpec_fromList_String+        exampleSpec_toList_String++    describe "Comparison" $ do++        exampleSpec_isSubmapOf_Sum_Natural+        exampleSpec_disjoint_Product_Natural+        exampleSpec_disjoint_Sum_Natural+        exampleSpec_disjoint_Set_Natural++    describe "Intersection" $ do++        exampleSpec_intersectionWith_min_Sum_Natural++    describe "Union" $ do++        exampleSpec_unionWith_max_Sum_Natural++    describe "Semigroup" $ do++        exampleSpec_Semigroup_mappend_String+        exampleSpec_Semigroup_mappend_Sum_Natural++    describe "Group" $ do++        exampleSpec_Group_invert_Product_Rational+        exampleSpec_Group_invert_Sum_Integer+        exampleSpec_Group_pow_Product_Rational+        exampleSpec_Group_pow_Sum_Integer+        exampleSpec_Group_subtract_Product_Rational+        exampleSpec_Group_subtract_Sum_Integer++    describe "Reductive" $ do++        exampleSpec_Reductive_isPrefixOf_String+        exampleSpec_Reductive_isPrefixOf_Sum_Natural+        exampleSpec_Reductive_isSuffixOf_String+        exampleSpec_Reductive_isSuffixOf_Sum_Natural+        exampleSpec_Reductive_stripPrefix_String+        exampleSpec_Reductive_stripPrefix_Sum_Natural+        exampleSpec_Reductive_stripSuffix_String+        exampleSpec_Reductive_stripSuffix_Sum_Natural++    describe "LeftGCDMonoid" $ do++        exampleSpec_LeftGCDMonoid_commonPrefix_String+        exampleSpec_LeftGCDMonoid_commonPrefix_Sum_Natural+        exampleSpec_LeftGCDMonoid_stripCommonPrefix_String+        exampleSpec_LeftGCDMonoid_stripCommonPrefix_Sum_Natural++    describe "RightGCDMonoid" $ do++        exampleSpec_RightGCDMonoid_commonSuffix_String+        exampleSpec_RightGCDMonoid_commonSuffix_Sum_Natural+        exampleSpec_RightGCDMonoid_stripCommonSuffix_String+        exampleSpec_RightGCDMonoid_stripCommonSuffix_Sum_Natural++    describe "OverlappingGCDMonoid" $ do++        exampleSpec_OverlappingGCDMonoid_overlap_String+        exampleSpec_OverlappingGCDMonoid_overlap_Sum_Natural+        exampleSpec_OverlappingGCDMonoid_stripPrefixOverlap_String+        exampleSpec_OverlappingGCDMonoid_stripPrefixOverlap_Sum_Natural+        exampleSpec_OverlappingGCDMonoid_stripSuffixOverlap_String+        exampleSpec_OverlappingGCDMonoid_stripSuffixOverlap_Sum_Natural++    describe "GCDMonoid" $ do++        exampleSpec_GCDMonoid_gcd_Product_Natural+        exampleSpec_GCDMonoid_gcd_Sum_Natural+        exampleSpec_GCDMonoid_gcd_Set_Natural++    describe "LCMMonoid" $ do++        exampleSpec_LCMMonoid_lcm_Product_Natural+        exampleSpec_LCMMonoid_lcm_Sum_Natural+        exampleSpec_LCMMonoid_lcm_Set_Natural++    describe "Monus" $ do++        exampleSpec_Monus_monus_Set_Natural+        exampleSpec_Monus_monus_Sum_Natural++--------------------------------------------------------------------------------+-- Conversion+--------------------------------------------------------------------------------++exampleSpec_fromList_String :: Spec+exampleSpec_fromList_String = unitTestSpec+    "MonoidMap.fromList (String)"+    "MonoidMap.fromList"+    (MonoidMap.fromList)+    (exampleData_fromList_String)++exampleData_fromList_String :: UnitTestData1+    [(Int, String)]+    (MonoidMap Int String)+exampleData_fromList_String = unitTestData1+    [ ( [(1, "a"), (2, "x"), (1, "b"), (2, "y"), (1, "c"), (2, "z")]+      , [(1, "abc"), (2, "xyz")]+      )+    ]++exampleSpec_toList_String :: Spec+exampleSpec_toList_String = unitTestSpec+    "MonoidMap.toList (String)"+    "MonoidMap.toList"+    (MonoidMap.toList)+    (exampleData_toList_String)++exampleData_toList_String :: UnitTestData1+    (MonoidMap Int String)+    [(Int, String)]+exampleData_toList_String = unitTestData1+    [ ( [(3, "z"), (2, "y"), (1, "x")]+      , [(1, "x"), (2, "y"), (3, "z")]+      )+    ]++--------------------------------------------------------------------------------+-- Comparison+--------------------------------------------------------------------------------++exampleSpec_isSubmapOf_Sum_Natural :: Spec+exampleSpec_isSubmapOf_Sum_Natural = unitTestSpec+    "MonoidMap.isSubmapOf (Sum Natural)"+    "MonoidMap.isSubmapOf"+    (MonoidMap.isSubmapOf)+    (exampleData_isSubmapOf_Sum_Natural)++exampleData_isSubmapOf_Sum_Natural :: UnitTestData2+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+    (Bool)+exampleData_isSubmapOf_Sum_Natural = unitTestData2+    [ ( m [0, 1, 2, 3]+      , m [4, 4, 4, 4]+      , True+      )+    , ( m [0, 1, 2, 3]+      , m [0, 4, 4, 4]+      , True+      )+    , ( m [0, 1, 2, 3]+      , m [0, 1, 4, 4]+      , True+      )+    , ( m [0, 1, 2, 3]+      , m [0, 1, 2, 4]+      , True+      )+    , ( m [0, 1, 2, 3]+      , m [0, 1, 2, 3]+      , True+      )+    , ( m [0, 1, 2, 3]+      , m [0, 0, 2, 3]+      , False+      )+    , ( m [0, 1, 2, 3]+      , m [0, 1, 1, 3]+      , False+      )+    , ( m [0, 1, 2, 3]+      , m [0, 1, 2, 2]+      , False+      )+    , ( m [0, 1, 2, 3]+      , m [0, 0, 0, 0]+      , False+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_disjoint_Product_Natural :: Spec+exampleSpec_disjoint_Product_Natural = unitTestSpec+    "MonoidMap.disjoint (Product Natural)"+    "MonoidMap.disjoint"+    (MonoidMap.disjoint)+    (exampleData_disjoint_Product_Natural)++exampleData_disjoint_Product_Natural :: UnitTestData2+    (MonoidMap LatinChar (Product Natural))+    (MonoidMap LatinChar (Product Natural))+    (Bool)+exampleData_disjoint_Product_Natural = unitTestData2+    [ ( m []+      , m []+      , True+      )+    , ( m [2, 3, 5, 7]+      , m [3, 5, 7, 2]+      , True+      )+    , ( m [2 * 3, 5 * 7]+      , m [5 * 7, 2 * 3]+      , True+      )+    , ( m [2 * 3    , 3 * 5    ]+      , m [    3 * 5,     5 * 7]+      , False+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_disjoint_Sum_Natural :: Spec+exampleSpec_disjoint_Sum_Natural = unitTestSpec+    "MonoidMap.disjoint (Sum Natural)"+    "MonoidMap.disjoint"+    (MonoidMap.disjoint)+    (exampleData_disjoint_Sum_Natural)++exampleData_disjoint_Sum_Natural :: UnitTestData2+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+    (Bool)+exampleData_disjoint_Sum_Natural = unitTestData2+    [ ( m []+      , m []+      , True+      )+    , ( m [0, 1, 0, 1]+      , m [1, 0, 1, 0]+      , True+      )+    , ( m [0, 8, 0, 8]+      , m [8, 0, 8, 0]+      , True+      )+    , ( m [0, 8, 0, 8]+      , m [8, 0, 8, 1]+      , False+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_disjoint_Set_Natural :: Spec+exampleSpec_disjoint_Set_Natural = unitTestSpec+    "MonoidMap.disjoint (Set Natural)"+    "MonoidMap.disjoint"+    (MonoidMap.disjoint)+    (exampleData_disjoint_Set_Natural)++exampleData_disjoint_Set_Natural :: UnitTestData2+    (MonoidMap LatinChar (Set Natural))+    (MonoidMap LatinChar (Set Natural))+    (Bool)+exampleData_disjoint_Set_Natural = unitTestData2+    [ ( m []+      , m []+      , True+      )+    , ( m [[1], [2], [3], [4]]+      , m [[5], [6], [7], [8]]+      , True+      )+    , ( m [[1, 2], [3, 4]]+      , m [[5, 6], [7, 8]]+      , True+      )+    , ( m [[1, 2   ], [3, 4   ]]+      , m [[   2, 3], [   4, 5]]+      , False+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..] . fmap Set.fromList++--------------------------------------------------------------------------------+-- Intersection+--------------------------------------------------------------------------------++exampleSpec_intersectionWith_min_Sum_Natural :: Spec+exampleSpec_intersectionWith_min_Sum_Natural = unitTestSpec+    "MonoidMap.intersectionWith (Sum Natural)"+    "MonoidMap.intersectionWith"+    (MonoidMap.intersectionWith min)+    (exampleData_intersectionWith_min_Sum_Natural)++exampleData_intersectionWith_min_Sum_Natural :: UnitTestData2+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+exampleData_intersectionWith_min_Sum_Natural = unitTestData2+    [ ( m [0, 1, 2, 3, 4, 5, 6, 7]+      , m [7, 6, 5, 4, 3, 2, 1, 0]+      , m [0, 1, 2, 3, 3, 2, 1, 0]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++--------------------------------------------------------------------------------+-- Union+--------------------------------------------------------------------------------++exampleSpec_unionWith_max_Sum_Natural :: Spec+exampleSpec_unionWith_max_Sum_Natural = unitTestSpec+    "MonoidMap.unionWith (Sum Natural)"+    "MonoidMap.unionWith"+    (MonoidMap.unionWith max)+    (exampleData_unionWith_max_Sum_Natural)++exampleData_unionWith_max_Sum_Natural :: UnitTestData2+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+exampleData_unionWith_max_Sum_Natural = unitTestData2+    [ ( m [0, 1, 2, 3, 4, 5, 6, 7]+      , m [7, 6, 5, 4, 3, 2, 1, 0]+      , m [7, 6, 5, 4, 4, 5, 6, 7]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++--------------------------------------------------------------------------------+-- Semigroup+--------------------------------------------------------------------------------++exampleSpec_Semigroup_mappend_String :: Spec+exampleSpec_Semigroup_mappend_String = unitTestSpec+    "Semigroup.mappend (String)"+    "mappend"+    (mappend)+    (exampleData_Semigroup_concat_String)++exampleData_Semigroup_concat_String :: UnitTestData2+    (MonoidMap LatinChar String)+    (MonoidMap LatinChar String)+    (MonoidMap LatinChar String)+exampleData_Semigroup_concat_String = unitTestData2+    [ ( m ["abc", "ij" , "p"  , ""   ]+      , m [   "",   "k",  "qr", "xyz"]+      , m ["abc", "ijk", "pqr", "xyz"]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_Semigroup_mappend_Sum_Natural :: Spec+exampleSpec_Semigroup_mappend_Sum_Natural = unitTestSpec+    "Semigroup.mappend (Sum Natural)"+    "mappend"+    (mappend)+    (exampleData_Semigroup_concat_Sum_Natural)++exampleData_Semigroup_concat_Sum_Natural :: UnitTestData2+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+exampleData_Semigroup_concat_Sum_Natural = unitTestData2+    [ ( m [4, 2, 1, 0]+      , m [0, 1, 2, 4]+      , m [4, 3, 3, 4]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++--------------------------------------------------------------------------------+-- Group+--------------------------------------------------------------------------------++exampleSpec_Group_invert_Product_Rational :: Spec+exampleSpec_Group_invert_Product_Rational = unitTestSpec+    "Group.invert (Product Rational)"+    "invert"+    (invert)+    (exampleData_Group_invert_Product_Rational)++exampleData_Group_invert_Product_Rational :: UnitTestData1+    (MonoidMap LatinChar (Product Rational))+    (MonoidMap LatinChar (Product Rational))+exampleData_Group_invert_Product_Rational = unitTestData1+    [ ( m [  2,   4,   8,   16]+      , m [1%2, 1%4, 1%8, 1%16]+      )+    , ( m [1%2, 1%4, 1%8, 1%16]+      , m [  2,   4,   8,   16]+      )+    , ( m [  2, 1%4,   8,   16]+      , m [1%2,   4, 1%8, 1%16]+      )+    , ( m [1%2,   4, 1%8, 1%16]+      , m [  2, 1%4,   8,   16]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..] . fmap Product++exampleSpec_Group_invert_Sum_Integer :: Spec+exampleSpec_Group_invert_Sum_Integer = unitTestSpec+    "Group.invert (Sum Integer)"+    "invert"+    (invert)+    (exampleData_Group_invert_Sum_Integer)++exampleData_Group_invert_Sum_Integer :: UnitTestData1+    (MonoidMap LatinChar (Sum Integer))+    (MonoidMap LatinChar (Sum Integer))+exampleData_Group_invert_Sum_Integer = unitTestData1+    [ ( m [ 1,  2,  3,  4]+      , m [-1, -2, -3, -4]+      )+    , ( m [-1, -2, -3, -4]+      , m [ 1,  2,  3,  4]+      )+    , ( m [ 1, -2,  3, -4]+      , m [-1,  2, -3,  4]+      )+    , ( m [-1,  2, -3,  4]+      , m [ 1, -2,  3, -4]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..] . fmap Sum++exampleSpec_Group_pow_Product_Rational :: Spec+exampleSpec_Group_pow_Product_Rational = unitTestSpec+    "Group.pow (Product Rational)"+    "pow"+    (pow)+    (exampleData_Group_pow_Product_Rational)++exampleData_Group_pow_Product_Rational :: UnitTestData2+    (MonoidMap LatinChar (Product Rational))+    (Integer)+    (MonoidMap LatinChar (Product Rational))+exampleData_Group_pow_Product_Rational = unitTestData2+    [ ( m [  2,   -4,   8,   -16], (-1)+      , m [1%2, -1%4, 1%8, -1%16]+      )+    , ( m [  2,   -4,   8,   -16], 0+      , m [  1,    1,   1,     1]+      )+    , ( m [  2,   -4,   8,   -16], 1+      , m [  2,   -4,   8,   -16]+      )+    , ( m [  2,   -4,   8,   -16], 2+      , m [  4,   16,  64,   256]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..] . fmap Product++exampleSpec_Group_pow_Sum_Integer :: Spec+exampleSpec_Group_pow_Sum_Integer = unitTestSpec+    "Group.pow (Sum Integer)"+    "pow"+    (pow)+    (exampleData_Group_pow_Sum_Integer)++exampleData_Group_pow_Sum_Integer :: UnitTestData2+    (MonoidMap LatinChar (Sum Integer))+    (Integer)+    (MonoidMap LatinChar (Sum Integer))+exampleData_Group_pow_Sum_Integer = unitTestData2+    [ ( m [ 1, -2,  3, -4], (-1)+      , m [-1,  2, -3,  4]+      )+    , ( m [ 1, -2,  3, -4], 0+      , m [ 0,  0,  0,  0]+      )+    , ( m [ 1, -2,  3, -4], 1+      , m [ 1, -2,  3, -4]+      )+    , ( m [ 1, -2,  3, -4], 2+      , m [ 2, -4,  6, -8]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..] . fmap Sum++exampleSpec_Group_subtract_Product_Rational :: Spec+exampleSpec_Group_subtract_Product_Rational = unitTestSpec+    "Group.(~~) (Product Rational)"+    "(~~)"+    (~~)+    (exampleData_Group_subtract_Product_Rational)++exampleData_Group_subtract_Product_Rational :: UnitTestData2+    (MonoidMap LatinChar (Product Rational))+    (MonoidMap LatinChar (Product Rational))+    (MonoidMap LatinChar (Product Rational))+exampleData_Group_subtract_Product_Rational = unitTestData2+    [ ( m [ 1,    1,    1,    1]+      , m [ 1,    2,    4,    8]+      , m [ 1,  1%2,  1%4,  1%8]+      )+    , ( m [-1,   -1,   -1,   -1]+      , m [ 1,    2,    4,    8]+      , m [-1, -1%2, -1%4, -1%8]+      )+    , ( m [ 1,    1,    1,    1]+      , m [-1,   -2,   -4,   -8]+      , m [-1, -1%2, -1%4, -1%8]+      )+    , ( m [-1,   -1,   -1,   -1]+      , m [-1,   -2,   -4,   -8]+      , m [ 1,  1%2,  1%4,  1%8]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..] . fmap Product++exampleSpec_Group_subtract_Sum_Integer :: Spec+exampleSpec_Group_subtract_Sum_Integer = unitTestSpec+    "Group.(~~) (Sum Integer)"+    "(~~)"+    (~~)+    (exampleData_Group_subtract_Sum_Integer)++exampleData_Group_subtract_Sum_Integer :: UnitTestData2+    (MonoidMap LatinChar (Sum Integer))+    (MonoidMap LatinChar (Sum Integer))+    (MonoidMap LatinChar (Sum Integer))+exampleData_Group_subtract_Sum_Integer = unitTestData2+    [ ( m [ 1,  2,  3,  4]+      , m [ 1,  2,  3,  4]+      , m [ 0,  0,  0,  0]+      )+    , ( m [ 0,  0,  0,  0]+      , m [ 1,  2,  3,  4]+      , m [-1, -2, -3, -4]+      )+    , ( m [ 1,  2,  3,  4]+      , m [-1, -2, -3, -4]+      , m [ 2,  4,  6,  8]+      )+    , ( m [-1, -2, -3, -4]+      , m [-1, -2, -3, -4]+      , m [ 0,  0,  0,  0]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..] . fmap Sum++--------------------------------------------------------------------------------+-- Reductive+--------------------------------------------------------------------------------++exampleSpec_Reductive_isPrefixOf_String :: Spec+exampleSpec_Reductive_isPrefixOf_String = unitTestSpec+    "Reductive.isPrefixOf (String)"+    "isPrefixOf"+    (isPrefixOf)+    (exampleData_Reductive_isPrefixOf_String)++exampleData_Reductive_isPrefixOf_String :: UnitTestData2+    (MonoidMap LatinChar String)+    (MonoidMap LatinChar String)+    (Bool)+exampleData_Reductive_isPrefixOf_String = unitTestData2+    [ ( m ["A"   , "B"   , "C"   ]+      , m ["A123", "B123", "C123"]+      , True+      )+    , ( m ["A123", "B123", "C123"]+      , m ["A"   , "B"   , "C"   ]+      , False+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_Reductive_isSuffixOf_String :: Spec+exampleSpec_Reductive_isSuffixOf_String = unitTestSpec+    "Reductive.isSuffixOf (String)"+    "isSuffixOf"+    (isSuffixOf)+    (exampleData_Reductive_isSuffixOf_String)++exampleData_Reductive_isSuffixOf_String :: UnitTestData2+    (MonoidMap LatinChar String)+    (MonoidMap LatinChar String)+    (Bool)+exampleData_Reductive_isSuffixOf_String = unitTestData2+    [ ( m [   "A",    "B",    "C"]+      , m ["123A", "123B", "123C"]+      , True+      )+    , ( m ["123A", "123B", "123C"]+      , m [   "A",    "B",    "C"]+      , False+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_Reductive_isPrefixOf_Sum_Natural :: Spec+exampleSpec_Reductive_isPrefixOf_Sum_Natural = unitTestSpec+    "Reductive.isPrefixOf (Sum Natural)"+    "isPrefixOf"+    (isPrefixOf)+    (exampleData_Reductive_Sum_Natural)++exampleSpec_Reductive_isSuffixOf_Sum_Natural :: Spec+exampleSpec_Reductive_isSuffixOf_Sum_Natural = unitTestSpec+    "Reductive.isSuffixOf (Sum Natural)"+    "isSuffixOf"+    (isSuffixOf)+    (exampleData_Reductive_Sum_Natural)++exampleData_Reductive_Sum_Natural :: UnitTestData2+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+    (Bool)+exampleData_Reductive_Sum_Natural = unitTestData2+    [ ( m [1, 1], m [1, 1], True )+    , ( m [1, 1], m [1, 2], True )+    , ( m [1, 1], m [2, 1], True )+    , ( m [1, 1], m [2, 2], True )+    , ( m [1, 2], m [1, 1], False)+    , ( m [1, 2], m [1, 2], True )+    , ( m [1, 2], m [2, 1], False)+    , ( m [1, 2], m [2, 2], True )+    , ( m [2, 1], m [1, 1], False)+    , ( m [2, 1], m [1, 2], False)+    , ( m [2, 1], m [2, 1], True )+    , ( m [2, 1], m [2, 2], True )+    , ( m [2, 2], m [1, 1], False)+    , ( m [2, 2], m [1, 2], False)+    , ( m [2, 2], m [2, 1], False)+    , ( m [2, 2], m [2, 2], True )+    ]+  where+    m = MonoidMap.fromList . zip [A ..] . fmap Sum++exampleSpec_Reductive_stripPrefix_String :: Spec+exampleSpec_Reductive_stripPrefix_String = unitTestSpec+    "Reductive.stripPrefix (String)"+    "stripPrefix"+    (stripPrefix)+    (exampleData_Reductive_stripPrefix_String)++exampleData_Reductive_stripPrefix_String :: UnitTestData2+    (MonoidMap LatinChar String)+    (MonoidMap LatinChar String)+    (Maybe (MonoidMap LatinChar String))+exampleData_Reductive_stripPrefix_String = unitTestData2+    [ ( m [""   , ""   , ""   ]+      , m ["abc", "pqr", "xyz"]+      , m ["abc", "pqr", "xyz"] & Just+      )+    , ( m ["a"  , "p"  , "x"  ]+      , m ["abc", "pqr", "xyz"]+      , m [ "bc",  "qr",  "yz"] & Just+      )+    , ( m ["abc", "pqr", "xyz"]+      , m ["abc", "pqr", "xyz"]+      , m [   "",    "",    ""] & Just+      )+    , ( m ["?"  , "p"  , "x"  ]+      , m ["abc", "pqr", "xyz"]+      , Nothing+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_Reductive_stripPrefix_Sum_Natural :: Spec+exampleSpec_Reductive_stripPrefix_Sum_Natural = unitTestSpec+    "Reductive.stripPrefix (Sum Natural)"+    "stripPrefix"+    (stripPrefix)+    (exampleData_Reductive_stripPrefix_Sum_Natural)++exampleData_Reductive_stripPrefix_Sum_Natural :: UnitTestData2+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+    (Maybe (MonoidMap LatinChar (Sum Natural)))+exampleData_Reductive_stripPrefix_Sum_Natural = unitTestData2+    [ ( m [0, 0, 0]+      , m [2, 4, 8]+      , m [2, 4, 8] & Just+      )+    , ( m [1, 2, 4]+      , m [2, 4, 8]+      , m [1, 2, 4] & Just+      )+    , ( m [2, 4, 8]+      , m [2, 4, 8]+      , m [0, 0, 0] & Just+      )+    , ( m [3, 4, 8]+      , m [2, 4, 8]+      , Nothing+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_Reductive_stripSuffix_String :: Spec+exampleSpec_Reductive_stripSuffix_String = unitTestSpec+    "Reductive.stripSuffix (String)"+    "stripSuffix"+    (stripSuffix)+    (exampleData_Reductive_stripSuffix_String)++exampleData_Reductive_stripSuffix_String :: UnitTestData2+    (MonoidMap LatinChar String)+    (MonoidMap LatinChar String)+    (Maybe (MonoidMap LatinChar String))+exampleData_Reductive_stripSuffix_String = unitTestData2+    [ ( m [   "",    "",    ""]+      , m ["abc", "pqr", "xyz"]+      , m ["abc", "pqr", "xyz"] & Just+      )+    , ( m [  "c",   "r",   "z"]+      , m ["abc", "pqr", "xyz"]+      , m ["ab" , "pq" , "xy" ] & Just+      )+    , ( m ["abc", "pqr", "xyz"]+      , m ["abc", "pqr", "xyz"]+      , m [""   , ""   , ""   ] & Just+      )+    , ( m [  "?",   "r",   "z"]+      , m ["abc", "pqr", "xyz"]+      , Nothing+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_Reductive_stripSuffix_Sum_Natural :: Spec+exampleSpec_Reductive_stripSuffix_Sum_Natural = unitTestSpec+    "Reductive.stripSuffix (Sum Natural)"+    "stripSuffix"+    (stripSuffix)+    (exampleData_Reductive_stripSuffix_Sum_Natural)++exampleData_Reductive_stripSuffix_Sum_Natural :: UnitTestData2+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+    (Maybe (MonoidMap LatinChar (Sum Natural)))+exampleData_Reductive_stripSuffix_Sum_Natural = unitTestData2+    [ ( m [0, 0, 0]+      , m [2, 4, 8]+      , m [2, 4, 8] & Just+      )+    , ( m [1, 2, 4]+      , m [2, 4, 8]+      , m [1, 2, 4] & Just+      )+    , ( m [2, 4, 8]+      , m [2, 4, 8]+      , m [0, 0, 0] & Just+      )+    , ( m [3, 4, 8]+      , m [2, 4, 8]+      , Nothing+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++--------------------------------------------------------------------------------+-- LeftGCDMonoid+--------------------------------------------------------------------------------++exampleSpec_LeftGCDMonoid_commonPrefix_String :: Spec+exampleSpec_LeftGCDMonoid_commonPrefix_String = unitTestSpec+    "LeftGCDMonoid.commonPrefix (String)"+    "commonPrefix"+    (commonPrefix)+    (exampleData_LeftGCDMonoid_commonPrefix_String)++exampleData_LeftGCDMonoid_commonPrefix_String :: UnitTestData2+    (MonoidMap LatinChar String)+    (MonoidMap LatinChar String)+    (MonoidMap LatinChar String)+exampleData_LeftGCDMonoid_commonPrefix_String = unitTestData2+    [ ( m ["---", "---", "---"]+      , m ["abc", "pqr", "xyz"]+      , m [""   , ""   , ""   ]+      )+    , ( m ["a--", "p--", "x--"]+      , m ["abc", "pqr", "xyz"]+      , m ["a"  , "p"  , "x"  ]+      )+    , ( m ["ab-", "pq-", "xy-"]+      , m ["abc", "pqr", "xyz"]+      , m ["ab" , "pq" , "xy" ]+      )+    , ( m ["abc", "pqr", "xyz"]+      , m ["abc", "pqr", "xyz"]+      , m ["abc", "pqr", "xyz"]+      )+    , ( m ["abc", "pqr", "xyz"]+      , m ["ab-", "pq-", "xy-"]+      , m ["ab" , "pq" , "xy" ]+      )+    , ( m ["abc", "pqr", "xyz"]+      , m ["a--", "p--", "x--"]+      , m ["a"  , "p"  , "x"  ]+      )+    , ( m ["abc", "pqr", "xyz"]+      , m ["---", "---", "---"]+      , m [""   , ""   , ""   ]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_LeftGCDMonoid_commonPrefix_Sum_Natural :: Spec+exampleSpec_LeftGCDMonoid_commonPrefix_Sum_Natural = unitTestSpec+    "LeftGCDMonoid.commonPrefix (Sum Natural)"+    "commonPrefix"+    (commonPrefix)+    (exampleData_LeftGCDMonoid_commonPrefix_Sum_Natural)++exampleData_LeftGCDMonoid_commonPrefix_Sum_Natural :: UnitTestData2+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+exampleData_LeftGCDMonoid_commonPrefix_Sum_Natural = unitTestData2+    [ ( m [0, 0, 0]+      , m [1, 2, 3]+      , m [0, 0, 0]+      )+    , ( m [1, 1, 1]+      , m [1, 2, 3]+      , m [1, 1, 1]+      )+    , ( m [2, 2, 2]+      , m [1, 2, 3]+      , m [1, 2, 2]+      )+    , ( m [3, 3, 3]+      , m [1, 2, 3]+      , m [1, 2, 3]+      )+    , ( m [4, 4, 4]+      , m [1, 2, 3]+      , m [1, 2, 3]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_LeftGCDMonoid_stripCommonPrefix_String :: Spec+exampleSpec_LeftGCDMonoid_stripCommonPrefix_String = unitTestSpec+    "LeftGCDMonoid.stripCommonPrefix (String)"+    "stripCommonPrefix"+    (stripCommonPrefix)+    (exampleData_LeftGCDMonoid_stripCommonPrefix_String)++exampleData_LeftGCDMonoid_stripCommonPrefix_String :: UnitTestData2+    (MonoidMap LatinChar String)+    (MonoidMap LatinChar String)+    ( MonoidMap LatinChar String+    , MonoidMap LatinChar String+    , MonoidMap LatinChar String+    )+exampleData_LeftGCDMonoid_stripCommonPrefix_String = unitTestData2+    [ (   m ["---", "---", "---"]+      ,   m ["abc", "pqr", "xyz"]++      , ( m [""   , ""   , ""   ]+        , m ["---", "---", "---"]+        , m ["abc", "pqr", "xyz"]+        )+      )+    , (   m ["a--", "p--", "x--"]+      ,   m ["abc", "pqr", "xyz"]++      , ( m ["a"  , "p"  , "x"  ]+        , m [ "--",  "--",  "--"]+        , m [ "bc",  "qr",  "yz"]+        )+      )+    , (   m ["ab-", "pq-", "xy-"]+      ,   m ["abc", "pqr", "xyz"]++      , ( m ["ab" , "pq" , "xy" ]+        , m [  "-",   "-",   "-"]+        , m [  "c",   "r",   "z"]+        )+      )+    , (   m ["abc", "pqr", "xyz"]+      ,   m ["abc", "pqr", "xyz"]++      , ( m ["abc", "pqr", "xyz"]+        , m [   "",    "",    ""]+        , m [   "",    "",    ""]+        )+      )+    , (   m ["abc", "pqr", "xyz"]+      ,   m ["ab-", "pq-", "xy-"]++      , ( m ["ab" , "pq" , "xy" ]+        , m [  "c",   "r",   "z"]+        , m [  "-",   "-",   "-"]+        )+      )+    , (   m ["abc", "pqr", "xyz"]+      ,   m ["a--", "p--", "x--"]+      , ( m ["a"  , "p"  , "x"  ]+        , m [ "bc",  "qr",  "yz"]+        , m [ "--",  "--",  "--"]+        )+      )+    , (   m ["abc", "pqr", "xyz"]+      ,   m ["---", "---", "---"]+      , ( m [""   , ""   , ""   ]+        , m ["abc", "pqr", "xyz"]+        , m ["---", "---", "---"]+        )+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_LeftGCDMonoid_stripCommonPrefix_Sum_Natural :: Spec+exampleSpec_LeftGCDMonoid_stripCommonPrefix_Sum_Natural = unitTestSpec+    "LeftGCDMonoid.stripCommonPrefix (Sum Natural)"+    "stripCommonPrefix"+    (stripCommonPrefix)+    (exampleData_LeftGCDMonoid_stripCommonPrefix_Sum_Natural)++exampleData_LeftGCDMonoid_stripCommonPrefix_Sum_Natural :: UnitTestData2+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+    ( MonoidMap LatinChar (Sum Natural)+    , MonoidMap LatinChar (Sum Natural)+    , MonoidMap LatinChar (Sum Natural)+    )+exampleData_LeftGCDMonoid_stripCommonPrefix_Sum_Natural = unitTestData2+    [ (   m [0, 1, 2, 3, 4]+      ,   m [4, 3, 2, 1, 0]++      , ( m [0, 1, 2, 1, 0]+        , m [0, 0, 0, 2, 4]+        , m [4, 2, 0, 0, 0]+        )+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++--------------------------------------------------------------------------------+-- RightGCDMonoid+--------------------------------------------------------------------------------++exampleSpec_RightGCDMonoid_commonSuffix_String :: Spec+exampleSpec_RightGCDMonoid_commonSuffix_String = unitTestSpec+    "RightGCDMonoid.commonSuffix (String)"+    "commonSuffix"+    (commonSuffix)+    (exampleData_RightGCDMonoid_commonSuffix_String)++exampleData_RightGCDMonoid_commonSuffix_String :: UnitTestData2+    (MonoidMap LatinChar String)+    (MonoidMap LatinChar String)+    (MonoidMap LatinChar String)+exampleData_RightGCDMonoid_commonSuffix_String = unitTestData2+    [ ( m ["---", "---", "---"]+      , m ["abc", "pqr", "xyz"]+      , m [  "" ,    "",    ""]+      )+    , ( m ["--c", "--r", "--z"]+      , m ["abc", "pqr", "xyz"]+      , m [  "c",   "r",   "z"]+      )+    , ( m ["-bc", "-qr", "-yz"]+      , m ["abc", "pqr", "xyz"]+      , m [ "bc",  "qr",  "yz"]+      )+    , ( m ["abc", "pqr", "xyz"]+      , m ["abc", "pqr", "xyz"]+      , m ["abc", "pqr", "xyz"]+      )+    , ( m ["abc", "pqr", "xyz"]+      , m ["-bc", "-qr", "-yz"]+      , m [ "bc",  "qr",  "yz"]+      )+    , ( m ["abc", "pqr", "xyz"]+      , m ["--c", "--r", "--z"]+      , m [  "c",   "r",   "z"]+      )+    , ( m ["abc", "pqr", "xyz"]+      , m ["---", "---", "---"]+      , m [   "",    "",    ""]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_RightGCDMonoid_commonSuffix_Sum_Natural :: Spec+exampleSpec_RightGCDMonoid_commonSuffix_Sum_Natural = unitTestSpec+    "RightGCDMonoid.commonSuffix (Sum Natural)"+    "commonSuffix"+    (commonSuffix)+    (exampleData_RightGCDMonoid_commonSuffix_Sum_Natural)++exampleData_RightGCDMonoid_commonSuffix_Sum_Natural :: UnitTestData2+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+exampleData_RightGCDMonoid_commonSuffix_Sum_Natural = unitTestData2+    [ ( m [0, 0, 0]+      , m [1, 2, 3]+      , m [0, 0, 0]+      )+    , ( m [1, 1, 1]+      , m [1, 2, 3]+      , m [1, 1, 1]+      )+    , ( m [2, 2, 2]+      , m [1, 2, 3]+      , m [1, 2, 2]+      )+    , ( m [3, 3, 3]+      , m [1, 2, 3]+      , m [1, 2, 3]+      )+    , ( m [4, 4, 4]+      , m [1, 2, 3]+      , m [1, 2, 3]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_RightGCDMonoid_stripCommonSuffix_String :: Spec+exampleSpec_RightGCDMonoid_stripCommonSuffix_String = unitTestSpec+    "RightGCDMonoid.stripCommonSuffix (String)"+    "stripCommonSuffix"+    (stripCommonSuffix)+    (exampleData_RightGCDMonoid_stripCommonSuffix_String)++exampleData_RightGCDMonoid_stripCommonSuffix_String :: UnitTestData2+    (MonoidMap LatinChar String)+    (MonoidMap LatinChar String)+    ( MonoidMap LatinChar String+    , MonoidMap LatinChar String+    , MonoidMap LatinChar String+    )+exampleData_RightGCDMonoid_stripCommonSuffix_String = unitTestData2+    [ (   m ["---", "---", "---"]+      ,   m ["abc", "pqr", "xyz"]++      , ( m ["---", "---", "---"]+        , m ["abc", "pqr", "xyz"]+        , m [   "",    "",    ""]+        )+      )+    , (   m ["--c", "--r", "--z"]+      ,   m ["abc", "pqr", "xyz"]++      , ( m ["--" , "--" , "--" ]+        , m ["ab" , "pq" , "xy" ]+        , m [  "c",   "r",   "z"]+        )+      )+    , (   m ["--c", "--r", "--z"]+      ,   m ["abc", "pqr", "xyz"]++      , ( m ["--" , "--" , "--" ]+        , m ["ab" , "pq" , "xy" ]+        , m [  "c",   "r",   "z"]+        )+      )+    , (   m ["-bc", "-qr", "-yz"]+      ,   m ["abc", "pqr", "xyz"]++      , ( m ["-"  , "-"  , "-"  ]+        , m ["a"  , "p"  , "x"  ]+        , m [ "bc",  "qr",  "yz"]+        )+      )+    , (   m ["abc", "pqr", "xyz"]+      ,   m ["abc", "pqr", "xyz"]++      , ( m [""   , ""   , ""   ]+        , m [""   , ""   , ""   ]+        , m ["abc", "pqr", "xyz"]+        )+      )+    , (   m ["abc", "pqr", "xyz"]+      ,   m ["-bc", "-qr", "-yz"]++      , ( m ["a"  , "p"  , "x"  ]+        , m ["-"  , "-"  , "-"  ]+        , m [ "bc",  "qr",  "yz"]+        )+      )+    , (   m ["abc", "pqr", "xyz"]+      ,   m ["--c", "--r", "--z"]++      , ( m ["ab" , "pq" , "xy" ]+        , m ["--" , "--" , "--" ]+        , m [  "c",   "r",   "z"]+        )+      )+    , (   m ["abc", "pqr", "xyz"]+      ,   m ["---", "---", "---"]++      , ( m ["abc", "pqr", "xyz"]+        , m ["---", "---", "---"]+        , m [   "",    "",    ""]+        )+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_RightGCDMonoid_stripCommonSuffix_Sum_Natural :: Spec+exampleSpec_RightGCDMonoid_stripCommonSuffix_Sum_Natural = unitTestSpec+    "RightGCDMonoid.stripCommonSuffix (Sum Natural)"+    "stripCommonSuffix"+    (stripCommonSuffix)+    (exampleData_RightGCDMonoid_stripCommonSuffix_Sum_Natural)++exampleData_RightGCDMonoid_stripCommonSuffix_Sum_Natural :: UnitTestData2+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+    ( MonoidMap LatinChar (Sum Natural)+    , MonoidMap LatinChar (Sum Natural)+    , MonoidMap LatinChar (Sum Natural)+    )+exampleData_RightGCDMonoid_stripCommonSuffix_Sum_Natural = unitTestData2+    [ (   m [0, 1, 2, 3, 4]+      ,   m [4, 3, 2, 1, 0]++      , ( m [0, 0, 0, 2, 4]+        , m [4, 2, 0, 0, 0]+        , m [0, 1, 2, 1, 0]+        )+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++--------------------------------------------------------------------------------+-- OverlappingGCDMonoid+--------------------------------------------------------------------------------++exampleSpec_OverlappingGCDMonoid_overlap_String :: Spec+exampleSpec_OverlappingGCDMonoid_overlap_String = unitTestSpec+    "OverlappingGCDMonoid.overlap (String)"+    "overlap"+    (overlap)+    (exampleData_OverlappingGCDMonoid_overlap_String)++exampleData_OverlappingGCDMonoid_overlap_String :: UnitTestData2+    (MonoidMap LatinChar String)+    (MonoidMap LatinChar String)+    (MonoidMap LatinChar String)+exampleData_OverlappingGCDMonoid_overlap_String = unitTestData2+    [ ( m ["abcd"    , "0123"    ]+      , m [    "efgh",     "4567"]+      , m [    ""    ,     ""    ]+      )+    , ( m ["abcde"   , "01234"   ]+      , m [   "defgh",    "34567"]+      , m [   "de"   ,    "34"   ]+      )+    , ( m ["abcdef"  , "012345"  ]+      , m [  "cdefgh",   "234567"]+      , m [  "cdef"  ,   "2345"  ]+      )+    , ( m ["abcdefg" , "0123456" ]+      , m [ "bcdefgh",  "1234567"]+      , m [ "bcdefg" ,  "123456" ]+      )+    , ( m ["abcdefgh", "01234567"]+      , m ["abcdefgh", "01234567"]+      , m ["abcdefgh", "01234567"]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_OverlappingGCDMonoid_overlap_Sum_Natural :: Spec+exampleSpec_OverlappingGCDMonoid_overlap_Sum_Natural = unitTestSpec+    "OverlappingGCDMonoid.overlap (Sum Natural)"+    "overlap"+    (overlap)+    (exampleData_OverlappingGCDMonoid_overlap_Sum_Natural)++exampleData_OverlappingGCDMonoid_overlap_Sum_Natural :: UnitTestData2+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+exampleData_OverlappingGCDMonoid_overlap_Sum_Natural = unitTestData2+    [ ( m [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]+      , m [9, 8, 7, 6, 5, 4, 3, 2, 1, 0]+      , m [0, 1, 2, 3, 4, 4, 3, 2, 1, 0]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_OverlappingGCDMonoid_stripPrefixOverlap_String :: Spec+exampleSpec_OverlappingGCDMonoid_stripPrefixOverlap_String = unitTestSpec+    "OverlappingGCDMonoid.stripPrefixOverlap (String)"+    "stripPrefixOverlap"+    (stripPrefixOverlap)+    (exampleData_OverlappingGCDMonoid_stripPrefixOverlap_String)++exampleData_OverlappingGCDMonoid_stripPrefixOverlap_String :: UnitTestData2+    (MonoidMap LatinChar String)+    (MonoidMap LatinChar String)+    (MonoidMap LatinChar String)+exampleData_OverlappingGCDMonoid_stripPrefixOverlap_String = unitTestData2+    [ ( m ["abcd"    , "0123"    ]+      , m [    "efgh",     "4567"]+      , m [    "efgh",     "4567"]+      )+    , ( m ["abcde"   , "01234"   ]+      , m [   "defgh",    "34567"]+      , m [     "fgh",      "567"]+      )+    , ( m ["abcdef"  , "012345"  ]+      , m [  "cdefgh",   "234567"]+      , m [      "gh",       "67"]+      )+    , ( m ["abcdefg" , "0123456" ]+      , m [ "bcdefgh",  "1234567"]+      , m [       "h",        "7"]+      )+    , ( m ["abcdefgh", "01234567"]+      , m ["abcdefgh", "01234567"]+      , m [        "",         ""]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_OverlappingGCDMonoid_stripSuffixOverlap_String :: Spec+exampleSpec_OverlappingGCDMonoid_stripSuffixOverlap_String = unitTestSpec+    "OverlappingGCDMonoid.stripSuffixOverlap (String)"+    "stripSuffixOverlap"+    (stripSuffixOverlap)+    (exampleData_OverlappingGCDMonoid_stripSuffixOverlap_String)++exampleData_OverlappingGCDMonoid_stripSuffixOverlap_String :: UnitTestData2+    (MonoidMap LatinChar String)+    (MonoidMap LatinChar String)+    (MonoidMap LatinChar String)+exampleData_OverlappingGCDMonoid_stripSuffixOverlap_String = unitTestData2+    [ ( m [    "efgh",     "4567"]+      , m ["abcd"    , "0123"    ]+      , m ["abcd"    , "0123"    ]+      )+    , ( m [   "defgh",    "34567"]+      , m ["abcde"   , "01234"   ]+      , m ["abc"     , "012"     ]+      )+    , ( m [  "cdefgh",   "234567"]+      , m ["abcdef"  , "012345"  ]+      , m ["ab"      , "01"      ]+      )+    , ( m [ "bcdefgh",  "1234567"]+      , m ["abcdefg" , "0123456" ]+      , m ["a"       , "0"       ]+      )+    , ( m ["abcdefgh", "01234567"]+      , m ["abcdefgh", "01234567"]+      , m [""        , ""        ]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_OverlappingGCDMonoid_stripPrefixOverlap_Sum_Natural :: Spec+exampleSpec_OverlappingGCDMonoid_stripPrefixOverlap_Sum_Natural = unitTestSpec+    "OverlappingGCDMonoid.stripPrefixOverlap (Sum Natural)"+    "stripPrefixOverlap"+    (stripPrefixOverlap)+    (exampleData_OverlappingGCDMonoid_stripPrefixOverlap_Sum_Natural)++exampleData_OverlappingGCDMonoid_stripPrefixOverlap_Sum_Natural+    :: UnitTestData2+        (MonoidMap LatinChar (Sum Natural))+        (MonoidMap LatinChar (Sum Natural))+        (MonoidMap LatinChar (Sum Natural))+exampleData_OverlappingGCDMonoid_stripPrefixOverlap_Sum_Natural = unitTestData2+    [ ( m [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]+      , m [9, 8, 7, 6, 5, 4, 3, 2, 1, 0]+      , m [9, 7, 5, 3, 1, 0, 0, 0, 0, 0]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_OverlappingGCDMonoid_stripSuffixOverlap_Sum_Natural :: Spec+exampleSpec_OverlappingGCDMonoid_stripSuffixOverlap_Sum_Natural = unitTestSpec+    "OverlappingGCDMonoid.stripSuffixOverlap (Sum Natural)"+    "stripSuffixOverlap"+    (stripSuffixOverlap)+    (exampleData_OverlappingGCDMonoid_stripSuffixOverlap_Sum_Natural)++exampleData_OverlappingGCDMonoid_stripSuffixOverlap_Sum_Natural+    :: UnitTestData2+        (MonoidMap LatinChar (Sum Natural))+        (MonoidMap LatinChar (Sum Natural))+        (MonoidMap LatinChar (Sum Natural))+exampleData_OverlappingGCDMonoid_stripSuffixOverlap_Sum_Natural = unitTestData2+    [ ( m [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]+      , m [9, 8, 7, 6, 5, 4, 3, 2, 1, 0]+      , m [9, 7, 5, 3, 1, 0, 0, 0, 0, 0]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++--------------------------------------------------------------------------------+-- GCDMonoid+--------------------------------------------------------------------------------++exampleSpec_GCDMonoid_gcd_Product_Natural :: Spec+exampleSpec_GCDMonoid_gcd_Product_Natural = unitTestSpec+    "GCDMonoid.gcd (Product Natural)"+    "gcd"+    (gcd)+    (exampleData_GCDMonoid_gcd_Product_Natural)++exampleData_GCDMonoid_gcd_Product_Natural :: UnitTestData2+    (MonoidMap LatinChar (Product Natural))+    (MonoidMap LatinChar (Product Natural))+    (MonoidMap LatinChar (Product Natural))+exampleData_GCDMonoid_gcd_Product_Natural = unitTestData2+    [ ( m [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]+      , m [0, 0, 0, 0, 0, 0, 0, 0, 0, 0]+      , m [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]+      )+    , ( m [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]+      , m [1, 1, 1, 1, 1, 1, 1, 1, 1, 1]+      , m [1, 1, 1, 1, 1, 1, 1, 1, 1, 1]+      )+    , ( m [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]+      , m [2, 2, 2, 2, 2, 2, 2, 2, 2, 2]+      , m [2, 1, 2, 1, 2, 1, 2, 1, 2, 1]+      )+    , ( m [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]+      , m [3, 3, 3, 3, 3, 3, 3, 3, 3, 3]+      , m [3, 1, 1, 3, 1, 1, 3, 1, 1, 3]+      )+    , ( m [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]+      , m [4, 4, 4, 4, 4, 4, 4, 4, 4, 4]+      , m [4, 1, 2, 1, 4, 1, 2, 1, 4, 1]+      )+    , ( m [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]+      , m [5, 5, 5, 5, 5, 5, 5, 5, 5, 5]+      , m [5, 1, 1, 1, 1, 5, 1, 1, 1, 1]+      )+    , ( m [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]+      , m [6, 6, 6, 6, 6, 6, 6, 6, 6, 6]+      , m [6, 1, 2, 3, 2, 1, 6, 1, 2, 3]+      )+    , ( m [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]+      , m [7, 7, 7, 7, 7, 7, 7, 7, 7, 7]+      , m [7, 1, 1, 1, 1, 1, 1, 7, 1, 1]+      )+    , ( m [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]+      , m [8, 8, 8, 8, 8, 8, 8, 8, 8, 8]+      , m [8, 1, 2, 1, 4, 1, 2, 1, 8, 1]+      )+    , ( m [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]+      , m [9, 9, 9, 9, 9, 9, 9, 9, 9, 9]+      , m [9, 1, 1, 3, 1, 1, 3, 1, 1, 9]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_GCDMonoid_gcd_Sum_Natural :: Spec+exampleSpec_GCDMonoid_gcd_Sum_Natural = unitTestSpec+    "GCDMonoid.gcd (Sum Natural)"+    "gcd"+    (gcd)+    (exampleData_GCDMonoid_gcd_Sum_Natural)++exampleData_GCDMonoid_gcd_Sum_Natural :: UnitTestData2+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+exampleData_GCDMonoid_gcd_Sum_Natural = unitTestData2+    [ ( m [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]+      , m [9, 8, 7, 6, 5, 4, 3, 2, 1, 0]+      , m [0, 1, 2, 3, 4, 4, 3, 2, 1, 0]+      )+    , ( m [9, 8, 7, 6, 5, 4, 3, 2, 1, 0]+      , m [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]+      , m [0, 1, 2, 3, 4, 4, 3, 2, 1, 0]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_GCDMonoid_gcd_Set_Natural :: Spec+exampleSpec_GCDMonoid_gcd_Set_Natural = unitTestSpec+    "GCDMonoid.gcd (Set Natural)"+    "gcd"+    (gcd)+    (exampleData_GCDMonoid_gcd_Set_Natural)++exampleData_GCDMonoid_gcd_Set_Natural :: UnitTestData2+    (MonoidMap LatinChar (Set Natural))+    (MonoidMap LatinChar (Set Natural))+    (MonoidMap LatinChar (Set Natural))+exampleData_GCDMonoid_gcd_Set_Natural = unitTestData2+    [ ( m [[0, 1, 2, 3], [4, 5, 6, 7]]+      , m [[0, 1, 2, 3], [4, 5, 6, 7]]+      , m [[0, 1, 2, 3], [4, 5, 6, 7]]+      )+    , ( m [[0, 1, 2, 3], [4, 5, 6, 7]]+      , m [[          ], [          ]]+      , m [[          ], [          ]]+      )+    , ( m [[          ], [          ]]+      , m [[0, 1, 2, 3], [4, 5, 6, 7]]+      , m [[          ], [          ]]+      )+    , ( m [[0, 1, 2, 3], [4, 5, 6, 7]]+      , m [[   1, 2, 3], [   5, 6, 7]]+      , m [[   1, 2, 3], [   5, 6, 7]]+      )+    , ( m [[   1, 2, 3], [   5, 6, 7]]+      , m [[0, 1, 2, 3], [4, 5, 6, 7]]+      , m [[   1, 2, 3], [   5, 6, 7]]+      )+    , ( m [[0, 1, 2   ], [4, 5, 6   ]]+      , m [[   1, 2, 3], [   5, 6, 7]]+      , m [[   1, 2   ], [   5, 6   ]]+      )+    , ( m [[   1, 2, 3], [   5, 6, 7]]+      , m [[0, 1, 2   ], [4, 5, 6   ]]+      , m [[   1, 2   ], [   5, 6   ]]+      )+    , ( m [[0, 1      ], [4, 5      ]]+      , m [[      2, 3], [      6, 7]]+      , m [[          ], [          ]]+      )+    , ( m [[      2, 3], [      6, 7]]+      , m [[0, 1      ], [4, 5      ]]+      , m [[          ], [          ]]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..] . fmap Set.fromList++--------------------------------------------------------------------------------+-- LCMMonoid+--------------------------------------------------------------------------------++exampleSpec_LCMMonoid_lcm_Product_Natural :: Spec+exampleSpec_LCMMonoid_lcm_Product_Natural = unitTestSpec+    "LCMMonoid.lcm (Product Natural)"+    "lcm"+    (lcm)+    (exampleData_LCMMonoid_lcm_Product_Natural)++exampleData_LCMMonoid_lcm_Product_Natural :: UnitTestData2+    (MonoidMap LatinChar (Product Natural))+    (MonoidMap LatinChar (Product Natural))+    (MonoidMap LatinChar (Product Natural))+exampleData_LCMMonoid_lcm_Product_Natural = unitTestData2+    [ ( m [ 0,  1,  2,  3,  4,  5,  6,  7,  8,  9]+      , m [ 0,  0,  0,  0,  0,  0,  0,  0,  0,  0]+      , m [ 0,  0,  0,  0,  0,  0,  0,  0,  0,  0]+      )+    , ( m [ 0,  1,  2,  3,  4,  5,  6,  7,  8,  9]+      , m [ 1,  1,  1,  1,  1,  1,  1,  1,  1,  1]+      , m [ 0,  1,  2,  3,  4,  5,  6,  7,  8,  9]+      )+    , ( m [ 0,  1,  2,  3,  4,  5,  6,  7,  8,  9]+      , m [ 2,  2,  2,  2,  2,  2,  2,  2,  2,  2]+      , m [ 0,  2,  2,  6,  4, 10,  6, 14,  8, 18]+      )+    , ( m [ 0,  1,  2,  3,  4,  5,  6,  7,  8,  9]+      , m [ 3,  3,  3,  3,  3,  3,  3,  3,  3,  3]+      , m [ 0,  3,  6,  3, 12, 15,  6, 21, 24,  9]+      )+    , ( m [ 0,  1,  2,  3,  4,  5,  6,  7,  8,  9]+      , m [ 4,  4,  4,  4,  4,  4,  4,  4,  4,  4]+      , m [ 0,  4,  4, 12,  4, 20, 12, 28,  8, 36]+      )+    , ( m [ 0,  1,  2,  3,  4,  5,  6,  7,  8,  9]+      , m [ 5,  5,  5,  5,  5,  5,  5,  5,  5,  5]+      , m [ 0,  5, 10, 15, 20,  5, 30, 35, 40, 45]+      )+    , ( m [ 0,  1,  2,  3,  4,  5,  6,  7,  8,  9]+      , m [ 6,  6,  6,  6,  6,  6,  6,  6,  6,  6]+      , m [ 0,  6,  6,  6, 12, 30,  6, 42, 24, 18]+      )+    , ( m [ 0,  1,  2,  3,  4,  5,  6,  7,  8,  9]+      , m [ 7,  7,  7,  7,  7,  7,  7,  7,  7,  7]+      , m [ 0,  7, 14, 21, 28, 35, 42,  7, 56, 63]+      )+    , ( m [ 0,  1,  2,  3,  4,  5,  6,  7,  8,  9]+      , m [ 8,  8,  8,  8,  8,  8,  8,  8,  8,  8]+      , m [ 0,  8,  8, 24,  8, 40, 24, 56,  8, 72]+      )+    , ( m [ 0,  1,  2,  3,  4,  5,  6,  7,  8,  9]+      , m [ 9,  9,  9,  9,  9,  9,  9,  9,  9,  9]+      , m [ 0,  9, 18,  9, 36, 45, 18, 63, 72,  9]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_LCMMonoid_lcm_Sum_Natural :: Spec+exampleSpec_LCMMonoid_lcm_Sum_Natural = unitTestSpec+    "LCMMonoid.lcm (Sum Natural)"+    "lcm"+    (lcm)+    (exampleData_LCMMonoid_lcm_Sum_Natural)++exampleData_LCMMonoid_lcm_Sum_Natural :: UnitTestData2+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+exampleData_LCMMonoid_lcm_Sum_Natural = unitTestData2+    [ ( m [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]+      , m [9, 8, 7, 6, 5, 4, 3, 2, 1, 0]+      , m [9, 8, 7, 6, 5, 5, 6, 7, 8, 9]+      )+    , ( m [9, 8, 7, 6, 5, 4, 3, 2, 1, 0]+      , m [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]+      , m [9, 8, 7, 6, 5, 5, 6, 7, 8, 9]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++exampleSpec_LCMMonoid_lcm_Set_Natural :: Spec+exampleSpec_LCMMonoid_lcm_Set_Natural = unitTestSpec+    "LCMMonoid.lcm (Set Natural)"+    "lcm"+    (lcm)+    (exampleData_LCMMonoid_lcm_Set_Natural)++exampleData_LCMMonoid_lcm_Set_Natural :: UnitTestData2+    (MonoidMap LatinChar (Set Natural))+    (MonoidMap LatinChar (Set Natural))+    (MonoidMap LatinChar (Set Natural))+exampleData_LCMMonoid_lcm_Set_Natural = unitTestData2+    [ ( m [[0, 1, 2, 3], [4, 5, 6, 7]]+      , m [[0, 1, 2, 3], [4, 5, 6, 7]]+      , m [[0, 1, 2, 3], [4, 5, 6, 7]]+      )+    , ( m [[0, 1, 2, 3], [4, 5, 6, 7]]+      , m [[          ], [          ]]+      , m [[0, 1, 2, 3], [4, 5, 6, 7]]+      )+    , ( m [[          ], [          ]]+      , m [[0, 1, 2, 3], [4, 5, 6, 7]]+      , m [[0, 1, 2, 3], [4, 5, 6, 7]]+      )+    , ( m [[0, 1, 2, 3], [4, 5, 6, 7]]+      , m [[   1, 2, 3], [   5, 6, 7]]+      , m [[0, 1, 2, 3], [4, 5, 6, 7]]+      )+    , ( m [[   1, 2, 3], [   5, 6, 7]]+      , m [[0, 1, 2, 3], [4, 5, 6, 7]]+      , m [[0, 1, 2, 3], [4, 5, 6, 7]]+      )+    , ( m [[0, 1, 2   ], [4, 5, 6   ]]+      , m [[   1, 2, 3], [   5, 6, 7]]+      , m [[0, 1, 2, 3], [4, 5, 6, 7]]+      )+    , ( m [[   1, 2, 3], [   5, 6, 7]]+      , m [[0, 1, 2   ], [4, 5, 6   ]]+      , m [[0, 1, 2, 3], [4, 5, 6, 7]]+      )+    , ( m [[0, 1      ], [4, 5      ]]+      , m [[      2, 3], [      6, 7]]+      , m [[0, 1, 2, 3], [4, 5, 6, 7]]+      )+    , ( m [[      2, 3], [      6, 7]]+      , m [[0, 1      ], [4, 5      ]]+      , m [[0, 1, 2, 3], [4, 5, 6, 7]]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..] . fmap Set.fromList++--------------------------------------------------------------------------------+-- Monus+--------------------------------------------------------------------------------++exampleSpec_Monus_monus_Set_Natural :: Spec+exampleSpec_Monus_monus_Set_Natural = unitTestSpec+    "Monus.monus (Set Natural)"+    "<\\>"+    (<\>)+    (exampleData_Monus_monus_Set_Natural)++exampleData_Monus_monus_Set_Natural :: UnitTestData2+    (MonoidMap LatinChar (Set Natural))+    (MonoidMap LatinChar (Set Natural))+    (MonoidMap LatinChar (Set Natural))+exampleData_Monus_monus_Set_Natural = unitTestData2+    [ ( m [[0, 1, 2], [3, 4, 5]]+      , m [[       ], [       ]]+      , m [[0, 1, 2], [3, 4, 5]]+      )+    , ( m [[0, 1, 2], [3, 4, 5]]+      , m [[0      ], [3      ]]+      , m [[   1, 2], [   4, 5]]+      )+    , ( m [[0, 1, 2], [3, 4, 5]]+      , m [[   1   ], [   4   ]]+      , m [[0,    2], [3,    5]]+      )+    , ( m [[0, 1, 2], [3, 4, 5]]+      , m [[      2], [      5]]+      , m [[0, 1   ], [3, 4   ]]+      )+    , ( m [[0, 1, 2], [3, 4, 5]]+      , m [[0, 1, 2], [3, 4, 5]]+      , m [[       ], [       ]]+      )+    , ( m [[0, 1, 2], [3, 4, 5]]+      , m [[3, 4, 5], [0, 1, 2]]+      , m [[0, 1, 2], [3, 4, 5]]+      )+    , ( m [[0, 1, 2], [3, 4, 5]]+      , m [[2, 3, 4], [1, 2, 3]]+      , m [[0, 1   ], [   4, 5]]+      )+    , ( m [[0, 1, 2], [3, 4, 5]]+      , m [[1, 2, 3], [2, 3, 4]]+      , m [[0      ], [      5]]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..] . fmap Set.fromList++exampleSpec_Monus_monus_Sum_Natural :: Spec+exampleSpec_Monus_monus_Sum_Natural = unitTestSpec+    "Monus.monus (Sum Natural)"+    "<\\>"+    (<\>)+    (exampleData_Monus_monus_Sum_Natural)++exampleData_Monus_monus_Sum_Natural :: UnitTestData2+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+    (MonoidMap LatinChar (Sum Natural))+exampleData_Monus_monus_Sum_Natural = unitTestData2+    [ ( m [0, 1, 2, 3]+      , m [0, 0, 0, 0]+      , m [0, 1, 2, 3]+      )+    , ( m [0, 1, 2, 3]+      , m [1, 1, 1, 1]+      , m [0, 0, 1, 2]+      )+    , ( m [0, 1, 2, 3]+      , m [2, 2, 2, 2]+      , m [0, 0, 0, 1]+      )+    , ( m [0, 1, 2, 3]+      , m [3, 3, 3, 3]+      , m [0, 0, 0, 0]+      )+    , ( m [0, 1, 2, 3]+      , m [4, 4, 4, 4]+      , m [0, 0, 0, 0]+      )+    ]+  where+    m = MonoidMap.fromList . zip [A ..]++--------------------------------------------------------------------------------+-- Utilities+--------------------------------------------------------------------------------++data LatinChar+    = A | B | C | D | E | F | G | H | I | J | K | L | M+    | N | O | P | Q | R | S | T | U | V | W | X | Y | Z+    deriving (Bounded, Enum, Eq, Ord, Show)
+ src/test/Data/MonoidMap/FilterSpec.hs view
@@ -0,0 +1,156 @@+{- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Use camelCase" -}+{- HLINT ignore "Use null" -}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Data.MonoidMap.FilterSpec+    ( spec+    ) where++import Prelude++import Control.Monad+    ( forM_ )+import Data.Function+    ( (&) )+import Data.MonoidMap+    ( MonoidMap, nonNullCount )+import Data.Proxy+    ( Proxy (..) )+import GHC.Exts+    ( IsList (..) )+import Test.Common+    ( Key, Test, TestType (TestType), makeSpec, property, testTypesMonoidNull )+import Test.Hspec+    ( Spec, describe, it )+import Test.QuickCheck+    ( Fun (..), Property, applyFun, applyFun2, cover, (===) )++import qualified Data.List as List+import qualified Data.MonoidMap as MonoidMap++spec :: Spec+spec = describe "Filtering" $ do++    forM_ testTypesMonoidNull $ \(TestType p) -> specFor (Proxy @Key) p++specFor :: forall k v. Test k v => Proxy k -> Proxy v -> Spec+specFor = makeSpec $ do++    it "prop_filter_get" $+        prop_filter_get+            @k @v & property+    it "prop_filter_asList" $+        prop_filter_asList+            @k @v & property+    it "prop_filterKeys_get" $+        prop_filterKeys_get+            @k @v & property+    it "prop_filterKeys_asList" $+        prop_filterKeys_asList+            @k @v & property+    it "prop_filterWithKey_get" $+        prop_filterWithKey_get+            @k @v & property+    it "prop_filterWithKey_asList" $+        prop_filterWithKey_asList+            @k @v & property++prop_filter_get+    :: Test k v => Fun v Bool -> k -> MonoidMap k v -> Property+prop_filter_get (applyFun -> f) k m =+    MonoidMap.get k (MonoidMap.filter f m)+        ===+        (MonoidMap.get k m & \v -> if f v then v else mempty)+    & cover 2+        (MonoidMap.nullKey k m && f (MonoidMap.get k m))+        "MonoidMap.nullKey k m && f (MonoidMap.get k m)"+    & cover 2+        (MonoidMap.nullKey k m && not (f (MonoidMap.get k m)))+        "MonoidMap.nullKey k m && not (f (MonoidMap.get k m))"+    & cover 2+        (MonoidMap.nonNullKey k m && f (MonoidMap.get k m))+        "MonoidMap.nonNullKey k m && f (MonoidMap.get k m)"+    & cover 2+        (MonoidMap.nonNullKey k m && not (f (MonoidMap.get k m)))+        "MonoidMap.nonNullKey k m && not (f (MonoidMap.get k m))"++prop_filter_asList+    :: Test k v => Fun v Bool -> MonoidMap k v -> Property+prop_filter_asList (applyFun -> f) m =+    n === fromList (List.filter (f . snd) (toList m))+    & cover 2+        (MonoidMap.nonNull n && nonNullCount n == nonNullCount m)+        "MonoidMap.nonNull n && nonNullCount n == nonNullCount m"+    & cover 2+        (MonoidMap.nonNull n && nonNullCount n /= nonNullCount m)+        "MonoidMap.nonNull n && nonNullCount n /= nonNullCount m"+  where+    n = MonoidMap.filter f m++prop_filterKeys_get+    :: Test k v => Fun k Bool -> k -> MonoidMap k v -> Property+prop_filterKeys_get (applyFun -> f) k m =+    MonoidMap.get k (MonoidMap.filterKeys f m)+        ===+        (if f k then MonoidMap.get k m else mempty)+    & cover 2+        (MonoidMap.nullKey k m && f k)+        "MonoidMap.nullKey k m && f k"+    & cover 2+        (MonoidMap.nullKey k m && not (f k))+        "MonoidMap.nullKey k m && not (f k)"+    & cover 2+        (MonoidMap.nonNullKey k m && f k)+        "MonoidMap.nonNullKey k m && f k"+    & cover 2+        (MonoidMap.nonNullKey k m && not (f k))+        "MonoidMap.nonNullKey k m && not (f k)"++prop_filterKeys_asList+    :: Test k v => Fun k Bool -> MonoidMap k v -> Property+prop_filterKeys_asList (applyFun -> f) m =+    n === MonoidMap.fromList (List.filter (f . fst) (toList m))+    & cover 2+        (MonoidMap.nonNull n && nonNullCount n == nonNullCount m)+        "MonoidMap.nonNull n && nonNullCount n == nonNullCount m"+    & cover 2+        (MonoidMap.nonNull n && nonNullCount n /= nonNullCount m)+        "MonoidMap.nonNull n && nonNullCount n /= nonNullCount m"+  where+    n = MonoidMap.filterKeys f m++prop_filterWithKey_get+    :: Test k v => Fun (k, v) Bool -> k -> MonoidMap k v -> Property+prop_filterWithKey_get (applyFun2 -> f) k m =+    MonoidMap.get k (MonoidMap.filterWithKey f m)+        ===+        (MonoidMap.get k m & \v -> if f k v then v else mempty)+    & cover 2+        (MonoidMap.nullKey k m && f k (MonoidMap.get k m))+        "MonoidMap.nullKey k m && f k (MonoidMap.get k m)"+    & cover 2+        (MonoidMap.nullKey k m && not (f k (MonoidMap.get k m)))+        "MonoidMap.nullKey k m && not (f k (MonoidMap.get k m))"+    & cover 2+        (MonoidMap.nonNullKey k m && f k (MonoidMap.get k m))+        "MonoidMap.nonNullKey k m && f k (MonoidMap.get k m)"+    & cover 2+        (MonoidMap.nonNullKey k m && not (f k (MonoidMap.get k m)))+        "MonoidMap.nonNullKey k m && not (f k (MonoidMap.get k m))"++prop_filterWithKey_asList+    :: Test k v => Fun (k, v) Bool -> MonoidMap k v -> Property+prop_filterWithKey_asList (applyFun2 -> f) m =+    n === MonoidMap.fromList (List.filter (uncurry f) (toList m))+    & cover 2+        (MonoidMap.nonNull n && nonNullCount n == nonNullCount m)+        "MonoidMap.nonNull n && nonNullCount n == nonNullCount m"+    & cover 2+        (MonoidMap.nonNull n && nonNullCount n /= nonNullCount m)+        "MonoidMap.nonNull n && nonNullCount n /= nonNullCount m"+  where+    n = MonoidMap.filterWithKey f m
+ src/test/Data/MonoidMap/IntersectionSpec.hs view
@@ -0,0 +1,193 @@+{- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Use camelCase" -}+{- HLINT ignore "Use null" -}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Data.MonoidMap.IntersectionSpec+    ( spec+    ) where++import Prelude++import Control.Monad+    ( forM_ )+import Data.Function+    ( (&) )+import Data.Functor.Identity+    ( Identity (..) )+import Data.Monoid.Cancellative+    ( GCDMonoid )+import Data.MonoidMap+    ( MonoidMap )+import Data.Proxy+    ( Proxy (..) )+import Test.Common+    ( Key+    , Test+    , TestType (TestType)+    , makeSpec+    , property+    , testTypesGCDMonoid+    , testTypesMonoidNull+    )+import Test.Hspec+    ( Spec, describe, it )+import Test.QuickCheck+    ( Fun (..), Property, applyFun2, conjoin, cover, expectFailure, (===) )++import qualified Data.Monoid.Null as Null+import qualified Data.MonoidMap as MonoidMap+import qualified Data.Set as Set++spec :: Spec+spec = describe "Intersection" $ do++    forM_ testTypesMonoidNull $+        \(TestType p) -> specMonoidNull+            (Proxy @Key) p+    forM_ testTypesGCDMonoid $+        \(TestType p) -> specGCDMonoid+            (Proxy @Key) p++specMonoidNull :: forall k v. Test k v => Proxy k -> Proxy v -> Spec+specMonoidNull = makeSpec $ do+    it "prop_intersectionWith_get" $+        prop_intersectionWith_get+            @k @v & property+    it "prop_intersectionWith_get_total" $+        prop_intersectionWith_get_total+            @k @v & property+    it "prop_intersectionWith_get_total_failure" $+        prop_intersectionWith_get_total_failure+            @k @v & property+    it "prop_intersectionWith_intersectionWithA" $+        prop_intersectionWith_intersectionWithA+            @k @v & property++specGCDMonoid+    :: forall k v. (Test k v, GCDMonoid v) => Proxy k -> Proxy v -> Spec+specGCDMonoid = makeSpec $ do+    it "prop_intersection_isSubmapOf" $+        prop_intersection_isSubmapOf+            @k @v & property++prop_intersection_isSubmapOf+    :: (Test k v, GCDMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Property+prop_intersection_isSubmapOf m1 m2 = conjoin+    [ intersection_m1_m2 `MonoidMap.isSubmapOf` m1+    , intersection_m1_m2 `MonoidMap.isSubmapOf` m2+    ]+    & cover 2+        (m1 /= m2 && MonoidMap.nonNull (intersection_m1_m2))+        "m1 /= m2 && MonoidMap.nonNull (intersection_m1_m2)"+  where+    intersection_m1_m2 = MonoidMap.intersection m1 m2++prop_intersectionWith_get+    :: Test k v+    => Fun (v, v) v+    -> MonoidMap k v+    -> MonoidMap k v+    -> k+    -> Property+prop_intersectionWith_get (applyFun2 -> f) m1 m2 k =+    (MonoidMap.get k result+        ===+        if keyWithinIntersection+        then f (MonoidMap.get k m1) (MonoidMap.get k m2)+        else mempty)+    & cover 2+        (keyWithinIntersection)+        "keyWithinIntersection"+    & cover 2+        (not keyWithinIntersection)+        "not keyWithinIntersection"+    & cover 2+        (MonoidMap.null result)+        "MonoidMap.null result"+    & cover 2+        (MonoidMap.nonNull result)+        "MonoidMap.nonNull result"+    & cover 2+        (MonoidMap.nullKey k result)+        "MonoidMap.nullKey k result"+    & cover 2+        (MonoidMap.nonNullKey k result)+        "MonoidMap.nonNullKey k result"+  where+    keyWithinIntersection =+        k `Set.member` Set.intersection+            (MonoidMap.nonNullKeys m1)+            (MonoidMap.nonNullKeys m2)+    result =+        MonoidMap.intersectionWith f m1 m2++prop_intersectionWith_get_total+    :: Test k v+    => Fun (v, v) v+    -> MonoidMap k v+    -> MonoidMap k v+    -> k+    -> Property+prop_intersectionWith_get_total (applyFun2 -> f0) m1 m2 k =+    (MonoidMap.get k result+        ===+        f (MonoidMap.get k m1) (MonoidMap.get k m2))+    & cover 2+        (keyWithinIntersection)+        "keyWithinIntersection"+    & cover 2+        (not keyWithinIntersection)+        "not keyWithinIntersection"+    & cover 2+        (MonoidMap.null result)+        "MonoidMap.null result"+    & cover 2+        (MonoidMap.nonNull result)+        "MonoidMap.nonNull result"+    & cover 2+        (MonoidMap.nullKey k result)+        "MonoidMap.nullKey k result"+    & cover 2+        (MonoidMap.nonNullKey k result)+        "MonoidMap.nonNullKey k result"+  where+    result =+        MonoidMap.intersectionWith f m1 m2+    keyWithinIntersection =+        k `Set.member` Set.intersection+            (MonoidMap.nonNullKeys m1)+            (MonoidMap.nonNullKeys m2)+    f v1 v2+        | Null.null v1 = mempty+        | Null.null v2 = mempty+        | otherwise = f0 v1 v2++prop_intersectionWith_get_total_failure+    :: Test k v+    => Fun (v, v) v+    -> MonoidMap k v+    -> MonoidMap k v+    -> k+    -> Property+prop_intersectionWith_get_total_failure (applyFun2 -> f) m1 m2 k =+    expectFailure $+    MonoidMap.get k (MonoidMap.intersectionWith f m1 m2)+        ===+        f (MonoidMap.get k m1) (MonoidMap.get k m2)++prop_intersectionWith_intersectionWithA+    :: Test k v+    => Fun (v, v) v+    -> MonoidMap k v+    -> MonoidMap k v+    -> Property+prop_intersectionWith_intersectionWithA (applyFun2 -> f) m1 m2 =+    runIdentity (MonoidMap.intersectionWithA ((fmap . fmap) Identity f) m1 m2)+    ===         (MonoidMap.intersectionWith                          f  m1 m2)
+ src/test/Data/MonoidMap/MapSpec.hs view
@@ -0,0 +1,219 @@+{- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Use camelCase" -}+{- HLINT ignore "Use null" -}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Data.MonoidMap.MapSpec+    ( spec+    ) where++import Prelude++import Control.Monad+    ( forM_ )+import Data.Bifunctor+    ( first, second )+import Data.Function+    ( (&) )+import Data.Monoid.Null+    ( MonoidNull )+import Data.MonoidMap+    ( MonoidMap, nonNullCount )+import Data.Proxy+    ( Proxy (..) )+import Test.Common+    ( Key, Test, TestType (TestType), makeSpec, property, testTypesMonoidNull )+import Test.Hspec+    ( Spec, describe, it )+import Test.QuickCheck+    ( Fun (..), Property, applyFun, applyFun2, cover, expectFailure, (===) )++import qualified Data.Foldable as F+import qualified Data.Monoid.Null as Null+import qualified Data.MonoidMap as MonoidMap+import qualified Data.Set as Set++spec :: Spec+spec = describe "Mapping" $ do++    forM_ testTypesMonoidNull $ \(TestType p) -> specFor (Proxy @Key) p++specFor :: forall k v. Test k v => Proxy k -> Proxy v -> Spec+specFor = makeSpec $ do++    it "prop_map_asList" $+        prop_map_asList+            @k @v & property+    it "prop_map_composition" $+        prop_map_composition+            @k @v & property+    it "prop_map_composition_failure" $+        prop_map_composition_failure+            @k @v & property+    it "prop_map_get" $+        prop_map_get+            @k @v & property+    it "prop_map_get_total" $+        prop_map_get_total+            @k @v & property+    it "prop_map_get_total_failure" $+        prop_map_get_total_failure+            @k @v & property+    it "prop_mapKeys_asList" $+        prop_mapKeys_asList+            @k @v & property+    it "prop_mapKeys_get" $+        prop_mapKeys_get+            @k @v & property+    it "prop_mapKeysWith_asList" $+        prop_mapKeysWith_asList+            @k @v & property++--------------------------------------------------------------------------------+-- Mapping+--------------------------------------------------------------------------------++prop_map_asList+    :: Test k v+    => Fun v v+    -> MonoidMap k v+    -> Property+prop_map_asList (applyFun -> f) m =+    n === (MonoidMap.fromList . fmap (second f) . MonoidMap.toList $ m)+    & cover 2+        (0 < nonNullCount n && nonNullCount n < nonNullCount m)+        "0 < nonNullCount n && nonNullCount n < nonNullCount m"+  where+    n = MonoidMap.map f m++prop_map_composition+    :: forall k v. Test k v+    => Fun v v+    -> Fun v v+    -> MonoidMap k v+    -> Property+prop_map_composition (applyFun -> f0) (applyFun -> g0) m =+    MonoidMap.map (f . g) m === MonoidMap.map f (MonoidMap.map g m)+    & cover 2+        (MonoidMap.nonNull m)+        "MonoidMap.nonNull m"+  where+    f = toNullPreservingFn f0+    g = g0++prop_map_composition_failure+    :: forall k v. Test k v+    => Fun v v+    -> Fun v v+    -> MonoidMap k v+    -> Property+prop_map_composition_failure (applyFun -> f) (applyFun -> g) m =+    expectFailure $+    MonoidMap.map (f . g) m === MonoidMap.map f (MonoidMap.map g m)+    & cover 1+        (MonoidMap.map (f . g) m /= MonoidMap.map f (MonoidMap.map g m))+        "MonoidMap.map (f . g) m /= MonoidMap.map f (MonoidMap.map g m)"++prop_map_get+    :: Test k v+    => Fun v v+    -> k+    -> MonoidMap k v+    -> Property+prop_map_get (applyFun -> f) k m =+    MonoidMap.get k (MonoidMap.map f m)+    ===+    (if MonoidMap.nullKey k m then mempty else f (MonoidMap.get k m))+    & cover 2+        (MonoidMap.nullKey k m)+        "MonoidMap.nullKey k m"+    & cover 2+        (MonoidMap.nonNullKey k m)+        "MonoidMap.nonNullKey k m"++prop_map_get_total+    :: forall k v. Test k v+    => Fun v v+    -> k+    -> MonoidMap k v+    -> Property+prop_map_get_total (applyFun -> f0) k m =+    MonoidMap.get k (MonoidMap.map f m) === f (MonoidMap.get k m)+    & cover 2+        (MonoidMap.nullKey k m)+        "MonoidMap.nullKey k m"+    & cover 2+        (MonoidMap.nonNullKey k m)+        "MonoidMap.nonNullKey k m"+  where+    f = toNullPreservingFn f0++prop_map_get_total_failure+    :: Test k v+    => Fun v v+    -> k+    -> MonoidMap k v+    -> Property+prop_map_get_total_failure (applyFun -> f) k m =+    expectFailure $+    MonoidMap.get k (MonoidMap.map f m) === f (MonoidMap.get k m)++prop_mapKeys_asList+    :: Test k v+    => Fun k k+    -> MonoidMap k v+    -> Property+prop_mapKeys_asList (applyFun -> f) m =+    n === (MonoidMap.fromList . fmap (first f) . MonoidMap.toList $ m)+    & cover 2+        (0 < nonNullCount n && nonNullCount n < nonNullCount m)+        "0 < nonNullCount n && nonNullCount n < nonNullCount m"+  where+    n = MonoidMap.mapKeys f m++prop_mapKeys_get+    :: Test k v+    => Fun k k+    -> k+    -> MonoidMap k v+    -> Property+prop_mapKeys_get (applyFun -> f) k m =+    MonoidMap.get k (MonoidMap.mapKeys f m)+        ===+        F.foldMap+            (`MonoidMap.get` m)+            (Set.filter ((==) k . f) (MonoidMap.nonNullKeys m))+    & cover 2+        (MonoidMap.nullKey k (MonoidMap.mapKeys f m))+        "MonoidMap.nullKey k (MonoidMap.mapKeys f m)"+    & cover 2+        (MonoidMap.nonNullKey k (MonoidMap.mapKeys f m))+        "MonoidMap.nonNullKey k (MonoidMap.mapKeys f m)"++prop_mapKeysWith_asList+    :: Test k v+    => Fun (v, v) v+    -> Fun k k+    -> MonoidMap k v+    -> Property+prop_mapKeysWith_asList (applyFun2 -> c) (applyFun -> f) m =+    n === (MonoidMap.fromListWith c . fmap (first f) . MonoidMap.toList $ m)+    & cover 2+        (0 < nonNullCount n && nonNullCount n < nonNullCount m)+        "0 < nonNullCount n && nonNullCount n < nonNullCount m"+  where+    n = MonoidMap.mapKeysWith c f m++--------------------------------------------------------------------------------+-- Utilities+--------------------------------------------------------------------------------++-- | Creates a function that never maps null values to non-null values.+--+toNullPreservingFn :: MonoidNull v => (v -> v) -> (v -> v)+toNullPreservingFn f v+    | Null.null v = v+    | otherwise = f v
+ src/test/Data/MonoidMap/MembershipSpec.hs view
@@ -0,0 +1,99 @@+{- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Use camelCase" -}+{- HLINT ignore "Use null" -}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Data.MonoidMap.MembershipSpec+    ( spec+    ) where++import Prelude++import Control.Monad+    ( forM_ )+import Data.Function+    ( (&) )+import Data.MonoidMap+    ( MonoidMap )+import Data.Proxy+    ( Proxy (..) )+import Test.Common+    ( Key, Test, TestType (TestType), makeSpec, property, testTypesMonoidNull )+import Test.Hspec+    ( Spec, describe, it )+import Test.QuickCheck+    ( Property, cover, (===) )++import qualified Data.MonoidMap as MonoidMap+import qualified Data.Set as Set++spec :: Spec+spec = describe "Membership" $ do++    forM_ testTypesMonoidNull $ \(TestType p) -> specFor (Proxy @Key) p++specFor :: forall k v. Test k v => Proxy k -> Proxy v -> Spec+specFor = makeSpec $ do++    it "prop_nullify_get" $+        prop_nullify_get+            @k @v & property+    it "prop_nullify_nonNullKey" $+        prop_nullify_nonNullKey+            @k @v & property+    it "prop_nullify_nonNullKeys" $+        prop_nullify_nonNullKeys+            @k @v & property+    it "prop_nonNullKeys_get" $+        prop_nonNullKeys_get+            @k @v & property++prop_nullify_get+    :: Test k v => MonoidMap k v -> k -> Property+prop_nullify_get m k =+    MonoidMap.get k (MonoidMap.nullify k m) === mempty+    & cover 2+        (MonoidMap.nonNullKey k m)+        "MonoidMap.nonNullKey k m"+    & cover 2+        (not (MonoidMap.nonNullKey k m))+        "not (MonoidMap.nonNullKey k m)"++prop_nullify_nonNullKey+    :: Test k v => MonoidMap k v -> k -> Property+prop_nullify_nonNullKey m k =+    MonoidMap.nonNullKey k (MonoidMap.nullify k m) === False+    & cover 2+        (MonoidMap.nonNullKey k m)+        "MonoidMap.nonNullKey k m"+    & cover 2+        (not (MonoidMap.nonNullKey k m))+        "not (MonoidMap.nonNullKey k m)"++prop_nullify_nonNullKeys+    :: Test k v => MonoidMap k v -> k -> Property+prop_nullify_nonNullKeys m k =+    Set.member k (MonoidMap.nonNullKeys (MonoidMap.nullify k m)) === False+    & cover 2+        (MonoidMap.nonNullKey k m)+        "MonoidMap.nonNullKey k m"+    & cover 2+        (not (MonoidMap.nonNullKey k m))+        "not (MonoidMap.nonNullKey k m)"++prop_nonNullKeys_get+    :: Test k v => MonoidMap k v -> Property+prop_nonNullKeys_get m =+    fmap+        (\k -> (k, MonoidMap.get k m))+        (Set.toList (MonoidMap.nonNullKeys m))+        === MonoidMap.toList m+    & cover 2+        (MonoidMap.null m)+        "MonoidMap.null m"+    & cover 2+        (not (MonoidMap.null m))+        "not (MonoidMap.null m)"
+ src/test/Data/MonoidMap/PartitionSpec.hs view
@@ -0,0 +1,166 @@+{- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Use camelCase" -}+{- HLINT ignore "Use null" -}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Data.MonoidMap.PartitionSpec+    ( spec+    ) where++import Prelude++import Control.Monad+    ( forM_ )+import Data.Function+    ( (&) )+import Data.MonoidMap+    ( MonoidMap )+import Data.Proxy+    ( Proxy (..) )+import Test.Common+    ( Key, Test, TestType (TestType), makeSpec, property, testTypesMonoidNull )+import Test.Hspec+    ( Spec, describe, it )+import Test.QuickCheck+    ( Fun (..), Property, applyFun, applyFun2, cover, (===) )++import qualified Data.MonoidMap as MonoidMap+import qualified Data.Set as Set++spec :: Spec+spec = describe "Partitioning" $ do++    forM_ testTypesMonoidNull $ \(TestType p) -> specFor (Proxy @Key) p++specFor :: forall k v. Test k v => Proxy k -> Proxy v -> Spec+specFor = makeSpec $ do++    it "prop_partition_filter" $+        prop_partition_filter+            @k @v & property+    it "prop_partition_append" $+        prop_partition_append+            @k @v & property+    it "prop_partition_disjoint" $+        prop_partition_disjoint+            @k @v & property+    it "prop_partitionKeys_filterKeys" $+        prop_partitionKeys_filterKeys+            @k @v & property+    it "prop_partitionKeys_append" $+        prop_partitionKeys_append+            @k @v & property+    it "prop_partitionKeys_disjoint" $+        prop_partitionKeys_disjoint+            @k @v & property+    it "prop_partitionWithKey_filterWithKey" $+        prop_partitionWithKey_filterWithKey+            @k @v & property+    it "prop_partitionWithKey_append" $+        prop_partitionWithKey_append+            @k @v & property+    it "prop_partitionWithKey_disjoint" $+        prop_partitionWithKey_disjoint+            @k @v & property++prop_partition_filter+    :: Test k v => Fun v Bool -> MonoidMap k v -> Property+prop_partition_filter (applyFun -> f) m =+    MonoidMap.partition f m === (m1, m2)+    & cover 2+        (MonoidMap.nonNull m1 && MonoidMap.nonNull m2)+        "MonoidMap.nonNull m1 && MonoidMap.nonNull m2"+  where+    m1 = MonoidMap.filter f m+    m2 = MonoidMap.filter (not . f) m++prop_partition_append+    :: Test k v => Fun v Bool -> MonoidMap k v -> Property+prop_partition_append (applyFun -> f) m =+    m1 <> m2 === m+    & cover 2+        (MonoidMap.nonNull m1 && MonoidMap.nonNull m2)+        "MonoidMap.nonNull m1 && MonoidMap.nonNull m2"+  where+    (m1, m2) = MonoidMap.partition f m++prop_partition_disjoint+    :: Test k v => Fun v Bool -> MonoidMap k v -> Property+prop_partition_disjoint (applyFun -> f) m =+    Set.disjoint+        (MonoidMap.nonNullKeys m1)+        (MonoidMap.nonNullKeys m2)+    & cover 2+        (MonoidMap.nonNull m1 && MonoidMap.nonNull m2)+        "MonoidMap.nonNull m1 && MonoidMap.nonNull m2"+  where+    (m1, m2) = MonoidMap.partition f m++prop_partitionKeys_filterKeys+    :: Test k v => Fun k Bool -> MonoidMap k v -> Property+prop_partitionKeys_filterKeys (applyFun -> f) m =+    MonoidMap.partitionKeys f m === (m1, m2)+    & cover 2+        (MonoidMap.nonNull m1 && MonoidMap.nonNull m2)+        "MonoidMap.nonNull m1 && MonoidMap.nonNull m2"+  where+    m1 = MonoidMap.filterKeys f m+    m2 = MonoidMap.filterKeys (not . f) m++prop_partitionKeys_append+    :: Test k v => Fun k Bool -> MonoidMap k v -> Property+prop_partitionKeys_append (applyFun -> f) m =+    m1 <> m2 === m+    & cover 2+        (MonoidMap.nonNull m1 && MonoidMap.nonNull m2)+        "MonoidMap.nonNull m1 && MonoidMap.nonNull m2"+  where+    (m1, m2) = MonoidMap.partitionKeys f m++prop_partitionKeys_disjoint+    :: Test k v => Fun k Bool -> MonoidMap k v -> Property+prop_partitionKeys_disjoint (applyFun -> f) m =+    Set.disjoint+        (MonoidMap.nonNullKeys m1)+        (MonoidMap.nonNullKeys m2)+    & cover 2+        (MonoidMap.nonNull m1 && MonoidMap.nonNull m2)+        "MonoidMap.nonNull m1 && MonoidMap.nonNull m2"+  where+    (m1, m2) = MonoidMap.partitionKeys f m++prop_partitionWithKey_filterWithKey+    :: Test k v => Fun (k, v) Bool -> MonoidMap k v -> Property+prop_partitionWithKey_filterWithKey (applyFun2 -> f) m =+    MonoidMap.partitionWithKey f m === (m1, m2)+    & cover 2+        (MonoidMap.nonNull m1 && MonoidMap.nonNull m2)+        "MonoidMap.nonNull m1 && MonoidMap.nonNull m2"+  where+    m1 = MonoidMap.filterWithKey f m+    m2 = MonoidMap.filterWithKey ((fmap . fmap) not f) m++prop_partitionWithKey_append+    :: Test k v => Fun (k, v) Bool -> MonoidMap k v -> Property+prop_partitionWithKey_append (applyFun2 -> f) m =+    m1 <> m2 === m+    & cover 2+        (MonoidMap.nonNull m1 && MonoidMap.nonNull m2)+        "MonoidMap.nonNull m1 && MonoidMap.nonNull m2"+  where+    (m1, m2) = MonoidMap.partitionWithKey f m++prop_partitionWithKey_disjoint+    :: Test k v => Fun (k, v) Bool -> MonoidMap k v -> Property+prop_partitionWithKey_disjoint (applyFun2 -> f) m =+    Set.disjoint+        (MonoidMap.nonNullKeys m1)+        (MonoidMap.nonNullKeys m2)+    & cover 2+        (MonoidMap.nonNull m1 && MonoidMap.nonNull m2)+        "MonoidMap.nonNull m1 && MonoidMap.nonNull m2"+  where+    (m1, m2) = MonoidMap.partitionWithKey f m
+ src/test/Data/MonoidMap/PrefixSpec.hs view
@@ -0,0 +1,80 @@+{- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Use camelCase" -}+{- HLINT ignore "Use null" -}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Data.MonoidMap.PrefixSpec+    ( spec+    ) where++import Prelude++import Control.Monad+    ( forM_ )+import Data.Function+    ( (&) )+import Data.Maybe+    ( isJust )+import Data.MonoidMap+    ( MonoidMap )+import Data.Proxy+    ( Proxy (..) )+import Data.Semigroup.Cancellative+    ( LeftReductive (..) )+import Test.Common+    ( Key+    , Test+    , TestType (TestType)+    , makeSpec+    , property+    , testTypesLeftReductive+    )+import Test.Hspec+    ( Spec, describe, it )+import Test.QuickCheck+    ( Property, cover, (===) )++import qualified Test.QuickCheck as QC++spec :: Spec+spec = describe "Prefixes" $ do++    forM_ testTypesLeftReductive $+        \(TestType p) -> specFor (Proxy @Key) p++specFor+    :: forall k v. (Test k v, LeftReductive v) => Proxy k -> Proxy v -> Spec+specFor = makeSpec $ do+    it "prop_stripPrefix_isJust" $+        prop_stripPrefix_isJust+            @k @v & property+    it "prop_stripPrefix_mappend" $+        prop_stripPrefix_mappend+            @k @v & property++prop_stripPrefix_isJust+    :: (Test k v, LeftReductive v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Property+prop_stripPrefix_isJust m1 m2 =+    isJust (stripPrefix m1 m2) === m1 `isPrefixOf` m2+    & cover 1+        (m1 `isPrefixOf` m2)+        "m1 `isPrefixOf` m2"++prop_stripPrefix_mappend+    :: (Test k v, LeftReductive v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Property+prop_stripPrefix_mappend m1 m2 = QC.property $+    all+        (\r -> m1 <> r == m2)+        (stripPrefix m1 m2)+    & cover 1+        (isJust (stripPrefix m1 m2))+        "isJust (stripPrefix m1 m2)"
+ src/test/Data/MonoidMap/SingletonSpec.hs view
@@ -0,0 +1,141 @@+{- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Use camelCase" -}+{- HLINT ignore "Use null" -}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Data.MonoidMap.SingletonSpec+    ( spec+    ) where++import Prelude++import Data.Function+    ( (&) )+import Data.MonoidMap+    ( nonNullCount )+import Data.Proxy+    ( Proxy (..) )+import Test.Common+    ( Key, Test, TestType (TestType), makeSpec, property, testTypesMonoidNull )+import Test.Hspec+    ( Spec, describe, it )+import Test.QuickCheck+    ( Property, cover, (===) )++import Control.Monad+    ( forM_ )+import qualified Data.MonoidMap as MonoidMap+import qualified Data.Set as Set++spec :: Spec+spec = describe "Singletons" $ do++    forM_ testTypesMonoidNull $ \(TestType p) -> specFor (Proxy @Key) p++specFor :: forall k v. Test k v => Proxy k -> Proxy v -> Spec+specFor = makeSpec $ do++    it "prop_singleton_get" $+        prop_singleton_get+            @k @v & property+    it "prop_singleton_nonNullKey" $+        prop_singleton_nonNullKey+            @k @v & property+    it "prop_singleton_nonNullKeys" $+        prop_singleton_nonNullKeys+            @k @v & property+    it "prop_singleton_null" $+        prop_singleton_null+            @k @v & property+    it "prop_singleton_nullify" $+        prop_singleton_nullify+            @k @v & property+    it "prop_singleton_nonNullCount" $+        prop_singleton_nonNullCount+            @k @v & property+    it "prop_singleton_toList" $+        prop_singleton_toList+            @k @v & property++prop_singleton_get+    :: Test k v => k -> v -> Property+prop_singleton_get k v =+    MonoidMap.get k (MonoidMap.singleton k v) === v+    & cover 2+        (v == mempty)+        "v == mempty"+    & cover 2+        (v /= mempty)+        "v /= mempty"++prop_singleton_nonNullKey+    :: Test k v => k -> v -> Property+prop_singleton_nonNullKey k v =+    MonoidMap.nonNullKey k (MonoidMap.singleton k v) === (v /= mempty)+    & cover 2+        (v == mempty)+        "v == mempty"+    & cover 2+        (v /= mempty)+        "v /= mempty"++prop_singleton_nonNullKeys+    :: Test k v => k -> v -> Property+prop_singleton_nonNullKeys k v =+    MonoidMap.nonNullKeys (MonoidMap.singleton k v) ===+        (if v == mempty then Set.empty else Set.singleton k)+    & cover 2+        (v == mempty)+        "v == mempty"+    & cover 2+        (v /= mempty)+        "v /= mempty"++prop_singleton_null+    :: Test k v => k -> v -> Property+prop_singleton_null k v =+    MonoidMap.null (MonoidMap.singleton k v) === (v == mempty)+    & cover 2+        (v == mempty)+        "v == mempty"+    & cover 2+        (v /= mempty)+        "v /= mempty"++prop_singleton_nullify+    :: Test k v => k -> v -> Property+prop_singleton_nullify k v =+    MonoidMap.nullify k (MonoidMap.singleton k v) === mempty+    & cover 2+        (v == mempty)+        "v == mempty"+    & cover 2+        (v /= mempty)+        "v /= mempty"++prop_singleton_nonNullCount+    :: Test k v => k -> v -> Property+prop_singleton_nonNullCount k v =+    nonNullCount (MonoidMap.singleton k v) ===+        (if v == mempty then 0 else 1)+    & cover 2+        (v == mempty)+        "v == mempty"+    & cover 2+        (v /= mempty)+        "v /= mempty"++prop_singleton_toList+    :: Test k v => k -> v -> Property+prop_singleton_toList k v =+    MonoidMap.toList (MonoidMap.singleton k v) ===+        [(k, v) | v /= mempty]+    & cover 2+        (v == mempty)+        "v == mempty"+    & cover 2+        (v /= mempty)+        "v /= mempty"
+ src/test/Data/MonoidMap/SliceSpec.hs view
@@ -0,0 +1,132 @@+{- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Use camelCase" -}+{- HLINT ignore "Use null" -}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Data.MonoidMap.SliceSpec+    ( spec+    , Slice (..)+    ) where++import Prelude++import Control.Monad+    ( forM_ )+import Data.Bifunctor+    ( Bifunctor (bimap) )+import Data.Function+    ( (&) )+import Data.Monoid.Null+    ( MonoidNull )+import Data.MonoidMap+    ( MonoidMap, nonNullCount )+import Data.Proxy+    ( Proxy (..) )+import GHC.Exts+    ( IsList (..) )+import Test.Common+    ( Key, Test, TestType (TestType), makeSpec, property, testTypesMonoidNull )+import Test.Hspec+    ( Spec, describe, it )+import Test.QuickCheck+    ( Arbitrary (..), Gen, Property, choose, cover, oneof, (===) )++import qualified Data.MonoidMap as MonoidMap++spec :: Spec+spec = describe "Slicing" $ do++    forM_ testTypesMonoidNull $ \(TestType p) -> specFor (Proxy @Key) p++specFor :: forall k v. Test k v => Proxy k -> Proxy v -> Spec+specFor = makeSpec $ do++    it "prop_take_toList_fromList" $+        prop_take_toList_fromList+            @k @v & property+    it "prop_drop_toList_fromList" $+        prop_drop_toList_fromList+            @k @v & property+    it "prop_splitAt_toList_fromList" $+        prop_splitAt_toList_fromList+            @k @v & property++data Slice k v = Slice Int (MonoidMap k v)+    deriving (Eq, Show)++instance (Arbitrary k, Arbitrary v, MonoidNull v, Ord k) =>+    Arbitrary (Slice k v)+  where+    arbitrary = do+        m <- genMap+        i <- genIndex m+        pure $ Slice i m+      where+        genMap :: Gen (MonoidMap k v)+        genMap = arbitrary++        genIndex :: MonoidMap k v -> Gen Int+        genIndex m = oneof+            [ choose (negate (length m), -1)+            , pure 0+            , choose (1, length m - 1)+            , pure (length m)+            , choose (length m + 1, 2 * length m)+            ]++prop_take_toList_fromList+    :: Test k v => Slice k v -> Property+prop_take_toList_fromList (Slice i m) =+    MonoidMap.take i m+        === (fromList . Prelude.take i . toList) m+    & cover 2+        (i == 0 && 0 < nonNullCount m)+        "i == 0 && 0 < nonNullCount m"+    & cover 2+        (0 < i && i < nonNullCount m)+        "0 < i && i < nonNullCount m"+    & cover 2+        (0 < nonNullCount m && nonNullCount m == i)+        "0 < nonNullCount m && nonNullCount m == i"+    & cover 2+        (0 < nonNullCount m && nonNullCount m < i)+        "0 < nonNullCount m && nonNullCount m < i"++prop_drop_toList_fromList+    :: Test k v => Slice k v -> Property+prop_drop_toList_fromList (Slice i m) =+    MonoidMap.drop i m+        === (fromList . Prelude.drop i . toList) m+    & cover 2+        (i == 0 && 0 < nonNullCount m)+        "i == 0 && 0 < nonNullCount m"+    & cover 2+        (0 < i && i < nonNullCount m)+        "0 < i && i < nonNullCount m"+    & cover 2+        (0 < nonNullCount m && nonNullCount m == i)+        "0 < nonNullCount m && nonNullCount m == i"+    & cover 2+        (0 < nonNullCount m && nonNullCount m < i)+        "0 < nonNullCount m && nonNullCount m < i"++prop_splitAt_toList_fromList+    :: Test k v => Slice k v -> Property+prop_splitAt_toList_fromList (Slice i m) =+    MonoidMap.splitAt i m+        === (bimap fromList fromList . Prelude.splitAt i . toList) m+    & cover 2+        (i == 0 && 0 < nonNullCount m)+        "i == 0 && 0 < nonNullCount m"+    & cover 2+        (0 < i && i < nonNullCount m)+        "0 < i && i < nonNullCount m"+    & cover 2+        (0 < nonNullCount m && nonNullCount m == i)+        "0 < nonNullCount m && nonNullCount m == i"+    & cover 2+        (0 < nonNullCount m && nonNullCount m < i)+        "0 < nonNullCount m && nonNullCount m < i"
+ src/test/Data/MonoidMap/SuffixSpec.hs view
@@ -0,0 +1,80 @@+{- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Use camelCase" -}+{- HLINT ignore "Use null" -}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Data.MonoidMap.SuffixSpec+    ( spec+    ) where++import Prelude++import Control.Monad+    ( forM_ )+import Data.Function+    ( (&) )+import Data.Maybe+    ( isJust )+import Data.MonoidMap+    ( MonoidMap )+import Data.Proxy+    ( Proxy (..) )+import Data.Semigroup.Cancellative+    ( RightReductive (..) )+import Test.Common+    ( Key+    , Test+    , TestType (TestType)+    , makeSpec+    , property+    , testTypesRightReductive+    )+import Test.Hspec+    ( Spec, describe, it )+import Test.QuickCheck+    ( Property, cover, (===) )++import qualified Test.QuickCheck as QC++spec :: Spec+spec = describe "Suffixes" $ do++    forM_ testTypesRightReductive $+        \(TestType p) -> specFor (Proxy @Key) p++specFor+    :: forall k v. (Test k v, RightReductive v) => Proxy k -> Proxy v -> Spec+specFor = makeSpec $ do+    it "prop_stripSuffix_isJust" $+        prop_stripSuffix_isJust+            @k @v & property+    it "prop_stripSuffix_mappend" $+        prop_stripSuffix_mappend+            @k @v & property++prop_stripSuffix_isJust+    :: (Test k v, RightReductive v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Property+prop_stripSuffix_isJust m1 m2 =+    isJust (stripSuffix m1 m2) === m1 `isSuffixOf` m2+    & cover 1+        (m1 `isSuffixOf` m2)+        "m1 `isSuffixOf` m2"++prop_stripSuffix_mappend+    :: (Test k v, RightReductive v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Property+prop_stripSuffix_mappend m1 m2 = QC.property $+    all+        (\r -> r <> m1 == m2)+        (stripSuffix m1 m2)+    & cover 1+        (isJust (stripSuffix m1 m2))+        "isJust (stripSuffix m1 m2)"
+ src/test/Data/MonoidMap/UnionSpec.hs view
@@ -0,0 +1,192 @@+{- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Use camelCase" -}+{- HLINT ignore "Use null" -}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Data.MonoidMap.UnionSpec+    ( spec+    ) where++import Prelude++import Control.Monad+    ( forM_ )+import Data.Function+    ( (&) )+import Data.Functor.Identity+    ( Identity (..) )+import Data.Monoid.LCM+    ( LCMMonoid )+import Data.MonoidMap+    ( MonoidMap )+import Data.Proxy+    ( Proxy (..) )+import Test.Common+    ( Key+    , Test+    , TestType (TestType)+    , makeSpec+    , property+    , testTypesLCMMonoid+    , testTypesMonoidNull+    )+import Test.Hspec+    ( Spec, describe, it )+import Test.QuickCheck+    ( Fun (..), Property, applyFun2, conjoin, cover, expectFailure, (===) )++import qualified Data.Monoid.Null as Null+import qualified Data.MonoidMap as MonoidMap+import qualified Data.Set as Set++spec :: Spec+spec = describe "Union" $ do++    forM_ testTypesMonoidNull $+        \(TestType p) -> specMonoidNull+            (Proxy @Key) p+    forM_ testTypesLCMMonoid $+        \(TestType p) -> specLCMMonoid+            (Proxy @Key) p++specMonoidNull :: forall k v. Test k v => Proxy k -> Proxy v -> Spec+specMonoidNull = makeSpec $ do+    it "prop_unionWith_get" $+        prop_unionWith_get+            @k @v & property+    it "prop_unionWith_get_total" $+        prop_unionWith_get_total+            @k @v & property+    it "prop_unionWith_get_total_failure" $+        prop_unionWith_get_total_failure+            @k @v & property+    it "prop_unionWith_unionWithA" $+        prop_unionWith_unionWithA+            @k @v & property++specLCMMonoid+    :: forall k v. (Test k v, LCMMonoid v) => Proxy k -> Proxy v -> Spec+specLCMMonoid = makeSpec $ do+    it "prop_union_isSubmapOf" $+        prop_union_isSubmapOf+            @k @v & property++prop_union_isSubmapOf+    :: (Test k v, LCMMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Property+prop_union_isSubmapOf m1 m2 = conjoin+    [ m1 `MonoidMap.isSubmapOf` union_m1_m2+    , m2 `MonoidMap.isSubmapOf` union_m1_m2+    ]+    & cover 2+        (m1 /= m2 && MonoidMap.nonNull (union_m1_m2))+        "m1 /= m2 && MonoidMap.nonNull (union_m1_m2)"+  where+    union_m1_m2 = MonoidMap.union m1 m2++prop_unionWith_get+    :: Test k v+    => Fun (v, v) v+    -> MonoidMap k v+    -> MonoidMap k v+    -> k+    -> Property+prop_unionWith_get (applyFun2 -> f) m1 m2 k =+    (MonoidMap.get k result+        ===+        if keyWithinUnion+        then f (MonoidMap.get k m1) (MonoidMap.get k m2)+        else mempty)+    & cover 2+        (keyWithinUnion)+        "keyWithinUnion"+    & cover 2+        (not keyWithinUnion)+        "not keyWithinUnion"+    & cover 2+        (MonoidMap.null result)+        "MonoidMap.null result"+    & cover 2+        (MonoidMap.nonNull result)+        "MonoidMap.nonNull result)"+    & cover 2+        (MonoidMap.nullKey k result)+        "MonoidMap.nullKey k result"+    & cover 2+        (MonoidMap.nonNullKey k result)+        "MonoidMap.nonNullKey k result"+  where+    keyWithinUnion =+        k `Set.member` Set.union+            (MonoidMap.nonNullKeys m1)+            (MonoidMap.nonNullKeys m2)+    result =+        MonoidMap.unionWith f m1 m2++prop_unionWith_get_total+    :: Test k v+    => Fun (v, v) v+    -> MonoidMap k v+    -> MonoidMap k v+    -> k+    -> Property+prop_unionWith_get_total (applyFun2 -> f0) m1 m2 k =+    (MonoidMap.get k result+        ===+        f (MonoidMap.get k m1) (MonoidMap.get k m2))+    & cover 2+        (keyWithinUnion)+        "keyWithinUnion"+    & cover 2+        (not keyWithinUnion)+        "not keyWithinUnion"+    & cover 2+        (MonoidMap.null result)+        "MonoidMap.null result"+    & cover 2+        (MonoidMap.nonNull result)+        "MonoidMap.nonNull result)"+    & cover 2+        (MonoidMap.nullKey k result)+        "MonoidMap.nullKey k result"+    & cover 2+        (MonoidMap.nonNullKey k result)+        "MonoidMap.nonNullKey k result"+  where+    keyWithinUnion =+        k `Set.member` Set.union+            (MonoidMap.nonNullKeys m1)+            (MonoidMap.nonNullKeys m2)+    result =+        MonoidMap.unionWith f m1 m2+    f v1 v2+        | Null.null v1 && Null.null v2 = mempty+        | otherwise = f0 v1 v2++prop_unionWith_get_total_failure+    :: Test k v+    => Fun (v, v) v+    -> MonoidMap k v+    -> MonoidMap k v+    -> k+    -> Property+prop_unionWith_get_total_failure (applyFun2 -> f) m1 m2 k =+    expectFailure $+    MonoidMap.get k (MonoidMap.unionWith f m1 m2)+        ===+        f (MonoidMap.get k m1) (MonoidMap.get k m2)++prop_unionWith_unionWithA+    :: Test k v+    => Fun (v, v) v+    -> MonoidMap k v+    -> MonoidMap k v+    -> Property+prop_unionWith_unionWithA (applyFun2 -> f) m1 m2 =+    runIdentity (MonoidMap.unionWithA ((fmap . fmap) Identity f) m1 m2)+    ===         (MonoidMap.unionWith                          f  m1 m2)
+ src/test/Data/MonoidMap/ValiditySpec.hs view
@@ -0,0 +1,620 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE RankNTypes #-}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Data.MonoidMap.ValiditySpec+    ( spec+    ) where++import Prelude++import Control.Monad+    ( forM_ )+import Data.Data+    ( Proxy (Proxy) )+import Data.Function+    ( (&) )+import Data.Group+    ( Group )+import Data.Map.Strict+    ( Map )+import Data.Maybe+    ( isJust )+import Data.Monoid.Cancellative+    ( GCDMonoid+    , LeftGCDMonoid+    , LeftReductive+    , OverlappingGCDMonoid+    , Reductive+    , RightGCDMonoid+    , RightReductive+    )+import Data.Monoid.LCM+    ( LCMMonoid )+import Data.Monoid.Monus+    ( Monus )+import Data.MonoidMap+    ( MonoidMap )+import Data.MonoidMap.SliceSpec+    ( Slice (..) )+import Test.Common+    ( Key+    , Test+    , TestType (TestType)+    , makeSpec+    , property+    , testTypesGCDMonoid+    , testTypesGroup+    , testTypesLCMMonoid+    , testTypesLeftGCDMonoid+    , testTypesLeftReductive+    , testTypesMonoidNull+    , testTypesMonus+    , testTypesOverlappingGCDMonoid+    , testTypesReductive+    , testTypesRightGCDMonoid+    , testTypesRightReductive+    )+import Test.Hspec+    ( Spec, it )+import Test.QuickCheck+    ( Fun, Property, applyFun, applyFun2, conjoin, counterexample, cover )++import qualified Data.Map.Strict as Map+import qualified Data.Monoid.Null as Null+import qualified Data.MonoidMap as MonoidMap++spec :: Spec+spec = do+    specForAll+        testTypesMonoidNull+        specValidMonoidNull+    specForAll+        testTypesLeftReductive+        specValidLeftReductive+    specForAll+        testTypesRightReductive+        specValidRightReductive+    specForAll+        testTypesReductive+        specValidReductive+    specForAll+        testTypesLeftGCDMonoid+        specValidLeftGCDMonoid+    specForAll+        testTypesRightGCDMonoid+        specValidRightGCDMonoid+    specForAll+        testTypesOverlappingGCDMonoid+        specValidOverlappingGCDMonoid+    specForAll+        testTypesGCDMonoid+        specValidGCDMonoid+    specForAll+        testTypesLCMMonoid+        specValidLCMMonoid+    specForAll+        testTypesMonus+        specValidMonus+    specForAll+        testTypesGroup+        specValidGroup+  where+    specForAll+        :: [TestType c]+        -> (forall k v. (Test k v, c v) => Proxy k -> Proxy v -> Spec)+        -> Spec+    specForAll testTypes specFn = forM_ testTypes (specFor specFn)++    specFor+        :: (forall k v. (Test k v, c v) => Proxy k -> Proxy v -> Spec)+        -> TestType c+        -> Spec+    specFor specFn (TestType (v :: Proxy v)) =+        specFn (Proxy @Key) v++specValidMonoidNull+    :: forall k v. Test k v => Proxy k -> Proxy v -> Spec+specValidMonoidNull = makeSpec $ do+    it "propValid_fromList" $+        propValid_fromList+            @k @v & property+    it "propValid_fromListWith" $+        propValid_fromListWith+            @k @v & property+    it "propValid_fromMap" $+        propValid_fromMap+            @k @v & property+    it "propValid_singleton" $+        propValid_singleton+            @k @v & property+    it "propValid_set" $+        propValid_set+            @k @v & property+    it "propValid_adjust" $+        propValid_adjust+            @k @v & property+    it "propValid_nullify" $+        propValid_nullify+            @k @v & property+    it "propValid_take" $+        propValid_take+            @k @v & property+    it "propValid_drop" $+        propValid_drop+            @k @v & property+    it "propValid_splitAt" $+        propValid_splitAt+            @k @v & property+    it "propValid_filter" $+        propValid_filter+            @k @v & property+    it "propValid_filterKeys" $+        propValid_filterKeys+            @k @v & property+    it "propValid_filterWithKey" $+        propValid_filterWithKey+            @k @v & property+    it "propValid_partition" $+        propValid_partition+            @k @v & property+    it "propValid_partitionKeys" $+        propValid_partitionKeys+            @k @v & property+    it "propValid_partitionWithKey" $+        propValid_partitionWithKey+            @k @v & property+    it "propValid_map" $+        propValid_map+            @k @v & property+    it "propValid_mapKeys" $+        propValid_mapKeys+            @k @v & property+    it "propValid_mapKeysWith" $+        propValid_mapKeysWith+            @k @v & property+    it "propValid_intersectionWith" $+        propValid_intersectionWith+            @k @v & property+    it "propValid_unionWith" $+        propValid_unionWith+            @k @v & property+    it "propValid_append" $+        propValid_append+            @k @v & property++specValidLeftReductive+    :: forall k v. (Test k v, LeftReductive v)+    => Proxy k+    -> Proxy v+    -> Spec+specValidLeftReductive = makeSpec $ do+    it "propValid_stripPrefix" $+        propValid_stripPrefix+            @k @v & property++specValidRightReductive+    :: forall k v. (Test k v, RightReductive v)+    => Proxy k+    -> Proxy v+    -> Spec+specValidRightReductive = makeSpec $ do+    it "propValid_stripSuffix" $+        propValid_stripSuffix+            @k @v & property++specValidReductive+    :: forall k v. (Test k v, Reductive v)+    => Proxy k+    -> Proxy v+    -> Spec+specValidReductive = makeSpec $ do+    it "propValid_minusMaybe" $+        propValid_minusMaybe+            @k @v & property++specValidLeftGCDMonoid+    :: forall k v. (Test k v, LeftGCDMonoid v)+    => Proxy k+    -> Proxy v+    -> Spec+specValidLeftGCDMonoid = makeSpec $ do+    it "propValid_commonPrefix" $+        propValid_commonPrefix+            @k @v & property+    it "propValid_stripCommonPrefix" $+        propValid_stripCommonPrefix+            @k @v & property++specValidRightGCDMonoid+    :: forall k v. (Test k v, RightGCDMonoid v)+    => Proxy k+    -> Proxy v+    -> Spec+specValidRightGCDMonoid = makeSpec $ do+    it "propValid_commonSuffix" $+        propValid_commonSuffix+            @k @v & property+    it "propValid_stripCommonSuffix" $+        propValid_stripCommonSuffix+            @k @v & property++specValidOverlappingGCDMonoid+    :: forall k v. (Test k v, OverlappingGCDMonoid v)+    => Proxy k+    -> Proxy v+    -> Spec+specValidOverlappingGCDMonoid = makeSpec $ do+    it "propValid_overlap" $+        propValid_overlap+            @k @v & property+    it "propValid_stripPrefixOverlap" $+        propValid_stripPrefixOverlap+            @k @v & property+    it "propValid_stripSuffixOverlap" $+        propValid_stripSuffixOverlap+            @k @v & property+    it "propValid_stripOverlap" $+        propValid_stripOverlap+            @k @v & property++specValidGCDMonoid+    :: forall k v. (Test k v, GCDMonoid v)+    => Proxy k+    -> Proxy v+    -> Spec+specValidGCDMonoid = makeSpec $ do+    it "propValid_intersection" $+        propValid_intersection+            @k @v & property++specValidLCMMonoid+    :: forall k v. (Test k v, LCMMonoid v)+    => Proxy k+    -> Proxy v+    -> Spec+specValidLCMMonoid = makeSpec $ do+    it "propValid_union" $+        propValid_union+            @k @v & property++specValidMonus+    :: forall k v. (Test k v, Monus v)+    => Proxy k+    -> Proxy v+    -> Spec+specValidMonus = makeSpec $ do+    it "propValid_monus" $+        propValid_monus+            @k @v & property++specValidGroup+    :: forall k v. (Test k v, Group v)+    => Proxy k+    -> Proxy v+    -> Spec+specValidGroup = makeSpec $ do+    it "propValid_minus" $+        propValid_minus+            @k @v & property+    it "propValid_invert" $+        propValid_invert+            @k @v & property+    it "propValid_power" $+        propValid_power+            @k @v & property++propValid+    :: Test k v => MonoidMap k v -> Property+propValid m = conjoin+    [ counterexample+        "propValid_nonNullKeys"+        (propValid_nonNullKeys)+    , counterexample+        "propValid_toList"+        (propValid_toList)+    ]+    & cover 2+        (not (Null.null m))+        "not (Null.null m)"+  where+    propValid_nonNullKeys =+        all (\k -> MonoidMap.get k m /= mempty) (MonoidMap.nonNullKeys m)+    propValid_toList =+        all (\(_, v) -> v /= mempty) (MonoidMap.toList m)++propValid_fromList+    :: Test k v => [(k, v)] -> Property+propValid_fromList kvs =+    propValid (MonoidMap.fromList kvs)+    & cover 2+        (filter (Null.null . snd) kvs /= [])+        "filter (Null.null . snd) kvs /= []"++propValid_fromListWith+    :: Test k v => Fun (v, v) v -> [(k, v)] -> Property+propValid_fromListWith (applyFun2 -> f) kvs =+    propValid (MonoidMap.fromListWith f kvs)+    & cover 2+        (filter (Null.null . snd) kvs /= [])+        "filter (Null.null . snd) kvs /= []"++propValid_fromMap+    :: Test k v => Map k v -> Property+propValid_fromMap m =+    propValid (MonoidMap.fromMap m)+    & cover 2+        (Map.filter (Null.null) m /= mempty)+        "Map.filter (Null.null) m /= mempty"++propValid_singleton+    :: Test k v => k -> v -> Property+propValid_singleton k v =+    propValid (MonoidMap.singleton k v)+    & cover 2+        (Null.null v)+        "Null.null v"++propValid_set+    :: Test k v => k -> v -> MonoidMap k v -> Property+propValid_set k v m =+    propValid (MonoidMap.set k v m)+    & cover 2+        (Null.null v)+        "Null.null v"++propValid_adjust+    :: Test k v => Fun v v -> k -> MonoidMap k v -> Property+propValid_adjust (applyFun -> f) k m =+    propValid (MonoidMap.adjust f k m)+    & cover 1+        (Null.null (f (MonoidMap.get k m)))+        "Null.null (f (MonoidMap.get k m))"++propValid_nullify+    :: Test k v => k -> MonoidMap k v -> Property+propValid_nullify k m =+    propValid (MonoidMap.nullify k m)+    & cover 2+        (MonoidMap.nonNullKey k m)+        "MonoidMap.nonNullKey k m"++propValid_take+    :: Test k v => Slice k v -> Property+propValid_take (Slice i m) =+    propValid (MonoidMap.take i m)++propValid_drop+    :: Test k v => Slice k v -> Property+propValid_drop (Slice i m) =+    propValid (MonoidMap.drop i m)++propValid_splitAt+    :: Test k v => Slice k v -> Property+propValid_splitAt (Slice i m) =+    conjoin+        [ counterexample "propValid m1" (propValid m1)+        , counterexample "propValid m2" (propValid m2)+        ]+  where+    (m1, m2) = MonoidMap.splitAt i m++propValid_filter+    :: Test k v => Fun v Bool -> MonoidMap k v -> Property+propValid_filter (applyFun -> f) m =+    propValid (MonoidMap.filter f m)++propValid_filterKeys+    :: Test k v => Fun k Bool -> MonoidMap k v -> Property+propValid_filterKeys (applyFun -> f) m =+    propValid (MonoidMap.filterKeys f m)++propValid_filterWithKey+    :: Test k v => Fun (k, v) Bool -> MonoidMap k v -> Property+propValid_filterWithKey (applyFun2 -> f) m =+    propValid (MonoidMap.filterWithKey f m)++propValid_partition+    :: Test k v => Fun v Bool -> MonoidMap k v -> Property+propValid_partition (applyFun -> f) m =+    conjoin+        [ counterexample "propValid m1" (propValid m1)+        , counterexample "propValid m2" (propValid m2)+        ]+  where+    (m1, m2) = MonoidMap.partition f m++propValid_partitionKeys+    :: Test k v => Fun k Bool -> MonoidMap k v -> Property+propValid_partitionKeys (applyFun -> f) m =+    conjoin+        [ counterexample "propValid m1" (propValid m1)+        , counterexample "propValid m2" (propValid m2)+        ]+  where+    (m1, m2) = MonoidMap.partitionKeys f m++propValid_partitionWithKey+    :: Test k v => Fun (k, v) Bool -> MonoidMap k v -> Property+propValid_partitionWithKey (applyFun2 -> f) m =+    conjoin+        [ counterexample "propValid m1" (propValid m1)+        , counterexample "propValid m2" (propValid m2)+        ]+  where+    (m1, m2) = MonoidMap.partitionWithKey f m++propValid_map+    :: Test k v => Fun v v -> MonoidMap k v -> Property+propValid_map (applyFun -> f) m =+    propValid (MonoidMap.map f m)++propValid_mapKeys+    :: Test k v => Fun k k -> MonoidMap k v -> Property+propValid_mapKeys (applyFun -> f) m =+    propValid (MonoidMap.mapKeys f m)++propValid_mapKeysWith+    :: Test k v => Fun (v, v) v -> Fun k k -> MonoidMap k v -> Property+propValid_mapKeysWith (applyFun2 -> f) (applyFun -> g) m =+    propValid (MonoidMap.mapKeysWith f g m)++propValid_intersection+    :: (Test k v, GCDMonoid v) => MonoidMap k v -> MonoidMap k v -> Property+propValid_intersection m1 m2 =+    propValid (MonoidMap.intersection m1 m2)++propValid_intersectionWith+    :: Test k v => Fun (v, v) v -> MonoidMap k v -> MonoidMap k v -> Property+propValid_intersectionWith (applyFun2 -> f) m1 m2 =+    propValid (MonoidMap.intersectionWith f m1 m2)++propValid_union+    :: (Test k v, LCMMonoid v) => MonoidMap k v -> MonoidMap k v -> Property+propValid_union m1 m2 =+    propValid (MonoidMap.union m1 m2)++propValid_unionWith+    :: Test k v => Fun (v, v) v -> MonoidMap k v -> MonoidMap k v -> Property+propValid_unionWith (applyFun2 -> f) m1 m2 =+    propValid (MonoidMap.unionWith f m1 m2)++propValid_append+    :: Test k v => MonoidMap k v -> MonoidMap k v -> Property+propValid_append m1 m2 =+    propValid (MonoidMap.append m1 m2)++propValid_minus+    :: (Test k v, Group v) => MonoidMap k v -> MonoidMap k v -> Property+propValid_minus m1 m2 =+    propValid (MonoidMap.minus m1 m2)++propValid_minusMaybe+    :: (Test k v, Reductive v) => MonoidMap k v -> MonoidMap k v -> Property+propValid_minusMaybe m1 m2 =+    maybe (property True) propValid mr+    & cover 2 (isJust mr) "isJust mr"+  where+    mr = MonoidMap.minusMaybe m1 m2++propValid_monus+    :: (Test k v, Monus v) => MonoidMap k v -> MonoidMap k v -> Property+propValid_monus m1 m2 =+    propValid (MonoidMap.monus m1 m2)++propValid_invert+    :: (Test k v, Group v) => MonoidMap k v -> Property+propValid_invert m =+    propValid (MonoidMap.invert m)++propValid_power+    :: (Test k v, Group v) => MonoidMap k v -> Int -> Property+propValid_power m i =+    propValid (MonoidMap.power m i)++propValid_commonPrefix+    :: (Test k v, LeftGCDMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Property+propValid_commonPrefix m1 m2 =+    propValid (MonoidMap.commonPrefix m1 m2)++propValid_commonSuffix+    :: (Test k v, RightGCDMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Property+propValid_commonSuffix m1 m2 =+    propValid (MonoidMap.commonSuffix m1 m2)++propValid_stripPrefix+    :: (Test k v, LeftReductive v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Property+propValid_stripPrefix m1 m2 =+    maybe (property True) propValid mr+    & cover 2 (isJust mr) "isJust mr"+  where+    mr = MonoidMap.stripPrefix m1 m2++propValid_stripSuffix+    :: (Test k v, RightReductive v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Property+propValid_stripSuffix m1 m2 =+    maybe (property True) propValid mr+    & cover 2 (isJust mr) "isJust mr"+  where+    mr = MonoidMap.stripSuffix m1 m2++propValid_stripCommonPrefix+    :: (Test k v, LeftGCDMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Property+propValid_stripCommonPrefix m1 m2 =+    conjoin+        [ counterexample "propValid r1" (propValid r1)+        , counterexample "propValid r2" (propValid r2)+        , counterexample "propValid r3" (propValid r3)+        ]+  where+    (r1, r2, r3) = MonoidMap.stripCommonPrefix m1 m2++propValid_stripCommonSuffix+    :: (Test k v, RightGCDMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Property+propValid_stripCommonSuffix m1 m2 =+    conjoin+        [ counterexample "propValid r1" (propValid r1)+        , counterexample "propValid r2" (propValid r2)+        , counterexample "propValid r3" (propValid r3)+        ]+  where+    (r1, r2, r3) = MonoidMap.stripCommonSuffix m1 m2++propValid_overlap+    :: (Test k v, OverlappingGCDMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Property+propValid_overlap m1 m2 =+    propValid (MonoidMap.overlap m1 m2)++propValid_stripPrefixOverlap+    :: (Test k v, OverlappingGCDMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Property+propValid_stripPrefixOverlap m1 m2 =+    propValid (MonoidMap.stripPrefixOverlap m1 m2)++propValid_stripSuffixOverlap+    :: (Test k v, OverlappingGCDMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Property+propValid_stripSuffixOverlap m1 m2 =+    propValid (MonoidMap.stripSuffixOverlap m1 m2)++propValid_stripOverlap+    :: (Test k v, OverlappingGCDMonoid v)+    => MonoidMap k v+    -> MonoidMap k v+    -> Property+propValid_stripOverlap m1 m2 =+    conjoin+        [ counterexample "propValid r1" (propValid r1)+        , counterexample "propValid r2" (propValid r2)+        , counterexample "propValid r3" (propValid r3)+        ]+  where+    (r1, r2, r3) = MonoidMap.stripOverlap m1 m2
+ src/test/Examples/MultiMapSpec.hs view
@@ -0,0 +1,728 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Use any" -}+{- HLINT ignore "Use null" -}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Examples.MultiMapSpec+    where++import Prelude++import Data.Function+    ( (&) )+import Data.Maybe+    ( isJust, isNothing )+import Data.Proxy+    ( Proxy (..) )+import Data.Set+    ( Set )+import Data.Typeable+    ( Typeable, typeRep )+import Examples.MultiMap.Class+    ( MultiMap )+import Test.Hspec+    ( Spec, describe, it )+import Test.QuickCheck+    ( Arbitrary (..)+    , Property+    , Testable+    , checkCoverage+    , counterexample+    , cover+    , (.||.)+    , (===)+    )+import Test.QuickCheck.Instances.Natural+    ()+import Test.QuickCheck.Instances.Text+    ()++import qualified Data.Foldable as F+import qualified Data.Set as Set+import qualified Examples.MultiMap.Class as M+import qualified Examples.MultiMap.Instances.MultiMap1 as MultiMap1+import qualified Examples.MultiMap.Instances.MultiMap2 as MultiMap2+import qualified Examples.MultiMap.Instances.MultiMap3 as MultiMap3+import qualified Examples.MultiMap.Instances.MultiMap4 as MultiMap4+import qualified Test.QuickCheck as QC++spec :: Spec+spec = do++    -- Uncomment the following line to see property test failures for an+    -- unlawful implementation of 'MultiMap':+    --+    -- specFor (Proxy @(MultiMap1.MultiMap Int Int))++    specFor (Proxy @(MultiMap2.MultiMap Int Int))+    specFor (Proxy @(MultiMap3.MultiMap Int Int))+    specFor (Proxy @(MultiMap4.MultiMap Int Int))++type Test m k v =+        ( Arbitrary k+        , Arbitrary v+        , MultiMap m k v+        , Show (m k v)+        , Show k+        , Show v+        , Typeable m+        , Typeable k+        , Typeable v+        )++specFor :: forall m k v. Test m k v => Proxy (m k v) -> Spec+specFor multimapType = do++    let description = show (typeRep multimapType)++    let property :: Testable t => t -> Property+        property = checkCoverage . QC.property++    describe description $ do++        describe "Validity properties" $ do++            it "prop_fromList_valid" $+                prop_fromList_valid+                    @m @k @v & property+            it "prop_update_valid" $+                prop_update_valid+                    @m @k @v & property+            it "prop_insert_valid" $+                prop_insert_valid+                    @m @k @v & property+            it "prop_remove_valid" $+                prop_remove_valid+                    @m @k @v & property+            it "prop_union_valid" $+                prop_union_valid+                    @m @k @v & property+            it "prop_intersection_valid" $+                prop_intersection_valid+                    @m @k @v & property++        describe "General properties" $ do++            it "prop_fromList_filter" $+                prop_fromList_filter+                    @m @k @v & property+            it "prop_toList_filter" $+                prop_toList_filter+                    @m @k @v & property+            it "prop_empty_fromList" $+                prop_empty_fromList+                    @m @k @v & property+            it "prop_lookup_filter_fold" $+                prop_lookup_filter_fold+                    @m @k @v & property+            it "prop_null_lookup" $+                prop_null_lookup+                    @m @k @v & property+            it "prop_nonNull_lookup" $+                prop_nonNull_lookup+                    @m @k @v & property+            it "prop_nonNullKey_lookup" $+                prop_nonNullKey_lookup+                    @m @k @v & property+            it "prop_nonNullKeys_nonNullKey" $+                prop_nonNullKeys_nonNullKey+                    @m @k @v & property+            it "prop_nonNullCount_nonNullKeys" $+                prop_nonNullCount_nonNullKeys+                    @m @k @v & property+            it "prop_isSubmapOf_lookup" $+                prop_isSubmapOf_lookup+                    @m @k @v & property+            it "prop_update_lookup" $+                prop_update_lookup+                    @m @k @v & property+            it "prop_insert_lookup" $+                prop_insert_lookup+                    @m @k @v & property+            it "prop_remove_lookup" $+                prop_remove_lookup+                    @m @k @v & property+            it "prop_union_idempotence" $+                prop_union_idempotence+                    @m @k @v & property+            it "prop_union_identity_left" $+                prop_union_identity_left+                    @m @k @v & property+            it "prop_union_identity_right" $+                prop_union_identity_right+                    @m @k @v & property+            it "prop_union_commutativity" $+                prop_union_commutativity+                    @m @k @v & property+            it "prop_union_associativity" $+                prop_union_associativity+                    @m @k @v & property+            it "prop_union_containment_left" $+                prop_union_containment_left+                    @m @k @v & property+            it "prop_union_containment_right" $+                prop_union_containment_right+                    @m @k @v & property+            it "prop_union_distributivity" $+                prop_union_distributivity+                    @m @k @v & property+            it "prop_intersection_idempotence" $+                prop_intersection_idempotence+                    @m @k @v & property+            it "prop_intersection_identity_left" $+                prop_intersection_identity_left+                    @m @k @v & property+            it "prop_intersection_identity_right" $+                prop_intersection_identity_right+                    @m @k @v & property+            it "prop_intersection_commutativity" $+                prop_intersection_commutativity+                    @m @k @v & property+            it "prop_intersection_associativity" $+                prop_intersection_associativity+                    @m @k @v & property+            it "prop_intersection_containment_left" $+                prop_intersection_containment_left+                    @m @k @v & property+            it "prop_intersection_containment_right" $+                prop_intersection_containment_right+                    @m @k @v & property+            it "prop_intersection_distributivity" $+                prop_intersection_distributivity+                    @m @k @v & property++--------------------------------------------------------------------------------+-- Validity properties+--------------------------------------------------------------------------------++-- A multimap is valid if (and only if):+--+-- - all keys included in 'nonNullKeys' are associated with non-empty sets.+-- - all keys included in 'toList'      are associated with non-empty sets.++prop_valid+    :: Test m k v => m k v -> Property+prop_valid m = QC.conjoin+    [ counterexample+        "prop_valid_nonNullKeys"+        (prop_valid_nonNullKeys)+    , counterexample+        "prop_valid_toList"+        (prop_valid_toList)+    ]+    & cover 1+        (M.null m)+        "M.null m"+    & cover 1+        (M.nonNull m)+        "M.nonNull m"+  where+    prop_valid_nonNullKeys =+        all (\k -> M.lookup k m /= Set.empty) (M.nonNullKeys m)+    prop_valid_toList =+        all (\(_, v) -> v /= Set.empty) (M.toList m)++--------------------------------------------------------------------------------+-- Validity of operations that produce multimaps+--------------------------------------------------------------------------------++prop_fromList_valid+    :: forall m k v. Test m k v+    => [(k, Set v)]+    -> Property+prop_fromList_valid kvs =+    prop_valid @m @k @v (M.fromList kvs)++prop_update_valid+    :: forall m k v. Test m k v+    => k+    -> Set v+    -> [(k, Set v)]+    -> Property+prop_update_valid k vs kvs =+    prop_valid @m @k @v (M.update k vs (M.fromList kvs))++prop_insert_valid+    :: forall m k v. Test m k v+    => k+    -> Set v+    -> [(k, Set v)]+    -> Property+prop_insert_valid k vs kvs =+    prop_valid @m @k @v (M.insert k vs (M.fromList kvs))++prop_remove_valid+    :: forall m k v. Test m k v+    => k+    -> Set v+    -> [(k, Set v)]+    -> Property+prop_remove_valid k vs kvs =+    prop_valid @m @k @v (M.remove k vs (M.fromList kvs))++prop_union_valid+    :: forall m k v. Test m k v+    => [(k, Set v)]+    -> [(k, Set v)]+    -> Property+prop_union_valid kvs1 kvs2 =+    prop_valid @m @k @v (M.union (M.fromList kvs1) (M.fromList kvs2))++prop_intersection_valid+    :: forall m k v. Test m k v+    => [(k, Set v)]+    -> [(k, Set v)]+    -> Property+prop_intersection_valid kvs1 kvs2 =+    prop_valid @m @k @v (M.intersection (M.fromList kvs1) (M.fromList kvs2))++--------------------------------------------------------------------------------+-- General properties+--------------------------------------------------------------------------------++prop_fromList_filter+    :: forall m k v. Test m k v+    => [(k, Set v)]+    -> Property+prop_fromList_filter kvs =+    M.fromList @m @k @v kvs === M.fromList (filter ((/= Set.empty) . snd) kvs)++prop_toList_filter+    :: forall m k v. Test m k v+    => [(k, Set v)]+    -> Property+prop_toList_filter kvs =+    M.toList m === filter ((/= Set.empty) . snd) (M.toList m)+  where+    m :: m k v+    m = M.fromList kvs++prop_empty_fromList+    :: forall m k v. Test m k v+    => Property+prop_empty_fromList =+    M.empty @m @k @v === M.fromList []++prop_lookup_filter_fold+    :: forall m k v. Test m k v+    => k+    -> [(k, Set v)]+    -> Property+prop_lookup_filter_fold k kvs =+    M.lookup k m === F.foldMap snd (filter ((== k) . fst) kvs)+    & cover 10+        (isJust (lookup k kvs))+        "isJust (lookup k kvs)"+    & cover 10+        (isNothing (lookup k kvs))+        "isNothing (lookup k kvs)"+  where+    m :: m k v+    m = M.fromList kvs++prop_null_lookup+    :: forall m k v. Test m k v+    => k+    -> [(k, Set v)]+    -> Property+prop_null_lookup k kvs =+    M.null m ==> M.lookup k m == Set.empty+    & cover 2+        (M.lookup k m == Set.empty && M.null m)+        "M.lookup k m == Set.empty && M.null m"+    & cover 2+        (M.lookup k m == Set.empty && M.nonNull m)+        "M.lookup k m == Set.empty && M.nonNull m"+    & cover 2+        (M.lookup k m /= Set.empty && M.nonNull m)+        "M.lookup k m /= Set.empty && M.nonNull m"+  where+    m :: m k v+    m = M.fromList kvs++prop_nonNull_lookup+    :: forall m k v. Test m k v+    => k+    -> [(k, Set v)]+    -> Property+prop_nonNull_lookup k kvs =+    M.lookup k m /= Set.empty ==> M.nonNull m+    & cover 2+        (M.lookup k m == Set.empty && M.null m)+        "M.lookup k m == Set.empty && M.null m"+    & cover 2+        (M.lookup k m == Set.empty && M.nonNull m)+        "M.lookup k m == Set.empty && M.nonNull m"+    & cover 2+        (M.lookup k m /= Set.empty && M.nonNull m)+        "M.lookup k m /= Set.empty && M.nonNull m"+  where+    m :: m k v+    m = M.fromList kvs++prop_nonNullKey_lookup+    :: forall m k v. Test m k v+    => k+    -> [(k, Set v)]+    -> Property+prop_nonNullKey_lookup k kvs =+    M.nonNullKey k m === (M.lookup k m /= Set.empty)+    & cover 2+        (M.lookup k m == Set.empty && M.null m)+        "M.lookup k m == Set.empty && M.null m"+    & cover 2+        (M.lookup k m == Set.empty && M.nonNull m)+        "M.lookup k m == Set.empty && M.nonNull m"+    & cover 2+        (M.lookup k m /= Set.empty && M.nonNull m)+        "M.lookup k m /= Set.empty && M.nonNull m"+  where+    m :: m k v+    m = M.fromList kvs++prop_nonNullKeys_nonNullKey+    :: forall m k v. Test m k v+    => [(k, Set v)]+    -> Property+prop_nonNullKeys_nonNullKey kvs = QC.property $+    all (`M.nonNullKey` m) (M.nonNullKeys m)+    & cover 2+        (M.null m)+        "M.null m"+    & cover 2+        (M.nonNull m)+        "M.nonNull m"+  where+    m :: m k v+    m = M.fromList kvs++prop_nonNullCount_nonNullKeys+    :: forall m k v. Test m k v+    => [(k, Set v)]+    -> Property+prop_nonNullCount_nonNullKeys kvs =+    M.nonNullCount m === Set.size (M.nonNullKeys m)+    & cover 1+        (M.nonNullCount m == 0)+        "M.nonNullCount m == 0"+    & cover 1+        (M.nonNullCount m == 1)+        "M.nonNullCount m == 1"+    & cover 1+        (M.nonNullCount m == 2)+        "M.nonNullCount m == 2"+    & cover 1+        (M.nonNullCount m >= 3)+        "M.nonNullCount m >= 3"+  where+    m :: m k v+    m = M.fromList kvs++prop_isSubmapOf_lookup+    :: forall m k v. Test m k v+    => k+    -> [(k, Set v)]+    -> [(k, Set v)]+    -> Property+prop_isSubmapOf_lookup k kvs1 kvs2 =+    m1 `M.isSubmapOf` m2+        ==>+        M.lookup k m1 `Set.isSubsetOf` M.lookup k m2+    & cover 1+        (m1 `M.isSubmapOf` m2)+        "m1 `M.isSubmapOf` m2"+  where+    m1, m2 :: m k v+    m1 = M.fromList kvs1+    m2 = M.fromList kvs2++prop_update_lookup+    :: forall m k v. Test m k v+    => k+    -> k+    -> Set v+    -> [(k, Set v)]+    -> Property+prop_update_lookup k1 k2 vs kvs =+    M.lookup k1 (M.update k2 vs m) === (if k1 == k2 then vs else M.lookup k1 m)+    & cover 1+        (k1 == k2)+        "k1 == k2"+    & cover 10+        (k1 /= k2)+        "k1 /= k2"+  where+    m :: m k v+    m = M.fromList kvs++prop_insert_lookup+    :: forall m k v. Test m k v+    => k+    -> k+    -> Set v+    -> [(k, Set v)]+    -> Property+prop_insert_lookup k1 k2 vs kvs =+    M.lookup k1 (M.insert k2 vs m) ===+        (if k1 == k2 then M.lookup k1 m `Set.union` vs else M.lookup k1 m)+    & cover 1+        (k1 == k2)+        "k1 == k2"+    & cover 10+        (k1 /= k2)+        "k1 /= k2"+  where+    m :: m k v+    m = M.fromList kvs++prop_remove_lookup+    :: forall m k v. Test m k v+    => k+    -> k+    -> Set v+    -> [(k, Set v)]+    -> Property+prop_remove_lookup k1 k2 vs kvs =+    M.lookup k1 (M.remove k2 vs m) ===+        (if k1 == k2 then M.lookup k1 m `Set.difference` vs else M.lookup k1 m)+    & cover 1+        (k1 == k2)+        "k1 == k2"+    & cover 10+        (k1 /= k2)+        "k1 /= k2"+  where+    m :: m k v+    m = M.fromList kvs++prop_union_idempotence+    :: forall m k v. Test m k v+    => [(k, Set v)]+    -> Property+prop_union_idempotence kvs =+    M.union m m === m+  where+    m :: m k v+    m = M.fromList kvs++prop_union_identity_left+    :: forall m k v. Test m k v+    => [(k, Set v)]+    -> Property+prop_union_identity_left kvs =+    M.union m M.empty === m+  where+    m :: m k v+    m = M.fromList kvs++prop_union_identity_right+    :: forall m k v. Test m k v+    => [(k, Set v)]+    -> Property+prop_union_identity_right kvs =+    M.union M.empty m === m+  where+    m :: m k v+    m = M.fromList kvs++prop_union_commutativity+    :: forall m k v. Test m k v+    => [(k, Set v)]+    -> [(k, Set v)]+    -> Property+prop_union_commutativity kvs1 kvs2 =+    M.union m1 m2 === M.union m2 m1+  where+    m1, m2 :: m k v+    m1 = M.fromList kvs1+    m2 = M.fromList kvs2++prop_union_associativity+    :: forall m k v. Test m k v+    => [(k, Set v)]+    -> [(k, Set v)]+    -> [(k, Set v)]+    -> Property+prop_union_associativity kvs1 kvs2 kvs3 =+    M.union m1 (M.union m2 m3)+        === M.union (M.union m1 m2) m3+  where+    m1, m2, m3 :: m k v+    m1 = M.fromList kvs1+    m2 = M.fromList kvs2+    m3 = M.fromList kvs3++prop_union_containment_left+    :: forall m k v. Test m k v+    => [(k, Set v)]+    -> [(k, Set v)]+    -> Property+prop_union_containment_left kvs1 kvs2 = QC.property $+    m1 `M.isSubmapOf` M.union m1 m2+  where+    m1, m2 :: m k v+    m1 = M.fromList kvs1+    m2 = M.fromList kvs2++prop_union_containment_right+    :: forall m k v. Test m k v+    => [(k, Set v)]+    -> [(k, Set v)]+    -> Property+prop_union_containment_right kvs1 kvs2 = QC.property $+    m2 `M.isSubmapOf` M.union m1 m2+  where+    m1, m2 :: m k v+    m1 = M.fromList kvs1+    m2 = M.fromList kvs2++prop_union_distributivity+    :: forall m k v. Test m k v+    => k+    -> [(k, Set v)]+    -> [(k, Set v)]+    -> Property+prop_union_distributivity k kvs1 kvs2 =+    M.lookup k (M.union m1 m2) === Set.union (M.lookup k m1) (M.lookup k m2)+    & cover 1+        (M.nonNullKey k (M.union m1 m2))+        "M.nonNullKey k (M.union m1 m2)"+  where+    m1, m2 :: m k v+    m1 = M.fromList kvs1+    m2 = M.fromList kvs2++prop_intersection_idempotence+    :: forall m k v. Test m k v+    => [(k, Set v)]+    -> Property+prop_intersection_idempotence kvs =+    M.intersection m m === m+  where+    m :: m k v+    m = M.fromList kvs++prop_intersection_identity_left+    :: forall m k v. Test m k v+    => [(k, Set v)]+    -> Property+prop_intersection_identity_left kvs =+    M.intersection m M.empty === M.empty+  where+    m :: m k v+    m = M.fromList kvs++prop_intersection_identity_right+    :: forall m k v. Test m k v+    => [(k, Set v)]+    -> Property+prop_intersection_identity_right kvs =+    M.intersection M.empty m === M.empty+  where+    m :: m k v+    m = M.fromList kvs++prop_intersection_commutativity+    :: forall m k v. Test m k v+    => [(k, Set v)]+    -> [(k, Set v)]+    -> Property+prop_intersection_commutativity kvs1 kvs2 =+    M.intersection m1 m2 === M.intersection m2 m1+    & cover 1+        (M.nonNull (M.intersection m1 m2))+        "M.nonNull (M.intersection m1 m2)"+    & cover 1+        (M.nonNull (M.intersection m2 m1))+        "M.nonNull (M.intersection m2 m1)"+  where+    m1, m2 :: m k v+    m1 = M.fromList kvs1+    m2 = M.fromList kvs2++prop_intersection_associativity+    :: forall m k v. Test m k v+    => [(k, Set v)]+    -> [(k, Set v)]+    -> [(k, Set v)]+    -> Property+prop_intersection_associativity kvs1 kvs2 kvs3 =+    M.intersection m1 (M.intersection m2 m3)+        === M.intersection (M.intersection m1 m2) m3+    & cover 1+        (M.nonNull (M.intersection m1 (M.intersection m2 m3)))+        "M.nonNull (M.intersection m1 (M.intersection m2 m3))"+    & cover 1+        (M.nonNull (M.intersection (M.intersection m1 m2) m3))+        "M.nonNull (M.intersection (M.intersection m1 m2) m3)"+  where+    m1, m2, m3 :: m k v+    m1 = M.fromList kvs1+    m2 = M.fromList kvs2+    m3 = M.fromList kvs3++prop_intersection_containment_left+    :: forall m k v. Test m k v+    => [(k, Set v)]+    -> [(k, Set v)]+    -> Property+prop_intersection_containment_left kvs1 kvs2 = QC.property $+    M.intersection m1 m2 `M.isSubmapOf` m1+    & cover 1+        (M.nonNull (M.intersection m1 m2))+        "M.nonNull (M.intersection m1 m2)"+  where+    m1, m2 :: m k v+    m1 = M.fromList kvs1+    m2 = M.fromList kvs2++prop_intersection_containment_right+    :: forall m k v. Test m k v+    => [(k, Set v)]+    -> [(k, Set v)]+    -> Property+prop_intersection_containment_right kvs1 kvs2 = QC.property $+    M.intersection m1 m2 `M.isSubmapOf` m2+    & cover 1+        (M.nonNull (M.intersection m1 m2))+        "M.nonNull (M.intersection m1 m2)"+  where+    m1, m2 :: m k v+    m1 = M.fromList kvs1+    m2 = M.fromList kvs2++prop_intersection_distributivity+    :: forall m k v. Test m k v+    => k+    -> [(k, Set v)]+    -> [(k, Set v)]+    -> Property+prop_intersection_distributivity k kvs1 kvs2 =+    M.lookup k (M.intersection m1 m2)+        === Set.intersection (M.lookup k m1) (M.lookup k m2)+    & cover 1+        (M.nonNullKey k (M.intersection m1 m2))+        "M.nonNullKey k (M.intersection m1 m2)"+  where+    m1, m2 :: m k v+    m1 = M.fromList kvs1+    m2 = M.fromList kvs2++--------------------------------------------------------------------------------+-- Utilities+--------------------------------------------------------------------------------++infixr 3 ==>+(==>) :: Bool -> Bool -> Property+a ==> b = not a .||. b++_preventRedundantImportErrors :: ()+_preventRedundantImportErrors = ()+  where+    _multiMap1 :: MultiMap1.MultiMap () ()+    _multiMap1 = M.empty
+ src/test/Examples/RecoveredMapSpec.hs view
@@ -0,0 +1,442 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Use any" #-}+{-# HLINT ignore "Use null" #-}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Examples.RecoveredMapSpec+    where++import Prelude++import Data.Function+    ( on, (&) )+import Data.List+    ( nubBy )+import Data.Monoid+    ( Sum (..) )+import Data.Proxy+    ( Proxy (..) )+import Data.Set+    ( Set )+import Data.Text+    ( Text )+import Data.Typeable+    ( Typeable, typeRep )+import Numeric.Natural+    ( Natural )+import Test.Hspec+    ( Spec, describe, it )+import Test.QuickCheck+    ( Arbitrary (..)+    , CoArbitrary+    , Fun+    , Function+    , Property+    , Testable+    , applyFun+    , checkCoverage+    , cover+    , listOf+    , shrinkMapBy+    , (===)+    )+import Test.QuickCheck.Classes+    ( eqLaws, functorLaws, monoidLaws, semigroupLaws, semigroupMonoidLaws )+import Test.QuickCheck.Classes.Hspec+    ( testLawsMany )+import Test.QuickCheck.Instances.Natural+    ()+import Test.QuickCheck.Instances.Text+    ()++import qualified Data.Map.Strict as OMap+import qualified Data.Set as Set+import qualified Examples.RecoveredMap as RMap+import qualified Test.QuickCheck as QC++spec :: Spec+spec = do+    specFor (Proxy @Int) (Proxy @(Set Int))+    specFor (Proxy @Int) (Proxy @(Set Natural))+    specFor (Proxy @Int) (Proxy @(Sum Int))+    specFor (Proxy @Int) (Proxy @(Sum Natural))+    specFor (Proxy @Int) (Proxy @Text)++specFor+    :: forall k v. () =>+        ( Arbitrary k+        , Arbitrary v+        , CoArbitrary v+        , Eq v+        , Function v+        , Monoid v+        , Ord k+        , Show k+        , Show v+        , Typeable k+        , Typeable v+        )+    => Proxy k+    -> Proxy v+    -> Spec+specFor keyType valueType = do++    let description = mconcat+            [ "RecoveredMap ("+            , show (typeRep keyType)+            , ") ("+            , show (typeRep valueType)+            , ")"+            ]++    let property :: Testable t => t -> Property+        property = checkCoverage . QC.property++    describe description $ do++        describe "Class laws" $ do+            testLawsMany @(RMap.Map k v)+                [ eqLaws+                , monoidLaws+                , semigroupLaws+                , semigroupMonoidLaws+                ]+            testLawsMany @(RMap.Map k)+                [ functorLaws+                ]++        describe "Conversion to and from lists" $ do+            it "prop_fromList_toList" $+                prop_fromList_toList+                    @k @v & property++        describe "Empty" $ do+            it "prop_empty_keysSet" $+                prop_empty_keysSet+                    @k & property+            it "prop_empty_lookup" $+                prop_empty_lookup+                    @k @v & property+            it "prop_empty_show" $+                prop_empty_show+                    @k @v & property+            it "prop_empty_toList" $+                prop_empty_toList+                    @k @v & property++        describe "Singleton" $ do+            it "prop_singleton_keysSet" $+                prop_singleton_keysSet+                    @k @v & property+            it "prop_singleton_lookup" $+                prop_singleton_lookup+                    @k @v & property+            it "prop_singleton_show" $+                prop_singleton_show+                    @k @v & property+            it "prop_singleton_toList" $+                prop_singleton_toList+                    @k @v & property++        describe "Append" $ do+            it "prop_append_toList" $+                prop_append_toList+                    @k @v & property++        describe "Delete" $ do+            it "prop_delete_lookup" $+                prop_delete_lookup+                    @k @v & property+            it "prop_delete_member" $+                prop_delete_member+                    @k @v & property+            it "prop_delete_toList" $+                prop_delete_toList+                    @k @v & property++        describe "Insert" $ do+            it "prop_insert_lookup" $+                prop_insert_lookup+                    @k @v & property+            it "prop_insert_member" $+                prop_insert_member+                    @k @v & property+            it "prop_insert_toList" $+                prop_insert_toList+                    @k @v & property++        describe "Map" $ do+            it "prop_map" $+                prop_map+                    @k @v @v & property+            it "prop_map_mempty" $+                prop_map_mempty+                    @k @v @v & property++--------------------------------------------------------------------------------+-- Conversion to and from lists+--------------------------------------------------------------------------------++prop_fromList_toList+    :: forall k v. (Ord k, Show k, Eq v, Show v)+    => [(k, v)]+    -> Property+prop_fromList_toList kvs =+    (===)+        (RMap.toList (RMap.fromList kvs))+        (OMap.toList (OMap.fromList kvs))+    & cover 10+        (length kvs > 1 && length (nubBy ((==) `on` fst) kvs) /= length kvs)+        "length kvs > 1 && length (nubBy ((==) `on` fst) kvs) /= length kvs"+    & cover 10+        (length kvs > 1 && length (nubBy ((==) `on` fst) kvs) == length kvs)+        "length kvs > 1 && length (nubBy ((==) `on` fst) kvs) == length kvs"++--------------------------------------------------------------------------------+-- Empty+--------------------------------------------------------------------------------++prop_empty_keysSet+    :: forall k. (Eq k, Show k)+    => Property+prop_empty_keysSet =+    (===)+        (RMap.keysSet (RMap.empty @k))+        (OMap.keysSet (OMap.empty @k))++prop_empty_lookup+    :: forall k v. (Ord k, Eq v, Show v)+    => k+    -> Property+prop_empty_lookup k =+    (===)+        (RMap.lookup k (RMap.empty @k @v))+        (OMap.lookup k (OMap.empty @k @v))++prop_empty_show+    :: forall k v. (Show k, Show v)+    => Property+prop_empty_show =+    (===)+        (show (RMap.empty @k @v))+        (show (OMap.empty @k @v))++prop_empty_toList+    :: forall k v. (Eq k, Show k, Eq v, Show v)+    => Property+prop_empty_toList =+    (===)+        (RMap.toList (RMap.empty @k @v))+        (OMap.toList (OMap.empty @k @v))++--------------------------------------------------------------------------------+-- Singleton+--------------------------------------------------------------------------------++prop_singleton_keysSet+    :: forall k v. (Ord k, Show k)+    => k+    -> v+    -> Property+prop_singleton_keysSet k v =+    (===)+        (RMap.keysSet (RMap.singleton k v))+        (OMap.keysSet (OMap.singleton k v))++prop_singleton_lookup+    :: forall k v. (Ord k, Eq v, Show v)+    => k+    -> v+    -> Property+prop_singleton_lookup k v =+    (===)+        (RMap.lookup k (RMap.singleton k v))+        (OMap.lookup k (OMap.singleton k v))++prop_singleton_show+    :: forall k v. (Ord k, Show k, Show v)+    => k+    -> v+    -> Property+prop_singleton_show k v =+    (===)+        (show (RMap.singleton k v))+        (show (OMap.singleton k v))++prop_singleton_toList+    :: forall k v. (Ord k, Show k, Eq v, Show v)+    => k+    -> v+    -> Property+prop_singleton_toList k v =+    (===)+        (RMap.toList (RMap.singleton k v))+        (OMap.toList (OMap.singleton k v))++--------------------------------------------------------------------------------+-- Append+--------------------------------------------------------------------------------++prop_append_toList+    :: forall k v. (Ord k, Show k, Eq v, Show v)+    => [(k, v)]+    -> [(k, v)]+    -> Property+prop_append_toList kvs1 kvs2 =+    (===)+        (RMap.toList (RMap.fromList kvs1 <> RMap.fromList kvs2))+        (OMap.toList (OMap.fromList kvs1 <> OMap.fromList kvs2))+    & cover 10+        (ks1 `Set.disjoint` ks2)+        "ks1 `Set.disjoint` ks2"+    & cover 10+        (not (ks1 `Set.disjoint` ks2))+        "not (ks1 `Set.disjoint` ks2)"+  where+    ks1 = Set.fromList (fst <$> kvs1)+    ks2 = Set.fromList (fst <$> kvs2)++--------------------------------------------------------------------------------+-- Delete+--------------------------------------------------------------------------------++prop_delete_lookup+    :: forall k v. (Ord k, Eq v, Show v)+    => [(k, v)]+    -> k+    -> Property+prop_delete_lookup kvs k =+    (===)+        (RMap.lookup k (RMap.delete k (RMap.fromList kvs)))+        (OMap.lookup k (OMap.delete k (OMap.fromList kvs)))+    & cover 10+        (filter ((== k) . fst) kvs == [])+        "filter ((== k) . fst) kvs == []"+    & cover 10+        (filter ((== k) . fst) kvs /= [])+        "filter ((== k) . fst) kvs /= []"++prop_delete_member+    :: forall k v. (Ord k, Eq v)+    => [(k, v)]+    -> k+    -> Property+prop_delete_member kvs k =+    (===)+        (RMap.member k (RMap.delete k (RMap.fromList kvs)))+        (OMap.member k (OMap.delete k (OMap.fromList kvs)))+    & cover 10+        (filter ((== k) . fst) kvs == [])+        "filter ((== k) . fst) kvs == []"+    & cover 10+        (filter ((== k) . fst) kvs /= [])+        "filter ((== k) . fst) kvs /= []"++prop_delete_toList+    :: forall k v. (Ord k, Show k, Eq v, Show v)+    => [(k, v)]+    -> k+    -> Property+prop_delete_toList kvs k =+    (===)+        (RMap.toList (RMap.delete k (RMap.fromList kvs)))+        (OMap.toList (OMap.delete k (OMap.fromList kvs)))+    & cover 10+        (filter ((== k) . fst) kvs == [])+        "filter ((== k) . fst) kvs == []"+    & cover 10+        (filter ((== k) . fst) kvs /= [])+        "filter ((== k) . fst) kvs /= []"++--------------------------------------------------------------------------------+-- Insert+--------------------------------------------------------------------------------++prop_insert_lookup+    :: forall k v. (Ord k, Eq v, Show v)+    => [(k, v)]+    -> k+    -> v+    -> Property+prop_insert_lookup kvs k v =+    (===)+        (RMap.lookup k (RMap.insert k v (RMap.fromList kvs)))+        (OMap.lookup k (OMap.insert k v (OMap.fromList kvs)))+    & cover 10+        (filter ((== k) . fst) kvs == [])+        "filter ((== k) . fst) kvs == []"+    & cover 10+        (filter ((== k) . fst) kvs /= [])+        "filter ((== k) . fst) kvs /= []"++prop_insert_member+    :: forall k v. (Ord k, Eq v)+    => [(k, v)]+    -> k+    -> v+    -> Property+prop_insert_member kvs k v =+    (===)+        (RMap.member k (RMap.insert k v (RMap.fromList kvs)))+        (OMap.member k (OMap.insert k v (OMap.fromList kvs)))+    & cover 10+        (filter ((== k) . fst) kvs == [])+        "filter ((== k) . fst) kvs == []"+    & cover 10+        (filter ((== k) . fst) kvs /= [])+        "filter ((== k) . fst) kvs /= []"++prop_insert_toList+    :: forall k v. (Ord k, Show k, Eq v, Show v)+    => [(k, v)]+    -> k+    -> v+    -> Property+prop_insert_toList kvs k v =+    (===)+        (RMap.toList (RMap.insert k v (RMap.fromList kvs)))+        (OMap.toList (OMap.insert k v (OMap.fromList kvs)))+    & cover 10+        (filter ((== k) . fst) kvs == [])+        "filter ((== k) . fst) kvs == []"+    & cover 10+        (filter ((== k) . fst) kvs /= [])+        "filter ((== k) . fst) kvs /= []"++--------------------------------------------------------------------------------+-- Map+--------------------------------------------------------------------------------++prop_map+    :: (Ord k, Show k, Eq v2, Show v2)+    => [(k, v1)]+    -> Fun v1 v2+    -> Property+prop_map kvs (applyFun -> f) =+    (===)+        (RMap.toList (RMap.map f (RMap.fromList kvs)))+        (OMap.toList (OMap.map f (OMap.fromList kvs)))++prop_map_mempty+    :: forall k v1 v2. (Ord k, Show k, Eq v2, Monoid v2, Show v2)+    => [(k, v1)]+    -> Property+prop_map_mempty kvs =+    (===)+        (RMap.toList (RMap.map (const (mempty @v2)) (RMap.fromList kvs)))+        (OMap.toList (OMap.map (const (mempty @v2)) (OMap.fromList kvs)))++--------------------------------------------------------------------------------+-- Arbitrary instances+--------------------------------------------------------------------------------++instance (Arbitrary k, Ord k, Arbitrary v) =>+    Arbitrary (RMap.Map k v)+  where+    arbitrary = RMap.fromList <$> listOf ((,) <$> arbitrary <*> arbitrary)+    shrink = shrinkMapBy RMap.fromList RMap.toList shrink
+ src/test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ src/test/SpecHook.hs view
@@ -0,0 +1,6 @@+module SpecHook where++import Test.Hspec++hook :: Spec -> Spec+hook = parallel
+ src/test/Test/Common.hs view
@@ -0,0 +1,291 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Use camelCase" -}+{- HLINT ignore "Use null" -}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Test.Common+    ( Key+    , Test+    , TestType (..)+    , testTypesMonoidNull+    , testTypesGroup+    , testTypesMonus+    , testTypesLeftReductive+    , testTypesRightReductive+    , testTypesReductive+    , testTypesLeftGCDMonoid+    , testTypesRightGCDMonoid+    , testTypesOverlappingGCDMonoid+    , testTypesGCDMonoid+    , testTypesLCMMonoid+    , TestValue+    , makeSpec+    , property+    ) where++import Prelude++import Data.Group+    ( Group )+import Data.Kind+    ( Constraint, Type )+import Data.Monoid+    ( Dual, Product, Sum )+import Data.Monoid.GCD+    ( GCDMonoid, LeftGCDMonoid, OverlappingGCDMonoid, RightGCDMonoid )+import Data.Monoid.LCM+    ( LCMMonoid )+import Data.Monoid.Monus+    ( Monus )+import Data.Monoid.Null+    ( MonoidNull )+import Data.MonoidMap+    ( MonoidMap )+import Data.Proxy+    ( Proxy (Proxy) )+import Data.Semigroup.Cancellative+    ( LeftReductive, Reductive, RightReductive )+import Data.Set+    ( Set )+import Data.Text+    ( Text )+import Data.Typeable+    ( Typeable, typeRep )+import GHC.Exts+    ( IsList (..) )+import Numeric.Natural+    ( Natural )+import Test.Hspec+    ( Spec, describe )+import Test.QuickCheck+    ( Arbitrary (..)+    , CoArbitrary (..)+    , Function (..)+    , Property+    , Testable+    , checkCoverage+    , choose+    , coarbitraryIntegral+    , coarbitraryShow+    , frequency+    , functionIntegral+    , functionShow+    , listOf+    , scale+    , shrinkMapBy+    )+import Test.QuickCheck.Instances.Natural+    ()++import qualified Data.MonoidMap as MonoidMap+import qualified Data.Text as Text+import qualified Test.QuickCheck as QC++--------------------------------------------------------------------------------+-- Arbitrary instances+--------------------------------------------------------------------------------++instance (Arbitrary k, Ord k, Arbitrary v, MonoidNull v) =>+    Arbitrary (MonoidMap k v)+  where+    arbitrary =+        fromList <$> scale (`mod` 16) (listOf ((,) <$> arbitrary <*> arbitrary))+    shrink =+        shrinkMapBy MonoidMap.fromMap MonoidMap.toMap shrink++instance Arbitrary Text where+    arbitrary = Text.pack <$> listOf genChar+      where+        genChar = frequency+            [ (64, pure 'a')+            , (16, pure 'b')+            , ( 4, pure 'c')+            , ( 1, pure 'd')+            ]++instance CoArbitrary Text where+    coarbitrary = coarbitraryShow++instance Function Text where+    function = functionShow++--------------------------------------------------------------------------------+-- Test keys+--------------------------------------------------------------------------------++newtype Key = Key Int+    deriving (Enum, Eq, Integral, Num, Ord, Real, Show)++instance Arbitrary Key where+    arbitrary = Key <$> choose (0, 15)+    shrink (Key k) = Key <$> shrink k++instance CoArbitrary Key where+    coarbitrary = coarbitraryIntegral++instance Function Key where+    function = functionIntegral++--------------------------------------------------------------------------------+-- Test constraints+--------------------------------------------------------------------------------++type Test k v = (TestKey k, TestValue v)++type TestKey k =+    ( Arbitrary k+    , CoArbitrary k+    , Function k+    , Ord k+    , Show k+    , Typeable k+    )++type TestValue v =+    ( Arbitrary v+    , CoArbitrary v+    , Eq v+    , Function v+    , MonoidNull v+    , Show v+    , Typeable v+    )++--------------------------------------------------------------------------------+-- Test types (for different type class constraints)+--------------------------------------------------------------------------------++data TestType (c :: Type -> Constraint) =+    forall v. (TestValue v, c v) => TestType (Proxy v)++testTypesMonoidNull :: [TestType MonoidNull]+testTypesMonoidNull =+    [ TestType (Proxy @(Dual Text))+    , TestType (Proxy @(Dual [Int]))+    , TestType (Proxy @(Dual [Natural]))+    , TestType (Proxy @(Set Int))+    , TestType (Proxy @(Set Natural))+    , TestType (Proxy @(Sum Int))+    , TestType (Proxy @(Sum Natural))+    , TestType (Proxy @(Product Int))+    , TestType (Proxy @(Product Natural))+    , TestType (Proxy @(Text))+    , TestType (Proxy @[Int])+    , TestType (Proxy @[Natural])+    ]++testTypesGroup :: [TestType Group]+testTypesGroup =+    [ TestType (Proxy @(Sum Int))+    ]++testTypesMonus :: [TestType Monus]+testTypesMonus =+    [ TestType (Proxy @(Set Int))+    , TestType (Proxy @(Set Natural))+    , TestType (Proxy @(Sum Natural))+    , TestType (Proxy @(Product Natural))+    ]++testTypesLeftReductive :: [TestType LeftReductive]+testTypesLeftReductive =+    [ TestType (Proxy @(Set Int))+    , TestType (Proxy @(Set Natural))+    , TestType (Proxy @(Sum Int))+    , TestType (Proxy @(Sum Natural))+    , TestType (Proxy @(Product Int))+    , TestType (Proxy @(Product Natural))+    , TestType (Proxy @[Int])+    , TestType (Proxy @[Natural])+    , TestType (Proxy @(Text))+    , TestType (Proxy @(Dual [Int]))+    , TestType (Proxy @(Dual [Natural]))+    , TestType (Proxy @(Dual Text))+    ]++testTypesRightReductive :: [TestType RightReductive]+testTypesRightReductive =+    [ TestType (Proxy @(Set Int))+    , TestType (Proxy @(Set Natural))+    , TestType (Proxy @(Sum Int))+    , TestType (Proxy @(Sum Natural))+    , TestType (Proxy @(Product Int))+    , TestType (Proxy @(Product Natural))+    , TestType (Proxy @[Int])+    , TestType (Proxy @[Natural])+    , TestType (Proxy @(Text))+    , TestType (Proxy @(Dual [Int]))+    , TestType (Proxy @(Dual [Natural]))+    , TestType (Proxy @(Dual Text))+    ]++testTypesReductive :: [TestType Reductive]+testTypesReductive =+    [ TestType (Proxy @(Set Int))+    , TestType (Proxy @(Set Natural))+    , TestType (Proxy @(Sum Int))+    , TestType (Proxy @(Sum Natural))+    , TestType (Proxy @(Product Int))+    , TestType (Proxy @(Product Natural))+    ]++testTypesLeftGCDMonoid :: [TestType LeftGCDMonoid]+testTypesLeftGCDMonoid =+    [ TestType (Proxy @(Set Int))+    , TestType (Proxy @(Set Natural))+    , TestType (Proxy @(Sum Natural))+    , TestType (Proxy @(Product Natural))+    , TestType (Proxy @(Text))+    , TestType (Proxy @(Dual Text))+    ]++testTypesRightGCDMonoid :: [TestType RightGCDMonoid]+testTypesRightGCDMonoid =+    [ TestType (Proxy @(Set Int))+    , TestType (Proxy @(Set Natural))+    , TestType (Proxy @(Sum Natural))+    , TestType (Proxy @(Product Natural))+    , TestType (Proxy @(Text))+    , TestType (Proxy @(Dual Text))+    ]++testTypesOverlappingGCDMonoid :: [TestType OverlappingGCDMonoid]+testTypesOverlappingGCDMonoid =+    [ TestType (Proxy @(Set Int))+    , TestType (Proxy @(Set Natural))+    , TestType (Proxy @(Sum Natural))+    , TestType (Proxy @(Product Natural))+    , TestType (Proxy @(Text))+    , TestType (Proxy @(Dual Text))+    ]++testTypesGCDMonoid :: [TestType GCDMonoid]+testTypesGCDMonoid =+    [ TestType (Proxy @(Set Int))+    , TestType (Proxy @(Set Natural))+    , TestType (Proxy @(Sum Natural))+    , TestType (Proxy @(Product Natural))+    ]++testTypesLCMMonoid :: [TestType LCMMonoid]+testTypesLCMMonoid =+    [ TestType (Proxy @(Set Int))+    , TestType (Proxy @(Set Natural))+    , TestType (Proxy @(Sum Natural))+    , TestType (Proxy @(Product Natural))+    ]++--------------------------------------------------------------------------------+-- Utilities+--------------------------------------------------------------------------------++makeSpec :: forall k v. Test k v => Spec -> Proxy k -> Proxy v -> Spec+makeSpec spec _k _v = describe (show $ typeRep (Proxy @(MonoidMap k v))) spec++property :: Testable t => t -> Property+property = checkCoverage . QC.property
+ src/test/Test/Hspec/Unit.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE FunctionalDependencies #-}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+module Test.Hspec.Unit where++import Prelude++import Data.Functor+    ( (<&>) )+import Test.Hspec+    ( Spec, describe, it )+import Test.QuickCheck+    ( counterexample, property )+import Text.Show.Pretty+    ( ppShow )++import qualified Data.Foldable as F++class IsUnitTestDatum d f r | d -> f, d -> r where+    params :: d -> [String]+    resultActual :: f -> d -> r+    resultExpected :: d -> r++data UnitTestDatum1 p1 r = UnitTestDatum1 p1 r+data UnitTestDatum2 p1 p2 r = UnitTestDatum2 p1 p2 r+data UnitTestDatum3 p1 p2 p3 r = UnitTestDatum3 p1 p2 p3 r+data UnitTestDatum4 p1 p2 p3 p4 r = UnitTestDatum4 p1 p2 p3 p4 r++type UnitTestData1 p1 r = [UnitTestDatum1 p1 r]+type UnitTestData2 p1 p2 r = [UnitTestDatum2 p1 p2 r]+type UnitTestData3 p1 p2 p3 r = [UnitTestDatum3 p1 p2 p3 r]+type UnitTestData4 p1 p2 p3 p4 r = [UnitTestDatum4 p1 p2 p3 p4 r]++unitTestDatum1 :: (p1, r) -> UnitTestDatum1 p1 r+unitTestDatum1 (p1, r) = UnitTestDatum1 p1 r+unitTestDatum2 :: (p1, p2, r) -> UnitTestDatum2 p1 p2 r+unitTestDatum2 (p1, p2, r) = UnitTestDatum2 p1 p2 r+unitTestDatum3 :: (p1, p2, p3, r) -> UnitTestDatum3 p1 p2 p3 r+unitTestDatum3 (p1, p2, p3, r) = UnitTestDatum3 p1 p2 p3 r+unitTestDatum4 :: (p1, p2, p3, p4, r) -> UnitTestDatum4 p1 p2 p3 p4 r+unitTestDatum4 (p1, p2, p3, p4, r) = UnitTestDatum4 p1 p2 p3 p4 r++unitTestData1 :: [(p1, r)] -> UnitTestData1 p1 r+unitTestData1 = fmap unitTestDatum1+unitTestData2 :: [(p1, p2, r)] -> UnitTestData2 p1 p2 r+unitTestData2 = fmap unitTestDatum2+unitTestData3 :: [(p1, p2, p3, r)] -> UnitTestData3 p1 p2 p3 r+unitTestData3 = fmap unitTestDatum3+unitTestData4 :: [(p1, p2, p3, p4, r)] -> UnitTestData4 p1 p2 p3 p4 r+unitTestData4 = fmap unitTestDatum4++instance Show p1 =>+    IsUnitTestDatum (UnitTestDatum1 p1 r) (p1 -> r) r+  where+    params (UnitTestDatum1 p1 _) = [show p1]+    resultActual f (UnitTestDatum1 p1 _) = f p1+    resultExpected (UnitTestDatum1 _ r) = r++instance (Show p1, Show p2) =>+    IsUnitTestDatum (UnitTestDatum2 p1 p2 r) (p1 -> p2 -> r) r+  where+    params (UnitTestDatum2 p1 p2 _) = [show p1, show p2]+    resultActual f (UnitTestDatum2 p1 p2 _) = f p1 p2+    resultExpected (UnitTestDatum2 _ _ r) = r++instance (Show p1, Show p2, Show p3) =>+    IsUnitTestDatum (UnitTestDatum3 p1 p2 p3 r) (p1 -> p2 -> p3 -> r) r+  where+    params (UnitTestDatum3 p1 p2 p3 _) = [show p1, show p2, show p3]+    resultActual f (UnitTestDatum3 p1 p2 p3 _) = f p1 p2 p3+    resultExpected (UnitTestDatum3 _ _ _ r) = r++instance (Show p1, Show p2, Show p3, Show p4) =>+    IsUnitTestDatum (UnitTestDatum4 p1 p2 p3 p4 r) (p1 -> p2 -> p3 -> p4 -> r) r+  where+    params (UnitTestDatum4 p1 p2 p3 p4 _) = [show p1, show p2, show p3, show p4]+    resultActual f (UnitTestDatum4 p1 p2 p3 p4 _) = f p1 p2 p3 p4+    resultExpected (UnitTestDatum4 _ _ _ _ r) = r++unitTestSpec+    :: forall d f r. (IsUnitTestDatum d f r, Eq r, Show r)+    => String+    -> String+    -> f+    -> [d]+    -> Spec+unitTestSpec specDescription functionName function =+    describe specDescription . mapM_ unitTest+  where+    unitTest :: d -> Spec+    unitTest d = it description+        $ property+        $ counterexample counterexampleText+        $ resultExpected d == resultActual function d+      where+        counterexampleText = unlines+            [ ""+            , "expected"+            , "/="+            , "actual"+            , ""+            , showWrap (resultExpected d)+            , "/="+            , showWrap (resultActual function d)+            ]+        description = unwords+            [ functionName+            , unwords (params d <&> \s -> "(" <> s <> ")")+            ]++--------------------------------------------------------------------------------+-- Utilities+--------------------------------------------------------------------------------++showWrap :: Show a => a -> String+showWrap x+    | singleLineMaxLengthExceeded =+        multiLine+    | otherwise =+        singleLine+  where+    multiLine = ppShow x+    singleLine = show x+    singleLineMaxLength = 80+    singleLineMaxLengthExceeded = F.length singleLine > singleLineMaxLength
+ src/test/Test/QuickCheck/Classes/Hspec.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE PolyKinds #-}++-- |+-- Copyright: © 2022–2023 Jonathan Knowles+-- License: Apache-2.0+--+-- Provides testing functions to check that type class instances obey laws.+--+module Test.QuickCheck.Classes.Hspec+    ( testLaws+    , testLawsMany+    ) where++import Prelude++import Control.Monad+    ( forM_ )+import Data.Proxy+    ( Proxy (..) )+import Data.Typeable+    ( Typeable, typeRep )+import Test.Hspec+    ( Spec, describe, it, parallel )+import Test.QuickCheck.Classes+    ( Laws (..) )++-- | Constructs a test to check that the given type class instance obeys the+--   given set of laws.+--+-- Example usage:+--+-- >>> testLaws @Natural ordLaws+-- >>> testLaws @(Map Int) functorLaws+--+testLaws+    :: forall a. Typeable a+    => (Proxy a -> Laws)+    -> Spec+testLaws getLaws =+    parallel $ describe description $+        forM_ (lawsProperties laws) $ uncurry it+  where+    description = mconcat+        [ "Testing "+        , lawsTypeclass laws+        , " laws for type "+        , show (typeRep $ Proxy @a)+        ]+    laws = getLaws $ Proxy @a++-- | Calls `testLaws` with multiple sets of laws.+--+-- Example usage:+--+-- >>> testLawsMany @Natural [eqLaws, ordLaws]+-- >>> testLawsMany @(Map Int) [foldableLaws, functorLaws]+--+testLawsMany+    :: forall a. Typeable a+    => [Proxy a -> Laws]+    -> Spec+testLawsMany getLawsMany =+    testLaws @a `mapM_` getLawsMany