├── .github └── workflows │ └── build.yml ├── .gitignore ├── README.md ├── cabal.project └── packages ├── monoidmap-aeson ├── CHANGELOG.md ├── LICENSE ├── README.md ├── components │ ├── monoidmap-aeson-test │ │ ├── Data │ │ │ └── MonoidMap │ │ │ │ └── JSONSpec.hs │ │ ├── Spec.hs │ │ ├── SpecHook.hs │ │ └── Test │ │ │ ├── Common.hs │ │ │ ├── Key.hs │ │ │ └── QuickCheck │ │ │ └── Classes │ │ │ └── Hspec.hs │ └── monoidmap-aeson │ │ └── Data │ │ └── MonoidMap │ │ └── JSON.hs ├── golden │ ├── MonoidMap (Int,Int) (Dual Text).json │ ├── MonoidMap (Int,Int) (Dual [Int]).json │ ├── MonoidMap (Int,Int) (Dual [Natural]).json │ ├── MonoidMap (Int,Int) (MonoidMap (Key 2) (Sum Int)).json │ ├── MonoidMap (Int,Int) (MonoidMap (Key 2) (Sum Natural)).json │ ├── MonoidMap (Int,Int) (Product Int).json │ ├── MonoidMap (Int,Int) (Product Natural).json │ ├── MonoidMap (Int,Int) (Set Int).json │ ├── MonoidMap (Int,Int) (Set Natural).json │ ├── MonoidMap (Int,Int) (Sum Int).json │ ├── MonoidMap (Int,Int) (Sum Natural).json │ ├── MonoidMap (Int,Int) Text.json │ ├── MonoidMap (Int,Int) [Int].json │ ├── MonoidMap (Int,Int) [Natural].json │ ├── MonoidMap Int (Dual Text).json │ ├── MonoidMap Int (Dual [Int]).json │ ├── MonoidMap Int (Dual [Natural]).json │ ├── MonoidMap Int (MonoidMap (Key 2) (Sum Int)).json │ ├── MonoidMap Int (MonoidMap (Key 2) (Sum Natural)).json │ ├── MonoidMap Int (Product Int).json │ ├── MonoidMap Int (Product Natural).json │ ├── MonoidMap Int (Set Int).json │ ├── MonoidMap Int (Set Natural).json │ ├── MonoidMap Int (Sum Int).json │ ├── MonoidMap Int (Sum Natural).json │ ├── MonoidMap Int Text.json │ ├── MonoidMap Int [Int].json │ ├── MonoidMap Int [Natural].json │ ├── MonoidMap Text (Dual Text).json │ ├── MonoidMap Text (Dual [Int]).json │ ├── MonoidMap Text (Dual [Natural]).json │ ├── MonoidMap Text (MonoidMap (Key 2) (Sum Int)).json │ ├── MonoidMap Text (MonoidMap (Key 2) (Sum Natural)).json │ ├── MonoidMap Text (Product Int).json │ ├── MonoidMap Text (Product Natural).json │ ├── MonoidMap Text (Set Int).json │ ├── MonoidMap Text (Set Natural).json │ ├── MonoidMap Text (Sum Int).json │ ├── MonoidMap Text (Sum Natural).json │ ├── MonoidMap Text Text.json │ ├── MonoidMap Text [Int].json │ ├── MonoidMap Text [Natural].json │ ├── MonoidMap [Int] (Dual Text).json │ ├── MonoidMap [Int] (Dual [Int]).json │ ├── MonoidMap [Int] (Dual [Natural]).json │ ├── MonoidMap [Int] (MonoidMap (Key 2) (Sum Int)).json │ ├── MonoidMap [Int] (MonoidMap (Key 2) (Sum Natural)).json │ ├── MonoidMap [Int] (Product Int).json │ ├── MonoidMap [Int] (Product Natural).json │ ├── MonoidMap [Int] (Set Int).json │ ├── MonoidMap [Int] (Set Natural).json │ ├── MonoidMap [Int] (Sum Int).json │ ├── MonoidMap [Int] (Sum Natural).json │ ├── MonoidMap [Int] Text.json │ ├── MonoidMap [Int] [Int].json │ └── MonoidMap [Int] [Natural].json └── monoidmap-aeson.cabal ├── monoidmap-examples ├── CHANGELOG.md ├── LICENSE ├── README.md ├── components │ ├── monoidmap-examples-test │ │ ├── Data │ │ │ └── MonoidMap │ │ │ │ └── Examples │ │ │ │ └── MultiMapSpec.hs │ │ ├── Spec.hs │ │ └── SpecHook.hs │ └── monoidmap-examples │ │ └── Data │ │ └── MonoidMap │ │ └── Examples │ │ ├── MultiMap.hs │ │ ├── MultiMap │ │ ├── Class.hs │ │ └── Instances │ │ │ ├── MultiMap1.hs │ │ │ ├── MultiMap2.hs │ │ │ ├── MultiMap3.hs │ │ │ └── MultiMap4.hs │ │ ├── MultiSet.hs │ │ ├── NestedMonoidMap.hs │ │ └── Set │ │ └── NonEmpty.hs └── monoidmap-examples.cabal ├── monoidmap-internal ├── CHANGELOG.md ├── LICENSE ├── README.md ├── components │ ├── monoidmap-benchmark │ │ └── Main.hs │ ├── monoidmap-internal │ │ └── Data │ │ │ └── MonoidMap │ │ │ ├── Internal.hs │ │ │ └── Internal │ │ │ ├── RecoveredMap.hs │ │ │ └── Unsafe.hs │ └── monoidmap-test │ │ ├── Data │ │ └── MonoidMap │ │ │ └── Internal │ │ │ ├── AccessSpec.hs │ │ │ ├── ClassSpec.hs │ │ │ ├── ComparisonSpec.hs │ │ │ ├── ConversionSpec.hs │ │ │ ├── DistributivitySpec.hs │ │ │ ├── ExampleSpec.hs │ │ │ ├── FilterSpec.hs │ │ │ ├── FoldSpec.hs │ │ │ ├── IntersectionSpec.hs │ │ │ ├── MapSpec.hs │ │ │ ├── MembershipSpec.hs │ │ │ ├── PartitionSpec.hs │ │ │ ├── PrefixSpec.hs │ │ │ ├── RecoveredMapSpec.hs │ │ │ ├── SingletonSpec.hs │ │ │ ├── SliceSpec.hs │ │ │ ├── SuffixSpec.hs │ │ │ ├── TraversalSpec.hs │ │ │ ├── UnionSpec.hs │ │ │ └── ValiditySpec.hs │ │ ├── Spec.hs │ │ ├── SpecHook.hs │ │ └── Test │ │ ├── Combinators │ │ └── NonZero.hs │ │ ├── Common.hs │ │ ├── Hspec │ │ └── Unit.hs │ │ ├── Key.hs │ │ └── QuickCheck │ │ └── Classes │ │ └── Hspec.hs └── monoidmap-internal.cabal ├── monoidmap-quickcheck ├── CHANGELOG.md ├── LICENSE ├── README.md ├── components │ └── monoidmap-quickcheck │ │ └── Data │ │ └── MonoidMap │ │ └── QuickCheck │ │ ├── Instances.hs │ │ └── Instances │ │ ├── Arbitrary.hs │ │ ├── CoArbitrary.hs │ │ └── Function.hs └── monoidmap-quickcheck.cabal └── monoidmap ├── CHANGELOG.md ├── LICENSE ├── README.md ├── components └── monoidmap │ └── Data │ └── MonoidMap.hs └── monoidmap.cabal /.github/workflows/build.yml: -------------------------------------------------------------------------------- 1 | name: Build 2 | on: 3 | workflow_dispatch: 4 | pull_request: 5 | types: 6 | - synchronize 7 | - opened 8 | - reopened 9 | push: 10 | branches: 11 | - main 12 | schedule: 13 | # Run once per day (at UTC 18:00) to maintain cache: 14 | - cron: 0 18 * * * 15 | jobs: 16 | build: 17 | name: ${{ matrix.os }}-ghc-${{ matrix.ghc }} 18 | runs-on: ${{ matrix.os }} 19 | env: 20 | cabal-build-dir: dist-newstyle 21 | strategy: 22 | matrix: 23 | os: 24 | - ubuntu-latest 25 | - macOS-latest 26 | - windows-latest 27 | cabal: 28 | - '3.12' 29 | ghc: 30 | - '8.10' 31 | - '9.0' 32 | - '9.2' 33 | - '9.4' 34 | - '9.6' 35 | - '9.8' 36 | - '9.10' 37 | - '9.12' 38 | exclude: 39 | # TODO: https://github.com/haskell-actions/setup/issues/77 40 | # To work around the above issue, we exclude the following versions: 41 | - os: macOS-latest 42 | ghc: '8.10' 43 | - os: macOS-latest 44 | ghc: '9.0' 45 | steps: 46 | - name: Checkout 47 | uses: actions/checkout@v4 48 | 49 | - name: Environment 50 | uses: haskell-actions/setup@v2 51 | id: setup-haskell-cabal 52 | with: 53 | ghc-version: ${{ matrix.ghc }} 54 | cabal-version: ${{ matrix.cabal }} 55 | 56 | - name: Configure 57 | run: > 58 | cabal configure 59 | --builddir=${{ env.cabal-build-dir }} 60 | --enable-tests 61 | --enable-benchmarks 62 | --enable-documentation 63 | --test-show-details=direct 64 | --write-ghc-environment-files=always 65 | 66 | - name: Freeze 67 | run: > 68 | cabal freeze 69 | --builddir=${{ env.cabal-build-dir }} 70 | 71 | - name: Cache 72 | uses: actions/cache@v4 73 | env: 74 | hash: ${{ hashFiles('cabal.project.freeze') }} 75 | with: 76 | key: ${{ matrix.os }}-ghc-${{ matrix.ghc }}-${{ env.hash }} 77 | restore-keys: | 78 | ${{ matrix.os }}-ghc-${{ matrix.ghc }}- 79 | path: | 80 | ${{ steps.setup-haskell-cabal.outputs.cabal-store }} 81 | ${{ env.cabal-build-dir }} 82 | 83 | - name: Dependencies 84 | run: > 85 | cabal build all 86 | --builddir=${{ env.cabal-build-dir }} 87 | --only-dependencies 88 | 89 | - name: Build 90 | run: > 91 | cabal build all 92 | --builddir=${{ env.cabal-build-dir }} 93 | --enable-tests 94 | --enable-benchmarks 95 | 96 | - name: Test 97 | run: > 98 | cabal test all 99 | --builddir=${{ env.cabal-build-dir }} 100 | 101 | - name: Benchmark 102 | run: > 103 | cabal bench all 104 | --builddir=${{ env.cabal-build-dir }} 105 | || true 106 | 107 | - name: Documentation (Generation) 108 | if: | 109 | matrix.os == 'ubuntu-latest' 110 | && matrix.ghc == '9.12' 111 | run: > 112 | cabal haddock-project 113 | --hackage 114 | --output=gh-pages 115 | 116 | - name: Documentation (Staging) 117 | if: | 118 | github.ref == 'refs/heads/main' 119 | && matrix.os == 'ubuntu-latest' 120 | && matrix.ghc == '9.12' 121 | run: > 122 | touch gh-pages/.nojekyll 123 | 124 | - name: Documentation (Deployment) 125 | if: | 126 | github.ref == 'refs/heads/main' 127 | && matrix.os == 'ubuntu-latest' 128 | && matrix.ghc == '9.12' 129 | uses: JamesIves/github-pages-deploy-action@v4 130 | with: 131 | branch: gh-pages 132 | folder: gh-pages 133 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | build-documentation.sh 2 | cabal.project.local 3 | dist-newstyle 4 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # `monoidmap` 2 | 3 | 4 | This repository contains source code and [documentation](https://github.com/jonathanknowles/monoidmap/tree/main/packages/monoidmap#readme) for the Haskell [`monoidmap`](https://hackage-content.haskell.org/package/monoidmap) package, which defines the [`MonoidMap`](https://hackage-content.haskell.org/package/monoidmap/docs/Data-MonoidMap.html#g:1) data type, providing a total mapping from keys to monoidal values. 5 | 6 | The following packages are included in this repository: 7 | 8 | | Package | Description | 9 | |--|--| 10 | | 📦 [`monoidmap`](https://hackage.haskell.org/package/monoidmap) | Provides the core [`MonoidMap`](https://hackage-content.haskell.org/package/monoidmap/docs/Data-MonoidMap.html#g:1) data type and functions. | 11 | | 📦 [`monoidmap-examples`](https://hackage.haskell.org/package/monoidmap-examples) | Provides worked examples of how to use [`MonoidMap`](https://hackage-content.haskell.org/package/monoidmap/docs/Data-MonoidMap.html#g:1). | 12 | | 📦 [`monoidmap-aeson`](https://hackage.haskell.org/package/monoidmap-aeson) | Provides support for JSON encoding with [`aeson`](https://hackage.haskell.org/package/aeson). | 13 | | 📦 [`monoidmap-quickcheck`](https://hackage.haskell.org/package/monoidmap-quickcheck) | Provides support for property testing with [`QuickCheck`](https://hackage.haskell.org/package/QuickCheck). | 14 | | 📦 [`monoidmap-internal`](https://hackage.haskell.org/package/monoidmap-internal) | Provides low-level internal functions. 🐉 | 15 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: 2 | packages/* 3 | -------------------------------------------------------------------------------- /packages/monoidmap-aeson/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # 0.0.0.5 2 | 3 | - Bumped lower bound on `monoidmap`. 4 | 5 | # 0.0.0.4 6 | 7 | - Refreshed documentation. 8 | 9 | # 0.0.0.3 10 | 11 | - Simplified imports required for documentation. 12 | 13 | # 0.0.0.2 14 | 15 | - Adjusted module `Data.MonoidMap.JSON` to only use explicit imports. 16 | 17 | # 0.0.0.1 18 | 19 | - Added JSON golden test files to source distribution. 20 | 21 | # 0.0.0.0 22 | 23 | - Initial release. 24 | -------------------------------------------------------------------------------- /packages/monoidmap-aeson/README.md: -------------------------------------------------------------------------------- 1 | # `monoidmap-aeson` 2 | 3 | 4 | ## Overview 5 | 6 | This package provides JSON serialisation support for the [`monoidmap`](https://hackage.haskell.org/package/monoidmap) package with [`aeson`](https://hackage.haskell.org/package/aeson). 7 | -------------------------------------------------------------------------------- /packages/monoidmap-aeson/components/monoidmap-aeson-test/Data/MonoidMap/JSONSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ExistentialQuantification #-} 2 | {-# OPTIONS_GHC -fno-warn-orphans #-} 3 | 4 | -- | 5 | -- Copyright: © 2022–2025 Jonathan Knowles 6 | -- License: Apache-2.0 7 | -- 8 | module Data.MonoidMap.JSONSpec 9 | ( spec 10 | ) 11 | where 12 | 13 | import Prelude 14 | 15 | import Control.Monad 16 | ( forM_ 17 | ) 18 | import Data.MonoidMap 19 | ( MonoidMap 20 | ) 21 | import Data.MonoidMap.JSON 22 | ( 23 | ) 24 | import Data.Proxy 25 | ( Proxy (Proxy) 26 | ) 27 | import Data.Text 28 | ( Text 29 | ) 30 | import Test.Aeson.Internal.GoldenSpecs 31 | ( goldenSpecs 32 | ) 33 | import Test.Common 34 | ( Test 35 | , TestKey 36 | , TestValueType (TestValueType) 37 | , makeSpec 38 | , testValueTypesAll 39 | ) 40 | import Test.Hspec 41 | ( Spec 42 | , describe 43 | ) 44 | import Test.QuickCheck.Classes 45 | ( jsonLaws 46 | ) 47 | import Test.QuickCheck.Classes.Hspec 48 | ( testLaws 49 | ) 50 | 51 | import qualified Test.Aeson.Internal.Utils as Golden 52 | 53 | spec :: Spec 54 | spec = do 55 | describe "JSON" 56 | $ forM_ testKeyValueTypes 57 | $ \(TestKeyType k, TestValueType v) -> specForTypes k v 58 | where 59 | testKeyValueTypes = 60 | [(kt, vt) | kt <- testKeyTypes, vt <- testValueTypesAll] 61 | 62 | specForTypes :: forall k v. (Test k v) => Proxy k -> Proxy v -> Spec 63 | specForTypes = makeSpec $ do 64 | testLaws @(MonoidMap k v) jsonLaws 65 | goldenSpecs goldenSettings (Proxy @(MonoidMap k v)) 66 | 67 | goldenSettings :: Golden.Settings 68 | goldenSettings = 69 | Golden.defaultSettings 70 | { Golden.goldenDirectoryOption = 71 | Golden.CustomDirectoryName "golden" 72 | , Golden.comparisonFile = 73 | Golden.OverwriteGoldenFile 74 | , Golden.randomMismatchOption = 75 | Golden.RandomMismatchError 76 | , Golden.useModuleNameAsSubDirectory = 77 | False 78 | , Golden.sampleSize = 79 | 10 80 | } 81 | 82 | data TestKeyType = forall k. (TestKey k) => TestKeyType (Proxy k) 83 | 84 | testKeyTypes :: [TestKeyType] 85 | testKeyTypes = 86 | mconcat [testKeyTypes_textual, testKeyTypes_nonTextual] 87 | where 88 | -- A selection of key types for which keys are encoded as JSON strings. 89 | -- For these types, 'MonoidMap' objects are encoded as JSON objects. 90 | testKeyTypes_textual = 91 | [ TestKeyType (Proxy @Int) 92 | , TestKeyType (Proxy @Text) 93 | ] 94 | -- A selection of key types for which keys are NOT encoded as JSON strings. 95 | -- For these types, 'MonoidMap' objects are encoded as JSON arrays. 96 | testKeyTypes_nonTextual = 97 | [ TestKeyType (Proxy @[Int]) 98 | , TestKeyType (Proxy @(Int, Int)) 99 | ] 100 | -------------------------------------------------------------------------------- /packages/monoidmap-aeson/components/monoidmap-aeson-test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | -------------------------------------------------------------------------------- /packages/monoidmap-aeson/components/monoidmap-aeson-test/SpecHook.hs: -------------------------------------------------------------------------------- 1 | module SpecHook where 2 | 3 | import Test.Hspec 4 | 5 | hook :: Spec -> Spec 6 | hook = parallel 7 | -------------------------------------------------------------------------------- /packages/monoidmap-aeson/components/monoidmap-aeson-test/Test/Common.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ExistentialQuantification #-} 2 | {-# OPTIONS_GHC -fno-warn-orphans #-} 3 | {- HLINT ignore "Redundant bracket" -} 4 | {- HLINT ignore "Use camelCase" -} 5 | {- HLINT ignore "Use null" -} 6 | 7 | -- | 8 | -- Copyright: © 2022–2025 Jonathan Knowles 9 | -- License: Apache-2.0 10 | -- 11 | module Test.Common 12 | ( Key 13 | , Test 14 | , TestKey 15 | , TestValueType (..) 16 | , testValueTypesAll 17 | , TestValue 18 | , makeSpec 19 | , property 20 | ) where 21 | 22 | import Prelude 23 | 24 | import Data.Aeson 25 | ( FromJSON 26 | , FromJSONKey 27 | , ToJSON 28 | , ToJSONKey 29 | ) 30 | import Data.Kind 31 | ( Constraint, Type ) 32 | import Data.Monoid 33 | ( Dual, Product, Sum ) 34 | import Data.Monoid.Null 35 | ( MonoidNull ) 36 | import Data.MonoidMap 37 | ( MonoidMap ) 38 | import Data.MonoidMap.JSON 39 | () 40 | import Data.Proxy 41 | ( Proxy (Proxy) ) 42 | import Data.Set 43 | ( Set ) 44 | import Data.Text 45 | ( Text ) 46 | import Data.Typeable 47 | ( Typeable, typeRep ) 48 | import GHC.Exts 49 | ( IsList (..) ) 50 | import Numeric.Natural 51 | ( Natural ) 52 | import Test.Hspec 53 | ( Spec, describe ) 54 | import Test.Key 55 | ( Key2, Key4 ) 56 | import Test.QuickCheck 57 | ( Arbitrary (..) 58 | , CoArbitrary (..) 59 | , Function (..) 60 | , Property 61 | , Testable 62 | , arbitrarySizedIntegral 63 | , checkCoverage 64 | , coarbitraryIntegral 65 | , coarbitraryShow 66 | , frequency 67 | , functionIntegral 68 | , functionMap 69 | , functionShow 70 | , listOf 71 | , scale 72 | , shrinkIntegral 73 | , shrinkMapBy 74 | ) 75 | 76 | import qualified Data.MonoidMap as MonoidMap 77 | import qualified Data.Text as Text 78 | import qualified Test.QuickCheck as QC 79 | 80 | -------------------------------------------------------------------------------- 81 | -- Arbitrary instances 82 | -------------------------------------------------------------------------------- 83 | 84 | instance (Arbitrary k, Ord k, Arbitrary v, MonoidNull v) => 85 | Arbitrary (MonoidMap k v) 86 | where 87 | arbitrary = 88 | fromList <$> scale (`mod` 16) (listOf ((,) <$> arbitrary <*> arbitrary)) 89 | shrink = 90 | shrinkMapBy MonoidMap.fromMap MonoidMap.toMap shrink 91 | 92 | instance (CoArbitrary k, CoArbitrary v) => 93 | CoArbitrary (MonoidMap k v) 94 | where 95 | coarbitrary = coarbitrary . MonoidMap.toMap 96 | 97 | instance (Function k, Function v, Ord k, MonoidNull v) => 98 | Function (MonoidMap k v) 99 | where 100 | function = functionMap MonoidMap.toMap MonoidMap.fromMap 101 | 102 | instance Arbitrary Natural where 103 | arbitrary = arbitrarySizedIntegral 104 | shrink = shrinkIntegral 105 | 106 | instance CoArbitrary Natural where 107 | coarbitrary = coarbitraryIntegral 108 | 109 | instance Function Natural where 110 | function = functionIntegral 111 | 112 | instance Arbitrary Text where 113 | arbitrary = Text.pack <$> listOf genChar 114 | where 115 | genChar = frequency 116 | [ (64, pure 'a') 117 | , (16, pure 'b') 118 | , ( 4, pure 'c') 119 | , ( 1, pure 'd') 120 | ] 121 | 122 | instance CoArbitrary Text where 123 | coarbitrary = coarbitraryShow 124 | 125 | instance Function Text where 126 | function = functionShow 127 | 128 | -------------------------------------------------------------------------------- 129 | -- Test keys 130 | -------------------------------------------------------------------------------- 131 | 132 | type SmallKey = Key2 133 | type Key = Key4 134 | 135 | -------------------------------------------------------------------------------- 136 | -- Test constraints 137 | -------------------------------------------------------------------------------- 138 | 139 | type Test k v = (TestKey k, TestValue v) 140 | 141 | type TestKey k = 142 | ( Arbitrary k 143 | , CoArbitrary k 144 | , Function k 145 | , Ord k 146 | , Show k 147 | , Typeable k 148 | , ToJSONKey k 149 | , FromJSONKey k 150 | ) 151 | 152 | type TestValue v = 153 | ( Arbitrary v 154 | , CoArbitrary v 155 | , Eq v 156 | , Function v 157 | , MonoidNull v 158 | , Show v 159 | , Typeable v 160 | , ToJSON v 161 | , FromJSON v 162 | ) 163 | 164 | -------------------------------------------------------------------------------- 165 | -- Test value types 166 | -------------------------------------------------------------------------------- 167 | 168 | data TestValueType (c :: Type -> Constraint) = 169 | forall v. (TestValue v, c v) => TestValueType (Proxy v) 170 | 171 | testValueTypesAll :: [TestValueType MonoidNull] 172 | testValueTypesAll = 173 | [ TestValueType (Proxy @(Dual Text)) 174 | , TestValueType (Proxy @(Dual [Int])) 175 | , TestValueType (Proxy @(Dual [Natural])) 176 | , TestValueType (Proxy @(Product Int)) 177 | , TestValueType (Proxy @(Product Natural)) 178 | , TestValueType (Proxy @(Set Int)) 179 | , TestValueType (Proxy @(Set Natural)) 180 | , TestValueType (Proxy @(Sum Int)) 181 | , TestValueType (Proxy @(Sum Natural)) 182 | , TestValueType (Proxy @(Text)) 183 | , TestValueType (Proxy @[Int]) 184 | , TestValueType (Proxy @[Natural]) 185 | , TestValueType (Proxy @(MonoidMap SmallKey (Sum Int))) 186 | , TestValueType (Proxy @(MonoidMap SmallKey (Sum Natural))) 187 | ] 188 | 189 | -------------------------------------------------------------------------------- 190 | -- Utilities 191 | -------------------------------------------------------------------------------- 192 | 193 | makeSpec :: forall k v. Test k v => Spec -> Proxy k -> Proxy v -> Spec 194 | makeSpec spec _k _v = describe (show $ typeRep (Proxy @(MonoidMap k v))) spec 195 | 196 | property :: Testable t => t -> Property 197 | property = checkCoverage . QC.property 198 | -------------------------------------------------------------------------------- /packages/monoidmap-aeson/components/monoidmap-aeson-test/Test/Key.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | 5 | -- | 6 | -- Copyright: © 2022–2025 Jonathan Knowles 7 | -- License: Apache-2.0 8 | -- 9 | -- Quasi-unique keys. 10 | -- 11 | module Test.Key 12 | ( Key1 13 | , Key2 14 | , Key4 15 | , Key8 16 | ) 17 | where 18 | 19 | import Prelude 20 | 21 | import Data.Aeson.Types 22 | ( FromJSON (parseJSON) 23 | , FromJSONKey (fromJSONKey) 24 | , FromJSONKeyFunction (FromJSONKeyTextParser) 25 | , Parser 26 | , ToJSON (toEncoding, toJSON) 27 | , ToJSONKey (toJSONKey) 28 | , toJSONKeyText 29 | , withText 30 | ) 31 | import Data.Text 32 | ( Text 33 | ) 34 | import GHC.Generics 35 | ( Generic 36 | ) 37 | import GHC.TypeLits 38 | ( Nat 39 | ) 40 | import Test.QuickCheck 41 | ( Arbitrary 42 | , CoArbitrary 43 | , Function 44 | ) 45 | import Test.QuickCheck.Quid 46 | ( Latin (Latin) 47 | , Quid 48 | , Size (Size) 49 | ) 50 | import Text.Read 51 | ( readMaybe 52 | ) 53 | 54 | import qualified Data.Text as Text 55 | 56 | newtype Key (size :: Nat) = Key Quid 57 | deriving stock (Eq, Generic, Ord) 58 | deriving (Read, Show) via Latin Quid 59 | deriving (Arbitrary) via Size size Quid 60 | deriving (CoArbitrary) via Quid 61 | deriving anyclass (Function) 62 | 63 | type Key1 = Key 1 64 | type Key2 = Key 2 65 | type Key4 = Key 4 66 | type Key8 = Key 8 67 | 68 | instance ToJSON (Key size) where 69 | toEncoding = toEncoding . toText 70 | toJSON = toJSON . toText 71 | 72 | instance ToJSONKey (Key size) where 73 | toJSONKey = toJSONKeyText toText 74 | 75 | instance FromJSON (Key size) where 76 | parseJSON = withText "Key" parseFromText 77 | 78 | instance FromJSONKey (Key size) where 79 | fromJSONKey = FromJSONKeyTextParser parseFromText 80 | 81 | toText :: Key size -> Text 82 | toText = Text.dropAround (== '\"') . Text.pack . show 83 | 84 | maybeFromText :: Text -> Maybe (Key size) 85 | maybeFromText = readMaybe . show . Text.unpack 86 | 87 | parseFromText :: Text -> Parser (Key size) 88 | parseFromText = 89 | maybe (fail failureMessage) pure . maybeFromText 90 | where 91 | failureMessage = "Failed to parse key from JSON" 92 | -------------------------------------------------------------------------------- /packages/monoidmap-aeson/components/monoidmap-aeson-test/Test/QuickCheck/Classes/Hspec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE PolyKinds #-} 2 | 3 | -- | 4 | -- Copyright: © 2022–2025 Jonathan Knowles 5 | -- License: Apache-2.0 6 | -- 7 | -- Provides testing functions to check that type class instances obey laws. 8 | -- 9 | module Test.QuickCheck.Classes.Hspec 10 | ( testLaws 11 | , testLawsMany 12 | ) where 13 | 14 | import Prelude 15 | 16 | import Control.Monad 17 | ( forM_ ) 18 | import Data.Proxy 19 | ( Proxy (..) ) 20 | import Data.Typeable 21 | ( Typeable, typeRep ) 22 | import Test.Hspec 23 | ( Spec, describe, it, parallel ) 24 | import Test.QuickCheck.Classes 25 | ( Laws (..) ) 26 | 27 | -- | Constructs a test to check that the given type class instance obeys the 28 | -- given set of laws. 29 | -- 30 | -- Example usage: 31 | -- 32 | -- >>> testLaws @Natural ordLaws 33 | -- >>> testLaws @(Map Int) functorLaws 34 | -- 35 | testLaws 36 | :: forall a. Typeable a 37 | => (Proxy a -> Laws) 38 | -> Spec 39 | testLaws getLaws = 40 | parallel $ describe description $ 41 | forM_ (lawsProperties laws) $ uncurry it 42 | where 43 | description = mconcat 44 | [ "Testing " 45 | , lawsTypeclass laws 46 | , " laws for type " 47 | , show (typeRep $ Proxy @a) 48 | ] 49 | laws = getLaws $ Proxy @a 50 | 51 | -- | Calls `testLaws` with multiple sets of laws. 52 | -- 53 | -- Example usage: 54 | -- 55 | -- >>> testLawsMany @Natural [eqLaws, ordLaws] 56 | -- >>> testLawsMany @(Map Int) [foldableLaws, functorLaws] 57 | -- 58 | testLawsMany 59 | :: forall a. Typeable a 60 | => [Proxy a -> Laws] 61 | -> Spec 62 | testLawsMany getLawsMany = 63 | testLaws @a `mapM_` getLawsMany 64 | -------------------------------------------------------------------------------- /packages/monoidmap-aeson/components/monoidmap-aeson/Data/MonoidMap/JSON.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wno-orphans #-} 2 | 3 | -- | 4 | -- Copyright: © 2022–2025 Jonathan Knowles 5 | -- License: Apache-2.0 6 | -- 7 | module Data.MonoidMap.JSON 8 | ( 9 | -- * Introduction 10 | -- $_introduction 11 | 12 | -- * Examples 13 | -- $_examples 14 | 15 | -- * Laws 16 | -- $_laws 17 | ) 18 | where 19 | 20 | import Data.Aeson 21 | ( FromJSON (parseJSON) 22 | , FromJSONKey 23 | , ToJSON (toEncoding, toJSON) 24 | , ToJSONKey 25 | , decode 26 | , encode 27 | ) 28 | import Data.Bool 29 | ( Bool 30 | ) 31 | import Data.Eq 32 | ( Eq ((==)) 33 | ) 34 | import Data.Functor 35 | ( Functor (fmap) 36 | ) 37 | import Data.Map.Strict 38 | ( Map 39 | ) 40 | import Data.Maybe 41 | ( Maybe 42 | ) 43 | import Data.Monoid 44 | ( Monoid (mempty) 45 | , Sum 46 | ) 47 | import Data.Monoid.Null 48 | ( MonoidNull 49 | ) 50 | import Data.MonoidMap 51 | ( MonoidMap 52 | , fromList 53 | , fromMap 54 | , toList 55 | , toMap 56 | ) 57 | import Data.Ord 58 | ( Ord 59 | ) 60 | import Prelude 61 | ( undefined 62 | , ($) 63 | , (.) 64 | ) 65 | 66 | -- $_introduction 67 | -- #_introduction# 68 | -- 69 | -- This module provides instances of 'ToJSON' and 'FromJSON' for 'MonoidMap'. 70 | -- 71 | -- These instances provide objects of type 'MonoidMap' __@k@__ __@v@__ with a 72 | -- JSON encoding that is /identical/ to objects of type 'Map' __@k@__ __@v@__, 73 | -- which are serialised as either JSON /objects/ or /arrays/ depending on the 74 | -- key type __@k@__. 75 | 76 | -- $_examples 77 | -- #_examples# 78 | -- 79 | -- === Encoding as JSON objects 80 | -- 81 | -- @ 82 | -- >>> 'encode' '$' 'MonoidMap'.'fromList' [("abc", 'Sum' 1), ("def", 'Sum' 2)] 83 | -- 84 | -- "{\\"abc\\":1,\\"def\\":2}" 85 | -- @ 86 | -- 87 | -- === Encoding as JSON arrays 88 | -- 89 | -- @ 90 | -- >>> 'encode' '$' 'MonoidMap'.'fromList' [((1,2), 'Sum' 3), ((2,3), 'Sum' 5)] 91 | -- 92 | -- "[[[1,2],3],[[2,3],5]]" 93 | -- @ 94 | 95 | -- $_laws 96 | -- #_laws# 97 | -- 98 | -- === Encoding to JSON 99 | -- 100 | -- The 'ToJSON' instance satisfies the following laws: 101 | -- 102 | -- @ 103 | -- 'toEncoding' '==' 'toEncoding' '.' 'MonoidMap'.'toMap' 104 | -- 'toJSON' '==' 'toJSON' '.' 'MonoidMap'.'toMap' 105 | -- @ 106 | -- 107 | -- === Decoding from JSON 108 | -- 109 | -- The 'FromJSON' instance satisfies the following law: 110 | -- 111 | -- @ 112 | -- 'parseJSON' '==' 'fmap' ('fmap' 'MonoidMap'.'fromMap') 'parseJSON' 113 | -- @ 114 | -- 115 | -- Mappings from keys to values that decode to 'mempty' are __not__ included in 116 | -- decoded 'MonoidMap' objects. 117 | 118 | _importsRequiredForDocumentation :: () 119 | _importsRequiredForDocumentation = () 120 | where 121 | _Map :: Map () () 122 | _Map = undefined 123 | 124 | _Sum :: Sum () 125 | _Sum = undefined 126 | 127 | _decodeEncode :: Maybe () 128 | _decodeEncode = decode $ encode () 129 | 130 | _equals :: () -> () -> Bool 131 | _equals = (==) 132 | 133 | _fromListToList :: [((), ())] 134 | _fromListToList = toList $ fromList [] 135 | 136 | _mempty :: () 137 | _mempty = mempty 138 | 139 | instance 140 | ( ToJSONKey k 141 | , ToJSON v 142 | ) 143 | => ToJSON (MonoidMap k v) 144 | where 145 | toEncoding = toEncoding . toMap 146 | toJSON = toJSON . toMap 147 | 148 | instance 149 | ( FromJSONKey k 150 | , Ord k 151 | , FromJSON v 152 | , MonoidNull v 153 | ) 154 | => FromJSON (MonoidMap k v) 155 | where 156 | parseJSON = fmap (fmap fromMap) parseJSON 157 | -------------------------------------------------------------------------------- /packages/monoidmap-aeson/golden/MonoidMap (Int,Int) (Sum Natural).json: -------------------------------------------------------------------------------- 1 | { 2 | "samples": [ 3 | [ 4 | [ 5 | [ 6 | -7, 7 | -13 8 | ], 9 | 1 10 | ], 11 | [ 12 | [ 13 | -1, 14 | -3 15 | ], 16 | 3 17 | ] 18 | ], 19 | [ 20 | [ 21 | [ 22 | -10, 23 | 2 24 | ], 25 | 7 26 | ], 27 | [ 28 | [ 29 | -1, 30 | 9 31 | ], 32 | 14 33 | ], 34 | [ 35 | [ 36 | 0, 37 | 10 38 | ], 39 | 4 40 | ], 41 | [ 42 | [ 43 | 5, 44 | 4 45 | ], 46 | 11 47 | ] 48 | ], 49 | [ 50 | [ 51 | [ 52 | -14, 53 | 1 54 | ], 55 | 2 56 | ], 57 | [ 58 | [ 59 | -14, 60 | 5 61 | ], 62 | 9 63 | ], 64 | [ 65 | [ 66 | -12, 67 | 4 68 | ], 69 | 9 70 | ], 71 | [ 72 | [ 73 | -11, 74 | 11 75 | ], 76 | 13 77 | ], 78 | [ 79 | [ 80 | -11, 81 | 14 82 | ], 83 | 3 84 | ], 85 | [ 86 | [ 87 | 5, 88 | 2 89 | ], 90 | 1 91 | ], 92 | [ 93 | [ 94 | 7, 95 | 0 96 | ], 97 | 13 98 | ], 99 | [ 100 | [ 101 | 8, 102 | 4 103 | ], 104 | 4 105 | ], 106 | [ 107 | [ 108 | 11, 109 | -7 110 | ], 111 | 11 112 | ], 113 | [ 114 | [ 115 | 13, 116 | -2 117 | ], 118 | 7 119 | ] 120 | ], 121 | [ 122 | [ 123 | [ 124 | -9, 125 | 3 126 | ], 127 | 8 128 | ], 129 | [ 130 | [ 131 | -4, 132 | -4 133 | ], 134 | 7 135 | ], 136 | [ 137 | [ 138 | 12, 139 | -1 140 | ], 141 | 2 142 | ] 143 | ], 144 | [ 145 | [ 146 | [ 147 | -10, 148 | 14 149 | ], 150 | 12 151 | ], 152 | [ 153 | [ 154 | -5, 155 | 9 156 | ], 157 | 2 158 | ], 159 | [ 160 | [ 161 | 1, 162 | 0 163 | ], 164 | 13 165 | ] 166 | ], 167 | [ 168 | [ 169 | [ 170 | 0, 171 | -10 172 | ], 173 | 11 174 | ] 175 | ], 176 | [ 177 | [ 178 | [ 179 | -11, 180 | 9 181 | ], 182 | 11 183 | ], 184 | [ 185 | [ 186 | -8, 187 | -3 188 | ], 189 | 11 190 | ], 191 | [ 192 | [ 193 | -6, 194 | -13 195 | ], 196 | 4 197 | ], 198 | [ 199 | [ 200 | -6, 201 | 8 202 | ], 203 | 8 204 | ], 205 | [ 206 | [ 207 | -3, 208 | -14 209 | ], 210 | 11 211 | ], 212 | [ 213 | [ 214 | -2, 215 | 9 216 | ], 217 | 10 218 | ], 219 | [ 220 | [ 221 | 6, 222 | -13 223 | ], 224 | 9 225 | ], 226 | [ 227 | [ 228 | 10, 229 | -11 230 | ], 231 | 12 232 | ], 233 | [ 234 | [ 235 | 12, 236 | -10 237 | ], 238 | 9 239 | ], 240 | [ 241 | [ 242 | 12, 243 | -5 244 | ], 245 | 13 246 | ], 247 | [ 248 | [ 249 | 14, 250 | 6 251 | ], 252 | 9 253 | ] 254 | ], 255 | [ 256 | [ 257 | [ 258 | -9, 259 | 13 260 | ], 261 | 14 262 | ], 263 | [ 264 | [ 265 | -2, 266 | -13 267 | ], 268 | 3 269 | ], 270 | [ 271 | [ 272 | 0, 273 | -14 274 | ], 275 | 3 276 | ], 277 | [ 278 | [ 279 | 1, 280 | -14 281 | ], 282 | 7 283 | ], 284 | [ 285 | [ 286 | 1, 287 | -4 288 | ], 289 | 1 290 | ], 291 | [ 292 | [ 293 | 7, 294 | -7 295 | ], 296 | 9 297 | ], 298 | [ 299 | [ 300 | 7, 301 | 0 302 | ], 303 | 13 304 | ], 305 | [ 306 | [ 307 | 13, 308 | 4 309 | ], 310 | 1 311 | ] 312 | ], 313 | [ 314 | [ 315 | [ 316 | -6, 317 | -5 318 | ], 319 | 9 320 | ], 321 | [ 322 | [ 323 | -6, 324 | 1 325 | ], 326 | 13 327 | ], 328 | [ 329 | [ 330 | 11, 331 | -1 332 | ], 333 | 10 334 | ], 335 | [ 336 | [ 337 | 12, 338 | 4 339 | ], 340 | 12 341 | ], 342 | [ 343 | [ 344 | 14, 345 | -3 346 | ], 347 | 8 348 | ] 349 | ], 350 | [] 351 | ], 352 | "seed": 8531488 353 | } -------------------------------------------------------------------------------- /packages/monoidmap-aeson/golden/MonoidMap Int (Dual Text).json: -------------------------------------------------------------------------------- 1 | { 2 | "samples": [ 3 | { 4 | "-1": "aaaaaaaaaaaaababa", 5 | "-13": "aaaaadacbcc", 6 | "-3": "aabaab", 7 | "-4": "abaaaaaadb", 8 | "-7": "aaadaba", 9 | "-8": "babbaabaaba", 10 | "1": "aaadaaaa", 11 | "11": "acaabacaabab", 12 | "3": "daca", 13 | "4": "cb", 14 | "5": "abcadabaabaaaaabcaa", 15 | "6": "abaaaaabaaaa" 16 | }, 17 | { 18 | "-1": "aacaabaa", 19 | "-12": "aaabb", 20 | "-6": "aaaaabaa", 21 | "1": "aababaaaaaaaababaabaa", 22 | "8": "aaababacababaa" 23 | }, 24 | { 25 | "-12": "baaabaabcaaaaaaaaaabc", 26 | "12": "aaaaabbabab", 27 | "5": "cbaababaa" 28 | }, 29 | {}, 30 | { 31 | "-9": "caaa", 32 | "1": "aaaacabaa", 33 | "12": "abcacaaaaa" 34 | }, 35 | { 36 | "-12": "abaaaa", 37 | "-13": "aaacaa", 38 | "-3": "aaaaaaaaba", 39 | "-4": "a", 40 | "-8": "abbcbaaaa", 41 | "9": "bbaaab" 42 | }, 43 | { 44 | "-3": "aaaaaca" 45 | }, 46 | { 47 | "-11": "ba", 48 | "8": "aaa" 49 | }, 50 | { 51 | "11": "aaaaa", 52 | "13": "aaaaada", 53 | "7": "accbaabac" 54 | }, 55 | { 56 | "-1": "aaaaacaababaabaaac", 57 | "-4": "acaa", 58 | "-7": "aaaabb", 59 | "1": "bacbaaa", 60 | "13": "badaaca", 61 | "3": "acaaaaabaaaaaaaaaaa" 62 | } 63 | ], 64 | "seed": 1485712058 65 | } -------------------------------------------------------------------------------- /packages/monoidmap-aeson/golden/MonoidMap Int (MonoidMap (Key 2) (Sum Int)).json: -------------------------------------------------------------------------------- 1 | { 2 | "samples": [ 3 | {}, 4 | { 5 | "-13": { 6 | "A": -12, 7 | "B": 19, 8 | "C": -23, 9 | "D": -10 10 | }, 11 | "-4": { 12 | "C": -8 13 | } 14 | }, 15 | { 16 | "-14": { 17 | "B": 3, 18 | "C": -7, 19 | "D": -18 20 | }, 21 | "0": { 22 | "A": -10, 23 | "C": -8, 24 | "D": -7 25 | }, 26 | "2": { 27 | "B": -22, 28 | "C": -7, 29 | "D": 8 30 | }, 31 | "3": { 32 | "A": 6, 33 | "B": 5, 34 | "C": -16 35 | } 36 | }, 37 | { 38 | "-5": { 39 | "A": 31, 40 | "B": 5, 41 | "C": -1, 42 | "D": 2 43 | }, 44 | "1": { 45 | "C": -5, 46 | "D": 12 47 | }, 48 | "11": { 49 | "A": -5, 50 | "B": -29, 51 | "C": -8, 52 | "D": 1 53 | }, 54 | "2": { 55 | "A": 31, 56 | "B": 39, 57 | "C": -21, 58 | "D": -40 59 | }, 60 | "3": { 61 | "A": -14, 62 | "B": 12, 63 | "C": 5, 64 | "D": -5 65 | }, 66 | "8": { 67 | "A": -4, 68 | "B": 12, 69 | "C": -5, 70 | "D": 7 71 | }, 72 | "9": { 73 | "A": -24, 74 | "B": -5, 75 | "D": 6 76 | } 77 | }, 78 | { 79 | "-2": { 80 | "A": 5, 81 | "B": -12 82 | }, 83 | "-6": { 84 | "A": -12, 85 | "B": 2, 86 | "C": -4 87 | }, 88 | "2": { 89 | "A": 2 90 | } 91 | }, 92 | { 93 | "-12": { 94 | "A": 6, 95 | "C": 12, 96 | "D": 17 97 | }, 98 | "-13": { 99 | "A": -4, 100 | "B": -1, 101 | "D": -19 102 | }, 103 | "-7": { 104 | "A": -4, 105 | "B": -3, 106 | "C": 17, 107 | "D": 17 108 | }, 109 | "12": { 110 | "A": -4, 111 | "B": 9, 112 | "C": -14 113 | }, 114 | "13": { 115 | "A": 26, 116 | "B": 2, 117 | "C": -6, 118 | "D": -7 119 | }, 120 | "14": { 121 | "A": 5, 122 | "B": 8, 123 | "C": -10, 124 | "D": -1 125 | }, 126 | "2": { 127 | "B": 8, 128 | "C": -9, 129 | "D": -5 130 | } 131 | }, 132 | { 133 | "-10": { 134 | "A": 6 135 | }, 136 | "-12": { 137 | "C": 10 138 | }, 139 | "-14": { 140 | "A": -21, 141 | "B": 37, 142 | "C": 21, 143 | "D": 10 144 | }, 145 | "10": { 146 | "B": 10, 147 | "C": -1 148 | }, 149 | "6": { 150 | "A": -30, 151 | "B": -7, 152 | "C": -7, 153 | "D": 15 154 | } 155 | }, 156 | { 157 | "-5": { 158 | "A": 11, 159 | "C": 20, 160 | "D": -9 161 | }, 162 | "-8": { 163 | "A": 19, 164 | "B": -7 165 | }, 166 | "0": { 167 | "A": 8, 168 | "B": 11, 169 | "D": -3 170 | }, 171 | "10": { 172 | "A": 5, 173 | "B": -24, 174 | "D": -3 175 | }, 176 | "11": { 177 | "C": 6, 178 | "D": -10 179 | }, 180 | "7": { 181 | "C": -8 182 | } 183 | }, 184 | { 185 | "-3": { 186 | "A": 12, 187 | "C": 2, 188 | "D": 3 189 | }, 190 | "-9": { 191 | "B": -10, 192 | "C": -5, 193 | "D": 6 194 | }, 195 | "12": { 196 | "A": -22, 197 | "B": 6, 198 | "C": -9, 199 | "D": 4 200 | }, 201 | "2": { 202 | "A": 7 203 | } 204 | }, 205 | { 206 | "-12": { 207 | "A": 9, 208 | "C": -9, 209 | "D": 19 210 | }, 211 | "-9": { 212 | "A": 2, 213 | "B": 2, 214 | "C": 1, 215 | "D": 2 216 | }, 217 | "13": { 218 | "A": -22, 219 | "C": -24, 220 | "D": 20 221 | }, 222 | "5": { 223 | "A": 31, 224 | "B": -4, 225 | "D": -1 226 | } 227 | } 228 | ], 229 | "seed": -1302115327 230 | } -------------------------------------------------------------------------------- /packages/monoidmap-aeson/golden/MonoidMap Int (MonoidMap (Key 2) (Sum Natural)).json: -------------------------------------------------------------------------------- 1 | { 2 | "samples": [ 3 | { 4 | "-10": { 5 | "A": 1, 6 | "B": 4, 7 | "C": 8, 8 | "D": 30 9 | }, 10 | "-2": { 11 | "A": 26, 12 | "B": 27, 13 | "C": 13, 14 | "D": 1 15 | }, 16 | "-7": { 17 | "B": 9, 18 | "C": 3 19 | } 20 | }, 21 | { 22 | "-1": { 23 | "A": 29, 24 | "B": 7 25 | }, 26 | "-6": { 27 | "A": 34, 28 | "B": 5, 29 | "D": 9 30 | }, 31 | "-8": { 32 | "B": 12, 33 | "C": 18, 34 | "D": 12 35 | }, 36 | "0": { 37 | "A": 17, 38 | "B": 14, 39 | "C": 17, 40 | "D": 33 41 | }, 42 | "3": { 43 | "A": 31, 44 | "B": 12, 45 | "C": 5 46 | } 47 | }, 48 | { 49 | "4": { 50 | "A": 5, 51 | "B": 5, 52 | "C": 13, 53 | "D": 35 54 | }, 55 | "5": { 56 | "A": 1, 57 | "B": 13, 58 | "C": 17, 59 | "D": 12 60 | }, 61 | "6": { 62 | "A": 48, 63 | "B": 19, 64 | "C": 42, 65 | "D": 20 66 | }, 67 | "8": { 68 | "A": 6, 69 | "B": 57, 70 | "C": 14, 71 | "D": 19 72 | } 73 | }, 74 | { 75 | "-12": { 76 | "A": 13, 77 | "B": 3, 78 | "C": 28, 79 | "D": 39 80 | } 81 | }, 82 | { 83 | "-13": { 84 | "A": 6, 85 | "B": 12, 86 | "C": 29, 87 | "D": 26 88 | }, 89 | "-6": { 90 | "A": 11, 91 | "C": 3 92 | }, 93 | "13": { 94 | "A": 3 95 | }, 96 | "14": { 97 | "A": 5, 98 | "B": 4 99 | } 100 | }, 101 | { 102 | "-2": { 103 | "A": 41, 104 | "B": 22, 105 | "C": 33, 106 | "D": 39 107 | }, 108 | "-3": { 109 | "A": 17, 110 | "B": 3, 111 | "C": 9, 112 | "D": 30 113 | }, 114 | "-4": { 115 | "A": 17, 116 | "B": 21, 117 | "C": 31, 118 | "D": 8 119 | } 120 | }, 121 | { 122 | "-11": { 123 | "A": 10, 124 | "B": 2, 125 | "C": 2, 126 | "D": 28 127 | }, 128 | "-3": { 129 | "A": 43, 130 | "B": 21, 131 | "C": 27, 132 | "D": 26 133 | }, 134 | "-4": { 135 | "A": 22, 136 | "B": 15, 137 | "C": 6 138 | }, 139 | "-9": { 140 | "B": 12 141 | }, 142 | "0": { 143 | "C": 13 144 | }, 145 | "11": { 146 | "A": 14, 147 | "B": 5, 148 | "C": 23, 149 | "D": 29 150 | }, 151 | "3": { 152 | "A": 43 153 | }, 154 | "4": { 155 | "A": 17, 156 | "C": 21, 157 | "D": 8 158 | } 159 | }, 160 | { 161 | "-11": { 162 | "A": 38, 163 | "B": 13, 164 | "C": 10, 165 | "D": 49 166 | }, 167 | "-13": { 168 | "A": 3, 169 | "C": 19, 170 | "D": 17 171 | }, 172 | "-4": { 173 | "C": 14 174 | }, 175 | "-7": { 176 | "A": 22, 177 | "B": 22, 178 | "C": 20, 179 | "D": 19 180 | }, 181 | "10": { 182 | "A": 9, 183 | "C": 45, 184 | "D": 28 185 | }, 186 | "2": { 187 | "A": 7, 188 | "B": 48, 189 | "C": 29, 190 | "D": 14 191 | }, 192 | "3": { 193 | "A": 26, 194 | "B": 19, 195 | "C": 38, 196 | "D": 42 197 | }, 198 | "9": { 199 | "A": 28, 200 | "B": 13, 201 | "C": 10, 202 | "D": 8 203 | } 204 | }, 205 | { 206 | "-10": { 207 | "A": 8, 208 | "C": 4, 209 | "D": 7 210 | }, 211 | "10": { 212 | "A": 4, 213 | "C": 10, 214 | "D": 16 215 | }, 216 | "14": { 217 | "A": 10, 218 | "B": 11, 219 | "C": 14, 220 | "D": 19 221 | } 222 | }, 223 | { 224 | "-4": { 225 | "A": 20, 226 | "B": 19, 227 | "C": 40, 228 | "D": 14 229 | }, 230 | "6": { 231 | "A": 11, 232 | "B": 13 233 | }, 234 | "8": { 235 | "A": 24, 236 | "B": 8, 237 | "C": 20 238 | } 239 | } 240 | ], 241 | "seed": 51041275 242 | } -------------------------------------------------------------------------------- /packages/monoidmap-aeson/golden/MonoidMap Int (Product Int).json: -------------------------------------------------------------------------------- 1 | { 2 | "samples": [ 3 | { 4 | "-13": 2, 5 | "-14": 12, 6 | "-6": 6, 7 | "10": 55, 8 | "11": -12, 9 | "12": 8, 10 | "14": -112, 11 | "9": -4 12 | }, 13 | { 14 | "-11": 10 15 | }, 16 | { 17 | "-1": -9, 18 | "-11": 4, 19 | "-13": -9, 20 | "0": 4, 21 | "10": -130, 22 | "11": 11, 23 | "14": 9, 24 | "2": -3, 25 | "6": -7 26 | }, 27 | { 28 | "-1": 5, 29 | "-3": -8, 30 | "-4": 3, 31 | "-5": 9, 32 | "-7": -11, 33 | "-8": 14, 34 | "6": 0, 35 | "7": 7, 36 | "8": -10, 37 | "9": 8 38 | }, 39 | { 40 | "-1": -13, 41 | "-9": -14, 42 | "0": -143, 43 | "12": 11, 44 | "5": 9 45 | }, 46 | { 47 | "-2": -100, 48 | "-6": 14, 49 | "9": -2 50 | }, 51 | { 52 | "-10": -9, 53 | "-4": -10, 54 | "-5": 3, 55 | "-6": 60, 56 | "-9": -10, 57 | "0": -1, 58 | "10": 6, 59 | "11": -4, 60 | "4": -1 61 | }, 62 | { 63 | "-13": -8, 64 | "-2": 9, 65 | "14": -11 66 | }, 67 | { 68 | "-1": -10, 69 | "-10": 9, 70 | "0": 9, 71 | "11": 156, 72 | "2": -5, 73 | "6": -13, 74 | "8": 4, 75 | "9": 5 76 | }, 77 | { 78 | "-10": 0, 79 | "-13": -6, 80 | "-3": -12, 81 | "-9": 9, 82 | "1": -14, 83 | "12": -11, 84 | "13": -18, 85 | "3": -4, 86 | "7": -30 87 | } 88 | ], 89 | "seed": -1160880579 90 | } -------------------------------------------------------------------------------- /packages/monoidmap-aeson/golden/MonoidMap Int (Product Natural).json: -------------------------------------------------------------------------------- 1 | { 2 | "samples": [ 3 | { 4 | "-13": 70, 5 | "-6": 13, 6 | "-7": 13, 7 | "-8": 0, 8 | "0": 10, 9 | "10": 13, 10 | "14": 11, 11 | "6": 0 12 | }, 13 | { 14 | "-11": 4, 15 | "3": 5 16 | }, 17 | { 18 | "-13": 5, 19 | "1": 7, 20 | "5": 12 21 | }, 22 | { 23 | "-2": 4, 24 | "0": 3, 25 | "2": 12, 26 | "9": 3 27 | }, 28 | { 29 | "-4": 2 30 | }, 31 | { 32 | "-12": 8, 33 | "14": 12, 34 | "4": 10, 35 | "6": 3 36 | }, 37 | { 38 | "-12": 5, 39 | "-13": 7, 40 | "-14": 0, 41 | "-4": 5, 42 | "-5": 88, 43 | "6": 9 44 | }, 45 | {}, 46 | { 47 | "-11": 3, 48 | "-12": 0, 49 | "-13": 5, 50 | "-9": 3 51 | }, 52 | { 53 | "-12": 11, 54 | "-2": 6, 55 | "-5": 13, 56 | "-8": 4, 57 | "13": 56, 58 | "14": 7, 59 | "4": 0, 60 | "5": 5, 61 | "9": 8 62 | } 63 | ], 64 | "seed": -1543741490 65 | } -------------------------------------------------------------------------------- /packages/monoidmap-aeson/golden/MonoidMap Int (Set Natural).json: -------------------------------------------------------------------------------- 1 | { 2 | "samples": [ 3 | { 4 | "-11": [ 5 | 2, 6 | 7, 7 | 8, 8 | 10, 9 | 12, 10 | 14 11 | ], 12 | "-14": [ 13 | 1, 14 | 2, 15 | 4, 16 | 5, 17 | 6, 18 | 9, 19 | 10, 20 | 11, 21 | 12, 22 | 13, 23 | 14 24 | ], 25 | "-2": [ 26 | 7, 27 | 10, 28 | 11 29 | ], 30 | "-3": [ 31 | 0, 32 | 2, 33 | 3, 34 | 6, 35 | 9, 36 | 12, 37 | 13 38 | ], 39 | "-6": [ 40 | 0, 41 | 1, 42 | 3, 43 | 8, 44 | 9 45 | ], 46 | "11": [ 47 | 2, 48 | 6, 49 | 7, 50 | 9, 51 | 10, 52 | 12, 53 | 13 54 | ], 55 | "8": [ 56 | 0, 57 | 5, 58 | 7, 59 | 9, 60 | 11 61 | ] 62 | }, 63 | { 64 | "-10": [ 65 | 3, 66 | 9, 67 | 11 68 | ], 69 | "-11": [ 70 | 12 71 | ], 72 | "6": [ 73 | 2 74 | ] 75 | }, 76 | { 77 | "-12": [ 78 | 3, 79 | 4, 80 | 10, 81 | 13 82 | ], 83 | "-8": [ 84 | 0, 85 | 1, 86 | 4, 87 | 6, 88 | 9, 89 | 10, 90 | 11, 91 | 12, 92 | 13 93 | ], 94 | "11": [ 95 | 4 96 | ] 97 | }, 98 | { 99 | "11": [ 100 | 4, 101 | 7, 102 | 12 103 | ] 104 | }, 105 | { 106 | "-13": [ 107 | 1, 108 | 8, 109 | 12, 110 | 14 111 | ], 112 | "-3": [ 113 | 4, 114 | 5, 115 | 6, 116 | 7, 117 | 9, 118 | 10, 119 | 12, 120 | 13 121 | ], 122 | "-9": [ 123 | 0, 124 | 1, 125 | 3, 126 | 5, 127 | 6, 128 | 7, 129 | 10, 130 | 11, 131 | 12, 132 | 13, 133 | 14 134 | ], 135 | "1": [ 136 | 1, 137 | 2, 138 | 12 139 | ], 140 | "10": [ 141 | 0, 142 | 1, 143 | 9, 144 | 11, 145 | 12, 146 | 13, 147 | 14 148 | ], 149 | "11": [ 150 | 0, 151 | 1, 152 | 4, 153 | 5, 154 | 7, 155 | 9, 156 | 12, 157 | 13, 158 | 14 159 | ] 160 | }, 161 | { 162 | "-1": [ 163 | 1, 164 | 3, 165 | 4, 166 | 7, 167 | 8, 168 | 9, 169 | 10, 170 | 11, 171 | 12 172 | ], 173 | "-12": [ 174 | 0, 175 | 4, 176 | 9, 177 | 10, 178 | 11, 179 | 13 180 | ], 181 | "-14": [ 182 | 1, 183 | 7, 184 | 10 185 | ], 186 | "-4": [ 187 | 0, 188 | 14 189 | ], 190 | "2": [ 191 | 2, 192 | 3, 193 | 7, 194 | 10, 195 | 11, 196 | 14 197 | ], 198 | "6": [ 199 | 0, 200 | 1, 201 | 6, 202 | 7, 203 | 9, 204 | 10, 205 | 11, 206 | 13 207 | ] 208 | }, 209 | { 210 | "-14": [ 211 | 0, 212 | 1, 213 | 2, 214 | 3, 215 | 4, 216 | 5, 217 | 6, 218 | 8, 219 | 9, 220 | 12, 221 | 13 222 | ], 223 | "-3": [ 224 | 2, 225 | 6, 226 | 7, 227 | 10, 228 | 12 229 | ], 230 | "-4": [ 231 | 0, 232 | 1, 233 | 4, 234 | 5, 235 | 14 236 | ], 237 | "-9": [ 238 | 0, 239 | 2, 240 | 3, 241 | 5, 242 | 6, 243 | 7, 244 | 9, 245 | 10, 246 | 12, 247 | 13, 248 | 14 249 | ], 250 | "0": [ 251 | 3, 252 | 5, 253 | 6, 254 | 7, 255 | 9 256 | ], 257 | "1": [ 258 | 0, 259 | 5, 260 | 9, 261 | 11, 262 | 13 263 | ], 264 | "10": [ 265 | 1, 266 | 6, 267 | 10, 268 | 11, 269 | 14 270 | ], 271 | "14": [ 272 | 0, 273 | 1, 274 | 3, 275 | 4, 276 | 8, 277 | 9, 278 | 10, 279 | 11, 280 | 13, 281 | 14 282 | ] 283 | }, 284 | { 285 | "-2": [ 286 | 0, 287 | 1, 288 | 3, 289 | 4, 290 | 9, 291 | 10, 292 | 12 293 | ], 294 | "11": [ 295 | 6, 296 | 13, 297 | 14 298 | ], 299 | "4": [ 300 | 1, 301 | 5 302 | ], 303 | "7": [ 304 | 0, 305 | 1, 306 | 4, 307 | 6, 308 | 9, 309 | 12 310 | ] 311 | }, 312 | {}, 313 | { 314 | "-12": [ 315 | 0, 316 | 4, 317 | 11, 318 | 13 319 | ] 320 | } 321 | ], 322 | "seed": 83482652 323 | } -------------------------------------------------------------------------------- /packages/monoidmap-aeson/golden/MonoidMap Int (Sum Int).json: -------------------------------------------------------------------------------- 1 | { 2 | "samples": [ 3 | { 4 | "-1": -7, 5 | "-14": 18, 6 | "-5": -13, 7 | "10": 13 8 | }, 9 | { 10 | "-11": 10, 11 | "-12": 4, 12 | "-13": -7, 13 | "-3": -5, 14 | "-9": -13, 15 | "12": 5, 16 | "8": 2 17 | }, 18 | { 19 | "-1": 9, 20 | "-12": 3, 21 | "-4": -9, 22 | "0": 13, 23 | "10": -6, 24 | "3": -10, 25 | "5": 1, 26 | "8": -3 27 | }, 28 | { 29 | "-12": -9, 30 | "-13": 11, 31 | "-14": 14, 32 | "-3": 4, 33 | "5": -2 34 | }, 35 | { 36 | "-12": -14, 37 | "12": 3, 38 | "8": -7 39 | }, 40 | { 41 | "-13": -6, 42 | "-14": -6, 43 | "-3": 5, 44 | "13": -32, 45 | "14": -11, 46 | "5": -5, 47 | "7": -11 48 | }, 49 | { 50 | "-14": -12, 51 | "-3": 12, 52 | "-9": 11, 53 | "5": -1 54 | }, 55 | { 56 | "-11": -5, 57 | "-4": 2, 58 | "14": 9, 59 | "4": -7, 60 | "5": -3, 61 | "6": -6 62 | }, 63 | { 64 | "-12": -3, 65 | "-9": 3 66 | }, 67 | { 68 | "-10": 7, 69 | "-12": 11, 70 | "-2": 3, 71 | "-7": 10, 72 | "1": 7, 73 | "11": -14, 74 | "2": 4, 75 | "3": -3, 76 | "8": -11, 77 | "9": 12 78 | } 79 | ], 80 | "seed": 1819141666 81 | } -------------------------------------------------------------------------------- /packages/monoidmap-aeson/golden/MonoidMap Int (Sum Natural).json: -------------------------------------------------------------------------------- 1 | { 2 | "samples": [ 3 | { 4 | "-3": 10, 5 | "-6": 1, 6 | "14": 12 7 | }, 8 | { 9 | "-1": 8, 10 | "-2": 10, 11 | "-6": 4, 12 | "-9": 10, 13 | "1": 8, 14 | "10": 1, 15 | "4": 18, 16 | "6": 4, 17 | "7": 1, 18 | "8": 7 19 | }, 20 | { 21 | "-1": 7, 22 | "-10": 12, 23 | "-12": 13, 24 | "-13": 4, 25 | "-4": 15, 26 | "-6": 8, 27 | "-8": 9, 28 | "0": 12, 29 | "11": 11, 30 | "6": 1, 31 | "8": 2 32 | }, 33 | { 34 | "-1": 3, 35 | "-12": 10, 36 | "-6": 7, 37 | "-9": 18, 38 | "0": 8, 39 | "3": 7 40 | }, 41 | { 42 | "-13": 8, 43 | "3": 4, 44 | "6": 1 45 | }, 46 | { 47 | "-10": 9, 48 | "-11": 15, 49 | "-12": 8, 50 | "-14": 10, 51 | "-5": 5, 52 | "-6": 10, 53 | "1": 1, 54 | "2": 5, 55 | "3": 10, 56 | "5": 13, 57 | "8": 7, 58 | "9": 13 59 | }, 60 | { 61 | "-5": 2, 62 | "7": 13, 63 | "8": 5 64 | }, 65 | {}, 66 | { 67 | "-14": 10, 68 | "0": 16, 69 | "10": 10, 70 | "13": 8, 71 | "8": 5, 72 | "9": 12 73 | }, 74 | { 75 | "-1": 9, 76 | "-11": 10, 77 | "-2": 3, 78 | "-5": 12, 79 | "-8": 10, 80 | "0": 10, 81 | "1": 3, 82 | "11": 8, 83 | "2": 12, 84 | "4": 9, 85 | "5": 6, 86 | "7": 18 87 | } 88 | ], 89 | "seed": -1247587153 90 | } -------------------------------------------------------------------------------- /packages/monoidmap-aeson/golden/MonoidMap Int Text.json: -------------------------------------------------------------------------------- 1 | { 2 | "samples": [ 3 | { 4 | "-1": "aa", 5 | "-14": "aaadaaaaaaa", 6 | "-4": "bacaaba", 7 | "12": "acbaaa", 8 | "8": "aaaa" 9 | }, 10 | { 11 | "-10": "aaaaabab", 12 | "-3": "daaacbaaaabcaaaaa", 13 | "-6": "aaa", 14 | "-7": "baaaab", 15 | "-8": "caaaabaabcaaca", 16 | "-9": "bab", 17 | "5": "aa", 18 | "7": "aba", 19 | "9": "abba" 20 | }, 21 | { 22 | "-14": "abaa", 23 | "-2": "abaaaa", 24 | "10": "bababaaba", 25 | "6": "aaabaaaaabcaa" 26 | }, 27 | { 28 | "-11": "aaadaaaa", 29 | "-13": "caaaaaaaba", 30 | "-14": "aaabaaaaaba", 31 | "1": "aabdabababadaa", 32 | "2": "baa", 33 | "8": "aaabaaaaabaaaaaabaca", 34 | "9": "aa" 35 | }, 36 | { 37 | "-10": "aa", 38 | "-5": "aaaaaabaa", 39 | "-9": "aabaaaababaaadaaaaabaaa", 40 | "10": "aa" 41 | }, 42 | { 43 | "-1": "bbcaaaaaaaaaa", 44 | "-10": "aaaaaaaabbaaaaaaabaaa", 45 | "-3": "aabaaabaaaaabaaabcaaa", 46 | "-4": "bba", 47 | "-5": "aba", 48 | "-8": "aaaaaa", 49 | "0": "baaaa", 50 | "2": "baababaaacb", 51 | "6": "aab" 52 | }, 53 | { 54 | "-14": "caaaaaabcbaa", 55 | "11": "baaaaaa", 56 | "8": "aabaaaa", 57 | "9": "aaa" 58 | }, 59 | { 60 | "-3": "abaaaaaaaaaa", 61 | "-4": "aaaaaaaaaaa", 62 | "-6": "caaaaaababaaab", 63 | "-8": "abaaabaaa", 64 | "0": "abaacb", 65 | "1": "aa", 66 | "11": "abb", 67 | "4": "a", 68 | "7": "baaaaaacaaabaaabcad", 69 | "9": "aaaaaaaabacbaabaabaaaaaa" 70 | }, 71 | { 72 | "-7": "babacaaabbaac", 73 | "4": "a" 74 | }, 75 | { 76 | "-13": "aabaa", 77 | "-14": "aba", 78 | "-2": "aaabaaaa", 79 | "-4": "a", 80 | "-5": "ab", 81 | "-9": "aaaaaaaaaa", 82 | "13": "b", 83 | "8": "bcbbaaaaaaaaaa", 84 | "9": "abbaaaaab" 85 | } 86 | ], 87 | "seed": 1346316189 88 | } -------------------------------------------------------------------------------- /packages/monoidmap-aeson/golden/MonoidMap Text (Dual Text).json: -------------------------------------------------------------------------------- 1 | { 2 | "samples": [ 3 | { 4 | "": "a", 5 | "aaaa": "aaaaaaaaababaa", 6 | "aaaaacaa": "aac", 7 | "aabaaabdabaab": "aaaaaaaaaa", 8 | "abaaacabaabaa": "abbaabaa", 9 | "abba": "aacacaaaaaba", 10 | "baaa": "aba", 11 | "bada": "ab", 12 | "bbacaaabba": "baaaaaaaaaaa" 13 | }, 14 | { 15 | "aaaaba": "aa", 16 | "baaa": "aaabaa" 17 | }, 18 | { 19 | "": "adbaabbbaaaa", 20 | "aaa": "abaaaaba", 21 | "aaaaaa": "aabaaaababaaa", 22 | "aaaaaaa": "baaabaaaaaa", 23 | "aaabaaaaaaaaaa": "aaabaaaabaca", 24 | "abaaaaabbaa": "adb", 25 | "acaaaaaabaaa": "abacabab", 26 | "b": "aaaaaaaa", 27 | "baaaa": "baababa", 28 | "bab": "aaaaaacabab", 29 | "bb": "baaabaaaaabaaa", 30 | "caaa": "abdbaaabbaaa" 31 | }, 32 | { 33 | "": "acaaabaaaaabb", 34 | "a": "aaab", 35 | "aa": "aadbabbabb", 36 | "aaaaaaaaaab": "aaaaaaaaa", 37 | "aaaabaad": "abacaabaacbac", 38 | "abaaabaaa": "aaaabacacbaaaa", 39 | "abababaabaaaa": "aacaababbaa" 40 | }, 41 | { 42 | "aaaaaaacba": "baaba", 43 | "aaaaaabc": "cabcaabaaa", 44 | "aaaabbaaababab": "aaaaa", 45 | "abbabadaa": "baacababaaaa" 46 | }, 47 | { 48 | "": "aaaaaa", 49 | "aa": "aaaaaababaaaa", 50 | "aaaaaacaab": "abbaa", 51 | "aaaaabaabaaab": "aabcabaaaaa", 52 | "aaaaacaaaa": "aaa", 53 | "aaabacaabaab": "aaabcaaaa", 54 | "aaabbaaa": "aababaaaa", 55 | "aaabbaaaa": "aacbbaaaaaaab", 56 | "aababbbbba": "aabaaaaaaaccbc", 57 | "abaaa": "abaabaaaaaabaa", 58 | "b": "baaaaaaabaca", 59 | "baaacaaaaaaaaa": "baaacaaabbadaa" 60 | }, 61 | { 62 | "aaaaaaac": "abaabaa", 63 | "aaabaa": "abaaaa", 64 | "aaabaaabaaa": "aaaaaaaa", 65 | "aadbbbabaaa": "aabab", 66 | "abaaaabaa": "bbbaaaaaaa", 67 | "abaaaabbab": "aa", 68 | "b": "aab", 69 | "daaaaaaa": "aabaaaaa" 70 | }, 71 | { 72 | "aa": "acbaaaaa", 73 | "aaabaaabaaaabb": "aaaaaa", 74 | "aabaaabaaaa": "baaaa", 75 | "ba": "aacaaaaaba", 76 | "bbaaaaabbaa": "abcabaacb" 77 | }, 78 | { 79 | "abadaaaaaaa": "aabaaccaa", 80 | "baaba": "aaaacbb" 81 | }, 82 | { 83 | "aaaaaa": "aaaaabcabaca", 84 | "aaaac": "baaaac", 85 | "aabaaabccaca": "abaaaaaaaaa", 86 | "aabaacbb": "aaab", 87 | "aabbbaaaabaa": "aaaaaaa", 88 | "abcaaaaa": "aacaaaca", 89 | "baa": "aabaaaaabaaaab", 90 | "bab": "aaaaaa", 91 | "bababaaaaab": "acaaabbcb", 92 | "daaaaabb": "abaaaaaaaaaa" 93 | } 94 | ], 95 | "seed": -637739861 96 | } -------------------------------------------------------------------------------- /packages/monoidmap-aeson/golden/MonoidMap Text (Product Int).json: -------------------------------------------------------------------------------- 1 | { 2 | "samples": [ 3 | { 4 | "": -10, 5 | "aaaa": -3 6 | }, 7 | {}, 8 | {}, 9 | { 10 | "a": 2, 11 | "aaaa": 8, 12 | "aaaaaaaaaa": 3, 13 | "aaaaaaaaba": 11, 14 | "aaaaaababaaaab": -8, 15 | "aaaaaba": -13, 16 | "aaaabaaaacbaa": -11, 17 | "aaabaaaaaaaaba": 9, 18 | "aaabbaa": 8, 19 | "aabaaaaa": 6, 20 | "abaaaaa": 7, 21 | "abaaaaab": 14, 22 | "abbabaaaaaa": 10, 23 | "acaaaaba": 14 24 | }, 25 | { 26 | "aaa": 11, 27 | "baaaaaaa": -3, 28 | "babcaca": -1, 29 | "bacbaaaabaaaca": -4 30 | }, 31 | { 32 | "a": -4, 33 | "aa": 0, 34 | "aaaaaa": -7, 35 | "aadaaa": -11, 36 | "abababaaa": -1, 37 | "abcdaaa": -1, 38 | "baaa": -6, 39 | "baacaaaacba": 6, 40 | "babaaaacaa": 13 41 | }, 42 | { 43 | "a": -7, 44 | "aaaaa": -4, 45 | "aabaaaaaaaaba": -13, 46 | "abaaaaaaaaabba": -7, 47 | "acbaaacdaa": -6, 48 | "baaab": 2 49 | }, 50 | { 51 | "": -1, 52 | "aaa": 13, 53 | "aabaaaaaabaa": -5, 54 | "aabbaacaaaaa": -5, 55 | "abaaababaa": 14, 56 | "baaaaa": 11 57 | }, 58 | { 59 | "a": -8, 60 | "aac": 9, 61 | "ababacba": 7, 62 | "ba": 3, 63 | "baadaaaa": 13, 64 | "bbaaadacabab": -14, 65 | "bcbba": 9 66 | }, 67 | { 68 | "aaaaaaa": 8, 69 | "aaaaaabaaaaaa": 12, 70 | "aaaaababaaa": 5, 71 | "cababb": -3 72 | } 73 | ], 74 | "seed": -1213399887 75 | } -------------------------------------------------------------------------------- /packages/monoidmap-aeson/golden/MonoidMap Text (Product Natural).json: -------------------------------------------------------------------------------- 1 | { 2 | "samples": [ 3 | { 4 | "aaa": 7, 5 | "aaaabacaaa": 5, 6 | "aaab": 9, 7 | "abaaacbaaaa": 11, 8 | "abaabaa": 12, 9 | "abbaaaaaa": 14, 10 | "acabaaaaaaaba": 6, 11 | "b": 11, 12 | "ba": 10, 13 | "baaaaaaaabaaaa": 11, 14 | "baaabbacba": 4 15 | }, 16 | { 17 | "": 9, 18 | "a": 11, 19 | "aaaaaaa": 2, 20 | "aaaaaaaaaaa": 9, 21 | "aaabacaaaaacaa": 2, 22 | "aaabbbbbaaca": 0, 23 | "aabaaaaa": 4, 24 | "aabab": 5, 25 | "aaccaaaaa": 13, 26 | "abbbbaaa": 12, 27 | "baaabbaaaaa": 7, 28 | "daa": 4 29 | }, 30 | { 31 | "": 7, 32 | "a": 0, 33 | "aa": 11, 34 | "aaaabcaaaaab": 2, 35 | "aaaba": 14, 36 | "aaababa": 12, 37 | "acbbaaaabaaaaa": 3, 38 | "baaaaaaaa": 2, 39 | "dabcaabbdbcabb": 9 40 | }, 41 | { 42 | "aaaaa": 12, 43 | "aaaaaaaba": 8, 44 | "aaaaaba": 0, 45 | "aaacbaaaaabaa": 7, 46 | "ababaaaaaaab": 7, 47 | "acaadbaa": 12, 48 | "baababaaaa": 4 49 | }, 50 | { 51 | "aa": 4, 52 | "aaaaaaabaaaa": 8, 53 | "aaaaacabda": 5, 54 | "aaaababbaa": 14, 55 | "aaacacabaaaaa": 3, 56 | "aabaabaaaaaa": 6, 57 | "aabababa": 10, 58 | "abcaaaababbaa": 10, 59 | "baaababaaacaaa": 6 60 | }, 61 | { 62 | "aaaaaaaaa": 11, 63 | "aaaaaaaaaaaaba": 4, 64 | "aaaacdac": 2, 65 | "aaca": 9, 66 | "acdaabaacaaba": 12 67 | }, 68 | { 69 | "aaabaaaa": 5, 70 | "aaabaaaaaa": 12 71 | }, 72 | { 73 | "": 0, 74 | "aaaaaabaa": 2 75 | }, 76 | { 77 | "": 10, 78 | "aabcaaaaba": 12, 79 | "aadaaaaaab": 4 80 | }, 81 | { 82 | "": 4, 83 | "aaa": 3, 84 | "aaabbab": 4, 85 | "aacababacaac": 10, 86 | "aadbaaaa": 2, 87 | "abaa": 2, 88 | "abababb": 4, 89 | "abbbaaaaaaa": 9, 90 | "acc": 13 91 | } 92 | ], 93 | "seed": 2007859132 94 | } -------------------------------------------------------------------------------- /packages/monoidmap-aeson/golden/MonoidMap Text (Sum Int).json: -------------------------------------------------------------------------------- 1 | { 2 | "samples": [ 3 | { 4 | "": -2, 5 | "aaa": -2, 6 | "aaaaa": 11, 7 | "aaaabaaaaaaa": 11, 8 | "aaacaabaaaaaa": 12, 9 | "aabaaaaacaaaaa": -11, 10 | "aabaaaab": -10, 11 | "aabaabaaab": -7, 12 | "ac": 11, 13 | "b": 7, 14 | "babaacaabaab": -6, 15 | "caabaabac": -14 16 | }, 17 | { 18 | "a": -16, 19 | "aa": 13, 20 | "aaaaaaaaaaaa": 9, 21 | "aaaaaaacaab": 7, 22 | "aaaaaab": -11, 23 | "aaabaaaa": -1, 24 | "aaacaa": -14, 25 | "aabaabbaaa": 10, 26 | "abbaaacaaaaa": -4, 27 | "caaaabaacabada": -3 28 | }, 29 | { 30 | "": -9, 31 | "aaaaaaaaaaaaac": -6, 32 | "aaaaaaaaabaab": 12, 33 | "aaaaabbaaaa": 10, 34 | "aaaabaababab": -10, 35 | "aaaababaaa": 4, 36 | "aabaa": -7, 37 | "abaaa": 14, 38 | "abaabaaaaaaac": -3 39 | }, 40 | { 41 | "aa": -9, 42 | "aaaaaabaa": -14, 43 | "aaaaaacaaaaab": 4, 44 | "aaabaaaababab": 1, 45 | "ababaabaaa": -8, 46 | "baab": 3 47 | }, 48 | { 49 | "aaaaaabaaaaaa": 3, 50 | "aaaaacaa": 11, 51 | "aabbaaaaaaaa": -5, 52 | "ababaaaadbaaa": 7, 53 | "bacaaaaaacaaaa": 4 54 | }, 55 | { 56 | "": -14, 57 | "aaa": 9, 58 | "aaaa": -8, 59 | "aaaaaaaaa": -8, 60 | "aaaaaaaaaaaaca": -4, 61 | "aaaaaaabbaaaaa": 12, 62 | "aaaaaab": -7, 63 | "aaabaaa": -6, 64 | "aaababa": 12, 65 | "abaaaaaacbaa": -1, 66 | "baaaa": 1, 67 | "baaac": -2, 68 | "bbaaa": -2 69 | }, 70 | { 71 | "aaaaaaaaaaba": 6 72 | }, 73 | { 74 | "aa": -12, 75 | "aaaaaabaaaa": 8, 76 | "aaaabaa": -7, 77 | "aadaaaaaaa": 9, 78 | "abaac": -14, 79 | "ba": 4, 80 | "baaa": -5, 81 | "baaaadcacaaaa": 9, 82 | "babadbbaabaaaa": 10 83 | }, 84 | { 85 | "aa": 1, 86 | "abaaabbb": 14 87 | }, 88 | { 89 | "": -4, 90 | "aaa": 2, 91 | "aaaaaaaaaabca": -9, 92 | "aab": 12, 93 | "baaa": 7, 94 | "bbaabcbaa": -10 95 | } 96 | ], 97 | "seed": -646378343 98 | } -------------------------------------------------------------------------------- /packages/monoidmap-aeson/golden/MonoidMap Text (Sum Natural).json: -------------------------------------------------------------------------------- 1 | { 2 | "samples": [ 3 | { 4 | "aaba": 7, 5 | "babaacabba": 3, 6 | "caaaaabbbb": 12 7 | }, 8 | { 9 | "": 6, 10 | "a": 2, 11 | "aaaa": 9, 12 | "aaaaaa": 11, 13 | "aaaabbaaabaa": 6, 14 | "aab": 5, 15 | "abbbaaaa": 3, 16 | "aca": 5, 17 | "baaabaaa": 8, 18 | "babbaa": 1, 19 | "bbabcaaa": 5 20 | }, 21 | { 22 | "": 12, 23 | "aa": 10, 24 | "aaaaaaaa": 1, 25 | "aabba": 11, 26 | "abaacaaaabab": 13, 27 | "ababaaaabbaaa": 14, 28 | "b": 13, 29 | "ba": 9, 30 | "babab": 5, 31 | "babbaaaaab": 1 32 | }, 33 | {}, 34 | { 35 | "a": 3, 36 | "aaaaaaaaa": 7, 37 | "aaacaaabaaa": 9, 38 | "abaaaaaaa": 2, 39 | "abab": 4, 40 | "ababaaaaaaaaab": 10, 41 | "abb": 11, 42 | "abcabcaaa": 2, 43 | "bbaaababbabaaa": 8 44 | }, 45 | { 46 | "": 6, 47 | "a": 8, 48 | "aaaaa": 8, 49 | "aaacaca": 11, 50 | "aaacacacaa": 9, 51 | "acacaaabaaaa": 10, 52 | "baabaaabaa": 7 53 | }, 54 | { 55 | "aaa": 6, 56 | "aaaaabaab": 4, 57 | "aaaabaa": 10, 58 | "aaaba": 6, 59 | "aabaaaabbbaab": 10, 60 | "abaaaaaaaaa": 6, 61 | "ada": 7, 62 | "b": 4 63 | }, 64 | { 65 | "aaaabaaaadaab": 1, 66 | "aaaababbba": 10, 67 | "aaabcaaaa": 9, 68 | "baabaaabaabada": 2 69 | }, 70 | {}, 71 | { 72 | "aaabbcaaabba": 4 73 | } 74 | ], 75 | "seed": 411464378 76 | } -------------------------------------------------------------------------------- /packages/monoidmap-aeson/golden/MonoidMap Text Text.json: -------------------------------------------------------------------------------- 1 | { 2 | "samples": [ 3 | { 4 | "a": "bdaabacabaada", 5 | "aaaaa": "abababaaaa", 6 | "aaaaaaaabaca": "bbaabaaaaaaa", 7 | "aaaabaaaabaaab": "a", 8 | "aaba": "aaaaba", 9 | "aabaaa": "aacab", 10 | "abaaaa": "babaaabbbaaa", 11 | "abaaaaaa": "aaaaabaaaabaaa", 12 | "abaaaaca": "aaaaaaaaaaabaa", 13 | "acabaacaa": "aaabcaaaaab", 14 | "baab": "baaaaa" 15 | }, 16 | { 17 | "aaaaaaaacaaaaa": "babbaaaa" 18 | }, 19 | {}, 20 | { 21 | "": "abaaaaaaaaa", 22 | "a": "acbaab", 23 | "aaabaa": "baaaaaaaa", 24 | "aaba": "baabaaaaa", 25 | "abaaaaababaa": "aaaaaa", 26 | "abbaabaaaa": "aaaabb", 27 | "ba": "aab", 28 | "baaaaaa": "abaaaaaa", 29 | "baaaaabba": "aba" 30 | }, 31 | { 32 | "aab": "aac", 33 | "aabbaabaa": "aaaa", 34 | "acacaaaab": "ab" 35 | }, 36 | { 37 | "": "aaacaacbbabaaa", 38 | "aaaaaa": "bb", 39 | "aaabbaa": "a", 40 | "aabbaaaaaabba": "aaabaaab", 41 | "ca": "aaaaaaaaaaaaa" 42 | }, 43 | { 44 | "aa": "aaaaaaaabaaaaaab", 45 | "aaababbaabaaa": "baaaaaabbacab", 46 | "aabacaaaaa": "aabaaaaaaaaaba", 47 | "aadbaaaaaaa": "a", 48 | "abb": "b" 49 | }, 50 | { 51 | "aa": "aaaadaaaaaaaab", 52 | "aaba": "aaaa", 53 | "aacaaaabaaaba": "b", 54 | "aba": "baaabaaaa", 55 | "aca": "aaaaa" 56 | }, 57 | { 58 | "aa": "ba", 59 | "aaa": "baaaa", 60 | "aab": "aaabaaaaaaaab", 61 | "abaaaba": "aaaab", 62 | "acaabaaba": "baa", 63 | "acbaaaa": "a", 64 | "b": "baaabaa", 65 | "baaacb": "aa", 66 | "babaa": "aababaaa", 67 | "bba": "baabcabb", 68 | "bbaaabaab": "aaabba", 69 | "bbaacaabbaabba": "aaaabaaaaa", 70 | "caabbaaaaab": "aa" 71 | }, 72 | { 73 | "": "aaaaaaaaaabbaaabaaaacbaaaaacaaaabb", 74 | "a": "aaaaaaaabaaaaa", 75 | "aaaa": "adaaaca", 76 | "aaaaaaaaaa": "caabaaa", 77 | "aaaab": "ab", 78 | "aaabaaaaaaa": "aaaaaa", 79 | "aaabcabaaa": "aaacaca", 80 | "aaacabaaa": "aaaabaa", 81 | "aacbaaaad": "aaaaaaaaacbbaa", 82 | "abaaa": "baaa", 83 | "baaaabaabaaba": "abaaaaa", 84 | "baaabaaaa": "aaaaaaa" 85 | } 86 | ], 87 | "seed": -2122979164 88 | } -------------------------------------------------------------------------------- /packages/monoidmap-aeson/monoidmap-aeson.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: monoidmap-aeson 3 | version: 0.0.0.5 4 | bug-reports: https://github.com/jonathanknowles/monoidmap-aeson/issues 5 | license: Apache-2.0 6 | license-file: LICENSE 7 | author: Jonathan Knowles 8 | maintainer: mail@jonathanknowles.net 9 | copyright: 2022–2025 Jonathan Knowles 10 | category: Data Structures 11 | synopsis: JSON support for monoidmap. 12 | description: JSON support for the monoidmap package, compatible with aeson. 13 | 14 | extra-doc-files: 15 | CHANGELOG.md 16 | README.md 17 | 18 | extra-source-files: 19 | golden/*.json 20 | 21 | common dependency-aeson 22 | build-depends:aeson >= 2.2.3.0 && < 2.3 23 | common dependency-base 24 | build-depends:base >= 4.14.3.0 && < 4.22 25 | common dependency-containers 26 | build-depends:containers >= 0.6.5.1 && < 0.8 27 | common dependency-hspec 28 | build-depends:hspec >= 2.10.9 && < 2.12 29 | common dependency-hspec-golden-aeson 30 | build-depends:hspec-golden-aeson >= 0.9.0.0 && < 0.10 31 | common dependency-monoid-subclasses 32 | build-depends:monoid-subclasses >= 1.2.3 && < 1.3 33 | common dependency-monoidmap 34 | build-depends:monoidmap >= 0.0.4.4 && < 0.1 35 | common dependency-QuickCheck 36 | build-depends:QuickCheck >= 2.14.2 && < 2.16 37 | common dependency-quickcheck-classes 38 | build-depends:quickcheck-classes >= 0.6.5.0 && < 0.7 39 | common dependency-quickcheck-quid 40 | build-depends:quickcheck-quid >= 0.0.1.7 && < 0.1 41 | common dependency-text 42 | build-depends:text >= 1.2.4.1 && < 2.2 43 | 44 | common extensions 45 | default-extensions: 46 | BangPatterns 47 | ConstraintKinds 48 | DerivingStrategies 49 | DerivingVia 50 | FlexibleContexts 51 | FlexibleInstances 52 | GeneralizedNewtypeDeriving 53 | LambdaCase 54 | MultiParamTypeClasses 55 | NoImplicitPrelude 56 | NumericUnderscores 57 | ScopedTypeVariables 58 | TupleSections 59 | TypeApplications 60 | TypeFamilies 61 | TypeOperators 62 | ViewPatterns 63 | 64 | source-repository head 65 | type: git 66 | location: https://github.com/jonathanknowles/monoidmap-aeson 67 | 68 | library 69 | import: 70 | , dependency-aeson 71 | , dependency-base 72 | , dependency-containers 73 | , dependency-monoid-subclasses 74 | , dependency-monoidmap 75 | , extensions 76 | hs-source-dirs: 77 | components/monoidmap-aeson 78 | exposed-modules: 79 | Data.MonoidMap.JSON 80 | default-language: 81 | Haskell2010 82 | 83 | test-suite monoidmap-aeson-test 84 | import: 85 | , dependency-aeson 86 | , dependency-base 87 | , dependency-containers 88 | , dependency-hspec 89 | , dependency-hspec-golden-aeson 90 | , dependency-monoid-subclasses 91 | , dependency-monoidmap 92 | , dependency-QuickCheck 93 | , dependency-quickcheck-classes 94 | , dependency-quickcheck-quid 95 | , dependency-text 96 | , extensions 97 | build-depends: 98 | , monoidmap-aeson 99 | ghc-options: 100 | -threaded -with-rtsopts=-N 101 | main-is: 102 | Spec.hs 103 | hs-source-dirs: 104 | components/monoidmap-aeson-test 105 | other-modules: 106 | SpecHook 107 | Data.MonoidMap.JSONSpec 108 | Test.Common 109 | Test.QuickCheck.Classes.Hspec 110 | Test.Key 111 | type: 112 | exitcode-stdio-1.0 113 | default-language: 114 | Haskell2010 115 | build-tool-depends: 116 | hspec-discover:hspec-discover ==2.* 117 | -------------------------------------------------------------------------------- /packages/monoidmap-examples/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # 0.0.0.0 2 | 3 | - Initial release. 4 | -------------------------------------------------------------------------------- /packages/monoidmap-examples/README.md: -------------------------------------------------------------------------------- 1 | # `monoidmap-examples` 2 | 3 | Examples for the [`monoidmap`](https://github.com/jonathanknowles/monoidmap) package. 4 | 5 | 6 | -------------------------------------------------------------------------------- /packages/monoidmap-examples/components/monoidmap-examples-test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | -------------------------------------------------------------------------------- /packages/monoidmap-examples/components/monoidmap-examples-test/SpecHook.hs: -------------------------------------------------------------------------------- 1 | module SpecHook where 2 | 3 | import Test.Hspec 4 | 5 | hook :: Spec -> Spec 6 | hook = parallel 7 | -------------------------------------------------------------------------------- /packages/monoidmap-examples/components/monoidmap-examples/Data/MonoidMap/Examples/MultiMap.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-unused-imports #-} 2 | -- | 3 | -- Copyright: © 2022–2025 Jonathan Knowles 4 | -- License: Apache-2.0 5 | -- 6 | -- Provides the 'MultiMap' class, which models a total relation from unique 7 | -- keys to sets of values. 8 | -- 9 | -- = Implementations 10 | -- 11 | -- The following example implementations are provided: 12 | -- 13 | -- +----------------+------------------------+---------+ 14 | -- | Implementation | Types used | Lawful? | 15 | -- +================+=============+==========+=========+ 16 | -- | 'MultiMap1' | 'Map' | 'Set' | 💥 No | 17 | -- +----------------+-------------+----------+---------+ 18 | -- | 'MultiMap2' | 'Map' | 'Set' | ✅ Yes | 19 | -- +----------------+-------------+----------+---------+ 20 | -- | 'MultiMap3' | 'Map' | 'NESet' | ✅ Yes | 21 | -- +----------------+-------------+----------+---------+ 22 | -- | 'MultiMap4' | 'MonoidMap' | 'Set' | ✅ Yes | 23 | -- +----------------+-------------+----------+---------+ 24 | -- 25 | module Data.MonoidMap.Examples.MultiMap 26 | ( MultiMap (..) 27 | ) where 28 | 29 | import Data.Map.Strict 30 | ( Map ) 31 | import Data.MonoidMap 32 | ( MonoidMap ) 33 | import Data.Set 34 | ( Set ) 35 | import Data.MonoidMap.Examples.Set.NonEmpty 36 | ( NESet ) 37 | import Data.MonoidMap.Examples.MultiMap.Class 38 | ( MultiMap (..) ) 39 | import Data.MonoidMap.Examples.MultiMap.Instances.MultiMap1 40 | ( MultiMap1 ) 41 | import Data.MonoidMap.Examples.MultiMap.Instances.MultiMap2 42 | ( MultiMap2 ) 43 | import Data.MonoidMap.Examples.MultiMap.Instances.MultiMap3 44 | ( MultiMap3 ) 45 | import Data.MonoidMap.Examples.MultiMap.Instances.MultiMap4 46 | ( MultiMap4 ) 47 | -------------------------------------------------------------------------------- /packages/monoidmap-examples/components/monoidmap-examples/Data/MonoidMap/Examples/MultiMap/Class.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: © 2022–2025 Jonathan Knowles 3 | -- License: Apache-2.0 4 | -- 5 | -- Provides the 'MultiMap' class, which models a total relation from unique 6 | -- keys to sets of values. 7 | -- 8 | module Data.MonoidMap.Examples.MultiMap.Class where 9 | 10 | import Data.Set 11 | ( Set ) 12 | import Prelude hiding 13 | ( lookup ) 14 | 15 | -- | Models a total relation from unique keys to sets of values. 16 | -- 17 | class (Eq (m k v), Ord k, Ord v) => MultiMap m k v where 18 | 19 | -- | Constructs a multimap from a list of key to value set mappings. 20 | -- 21 | -- Removing empty sets from the input list does not affect the result: 22 | -- 23 | -- > fromList ≡ fromList . filter ((/= Set.empty) . snd) 24 | -- 25 | fromList :: [(k, Set v)] -> m k v 26 | 27 | -- | Converts a multimap to a list of key to value-set mappings. 28 | -- 29 | -- Removing empty sets from the output list does not affect the result: 30 | -- 31 | -- > toList ≡ filter ((/= Set.empty) . snd) . toList 32 | -- 33 | -- The resulting list can be used to reconstruct the original multimap: 34 | -- 35 | -- > fromList . toList ≡ id 36 | -- 37 | toList :: m k v -> [(k, Set v)] 38 | 39 | -- | Constructs an empty multimap. 40 | -- 41 | -- > empty ≡ fromList [] 42 | -- 43 | empty :: m k v 44 | 45 | -- | Returns the set of values associated with a given key. 46 | -- 47 | -- > lookup k (fromList kvs) ≡ foldMap snd (filter ((== k) . fst) kvs) 48 | -- 49 | lookup :: k -> m k v -> Set v 50 | 51 | -- | Indicates whether or not a multimap is empty. 52 | -- 53 | -- > null m ≡ (∀ k. lookup k m == Set.empty) 54 | -- 55 | null :: m k v -> Bool 56 | 57 | -- | Indicates whether or not a multimap is non-empty. 58 | -- 59 | -- > nonNull m ≡ (∃ k. lookup k m /= Set.empty) 60 | -- 61 | nonNull :: m k v -> Bool 62 | 63 | -- | Returns 'True' iff. the given key is associated with a non-empty set. 64 | -- 65 | -- > nonNullKey k m ≡ (lookup k m /= Set.empty) 66 | -- 67 | nonNullKey :: k -> m k v -> Bool 68 | 69 | -- | Returns the set of keys that are associated with non-empty sets. 70 | -- 71 | -- > all (`nonNullKey` m) (nonNullKeys m) 72 | -- 73 | nonNullKeys :: m k v -> Set k 74 | 75 | -- | Indicates how many keys are associated with non-empty sets. 76 | -- 77 | -- > nonNullCount m ≡ Set.size (nonNullKeys m) 78 | -- 79 | nonNullCount :: m k v -> Int 80 | 81 | -- | Indicates whether or not the first map is a sub-map of the second. 82 | -- 83 | -- > m1 `isSubmapOf` m2 ≡ ∀ k. (lookup k m1 `Set.isSubsetOf` lookup k m2) 84 | -- 85 | isSubmapOf :: m k v -> m k v -> Bool 86 | 87 | -- | Updates the set of values associated with a given key. 88 | -- 89 | -- > lookup k1 (update k2 vs m) ≡ 90 | -- > if k1 == k2 91 | -- > then vs 92 | -- > else lookup k1 m 93 | -- 94 | update :: k -> Set v -> m k v -> m k v 95 | 96 | -- | Inserts values into the set of values associated with a given key. 97 | -- 98 | -- > lookup k1 (insert k2 vs m) ≡ 99 | -- > if k1 == k2 100 | -- > then lookup k1 m `Set.union` vs 101 | -- > else lookup k1 m 102 | -- 103 | insert :: k -> Set v -> m k v -> m k v 104 | 105 | -- | Removes values from the set of values associated with a given key. 106 | -- 107 | -- > lookup k1 (remove k2 vs m) ≡ 108 | -- > if k1 == k2 109 | -- > then lookup k1 m `Set.difference` vs 110 | -- > else lookup k1 m 111 | -- 112 | remove :: k -> Set v -> m k v -> m k v 113 | 114 | -- | Computes the union of two multimaps. 115 | -- 116 | -- Instances must satisfy the following properties: 117 | -- 118 | -- __/Idempotence/__ 119 | -- 120 | -- > union m m ≡ m 121 | -- 122 | -- __/Identity/__ 123 | -- 124 | -- > union empty m ≡ m 125 | -- > union m empty ≡ m 126 | -- 127 | -- __/Commutativity/__ 128 | -- 129 | -- > union m1 m2 ≡ union m2 m1 130 | -- 131 | -- __/Associativity/__ 132 | -- 133 | -- > union m1 (union m2 m3) ≡ 134 | -- > union (union m1 m2) m3 135 | -- 136 | -- __/Containment/__ 137 | -- 138 | -- > m1 `isSubmapOf` union m1 m2 139 | -- > m2 `isSubmapOf` union m1 m2 140 | -- 141 | -- __/Distributivity/__ 142 | -- 143 | -- > lookup k (union m1 m2) ≡ Set.union (lookup k m1) 144 | -- > (lookup k m2) 145 | -- 146 | union :: m k v -> m k v -> m k v 147 | 148 | -- | Computes the intersection of two multimaps. 149 | -- 150 | -- Instances must satisfy the following properties: 151 | -- 152 | -- __/Idempotence/__ 153 | -- 154 | -- > intersection m m ≡ m 155 | -- 156 | -- __/Identity/__ 157 | -- 158 | -- > intersection empty m ≡ empty 159 | -- > intersection m empty ≡ empty 160 | -- 161 | -- __/Commutativity/__ 162 | -- 163 | -- > intersection m1 m2 ≡ intersection m2 m1 164 | -- 165 | -- __/Associativity/__ 166 | -- 167 | -- > intersection m1 (intersection m2 m3) ≡ 168 | -- > intersection (intersection m1 m2) m3 169 | -- 170 | -- __/Containment/__ 171 | -- 172 | -- > intersection m1 m2 `isSubmapOf` m1 173 | -- > intersection m1 m2 `isSubmapOf` m2 174 | -- 175 | -- __/Distributivity/__ 176 | -- 177 | -- > lookup k (intersection m1 m2) ≡ Set.intersection (lookup k m1) 178 | -- > (lookup k m2) 179 | -- 180 | intersection :: m k v -> m k v -> m k v 181 | -------------------------------------------------------------------------------- /packages/monoidmap-examples/components/monoidmap-examples/Data/MonoidMap/Examples/MultiMap/Instances/MultiMap1.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: © 2022–2025 Jonathan Knowles 3 | -- License: Apache-2.0 4 | -- 5 | -- An __unlawful__ implementation of 'MultiMap', implemented in terms of 'Map' 6 | -- and 'Set'. 7 | -- 8 | -- This implementation has several subtle bugs. 💥 9 | -- 10 | module Data.MonoidMap.Examples.MultiMap.Instances.MultiMap1 where 11 | 12 | import Prelude 13 | 14 | import Data.Map.Strict 15 | ( Map ) 16 | import Data.Set 17 | ( Set ) 18 | 19 | import qualified Data.Map.Strict as Map 20 | import qualified Data.Set as Set 21 | import qualified Data.MonoidMap.Examples.MultiMap.Class as Class 22 | 23 | newtype MultiMap1 k v = MultiMap (Map k (Set v)) 24 | deriving stock (Eq, Show) 25 | 26 | instance (Ord k, Ord v) => Class.MultiMap MultiMap1 k v where 27 | 28 | fromList = MultiMap . Map.fromList 29 | 30 | toList (MultiMap m) = Map.toList m 31 | 32 | empty = MultiMap Map.empty 33 | 34 | lookup k (MultiMap m) = Map.findWithDefault Set.empty k m 35 | 36 | null (MultiMap m) = Map.null m 37 | 38 | nonNull (MultiMap m) = not (Map.null m) 39 | 40 | nonNullKey k (MultiMap m) = Map.member k m 41 | 42 | nonNullKeys (MultiMap m) = Map.keysSet m 43 | 44 | nonNullCount (MultiMap m) = Map.size m 45 | 46 | isSubmapOf (MultiMap m1) (MultiMap m2) = 47 | Map.isSubmapOfBy Set.isSubsetOf m1 m2 48 | 49 | update k vs (MultiMap m) = MultiMap (Map.insert k vs m) 50 | 51 | insert k vs (MultiMap m) = MultiMap $ 52 | Map.insert k (Map.findWithDefault Set.empty k m `Set.union` vs) m 53 | 54 | remove k vs (MultiMap m) = MultiMap $ 55 | Map.insert k (Map.findWithDefault Set.empty k m `Set.difference` vs) m 56 | 57 | union (MultiMap m1) (MultiMap m2) = MultiMap $ 58 | Map.unionWith Set.union m1 m2 59 | 60 | intersection (MultiMap m1) (MultiMap m2) = MultiMap $ 61 | Map.intersectionWith Set.intersection m1 m2 62 | -------------------------------------------------------------------------------- /packages/monoidmap-examples/components/monoidmap-examples/Data/MonoidMap/Examples/MultiMap/Instances/MultiMap2.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: © 2022–2025 Jonathan Knowles 3 | -- License: Apache-2.0 4 | -- 5 | -- A __lawful__ implementation of 'MultiMap', implemented in terms of 'Map' and 6 | -- 'Set'. 7 | -- 8 | module Data.MonoidMap.Examples.MultiMap.Instances.MultiMap2 where 9 | 10 | import Prelude 11 | 12 | import Data.Map.Strict 13 | ( Map ) 14 | import Data.Set 15 | ( Set ) 16 | 17 | import qualified Data.Map.Merge.Strict as Map 18 | import qualified Data.Map.Strict as Map 19 | import qualified Data.Set as Set 20 | import qualified Data.MonoidMap.Examples.MultiMap.Class as Class 21 | 22 | newtype MultiMap2 k v = MultiMap (Map k (Set v)) 23 | deriving stock (Eq, Show) 24 | 25 | instance (Ord k, Ord v) => Class.MultiMap MultiMap2 k v where 26 | 27 | fromList = MultiMap . Map.fromListWith (<>) . filter ((/= mempty) . snd) 28 | 29 | toList (MultiMap m) = Map.toList m 30 | 31 | empty = MultiMap Map.empty 32 | 33 | lookup k (MultiMap m) = Map.findWithDefault Set.empty k m 34 | 35 | null (MultiMap m) = Map.null m 36 | 37 | nonNull (MultiMap m) = not (Map.null m) 38 | 39 | nonNullKey k (MultiMap m) = Map.member k m 40 | 41 | nonNullKeys (MultiMap m) = Map.keysSet m 42 | 43 | nonNullCount (MultiMap m) = Map.size m 44 | 45 | isSubmapOf (MultiMap m1) (MultiMap m2) = 46 | Map.isSubmapOfBy Set.isSubsetOf m1 m2 47 | 48 | update k vs (MultiMap m) 49 | | Set.null vs = MultiMap (Map.delete k m) 50 | | otherwise = MultiMap (Map.insert k vs m) 51 | 52 | insert k vs (MultiMap m) 53 | | Set.null xs = MultiMap (Map.delete k m) 54 | | otherwise = MultiMap (Map.insert k xs m) 55 | where 56 | xs = Map.findWithDefault Set.empty k m `Set.union` vs 57 | 58 | remove k vs (MultiMap m) 59 | | Set.null xs = MultiMap (Map.delete k m) 60 | | otherwise = MultiMap (Map.insert k xs m) 61 | where 62 | xs = Map.findWithDefault Set.empty k m `Set.difference` vs 63 | 64 | union (MultiMap m1) (MultiMap m2) = MultiMap $ 65 | Map.unionWith Set.union m1 m2 66 | 67 | intersection (MultiMap m1) (MultiMap m2) = MultiMap $ 68 | Map.merge 69 | Map.dropMissing 70 | Map.dropMissing 71 | (Map.zipWithMaybeMatched mergeValues) 72 | m1 73 | m2 74 | where 75 | mergeValues :: k -> Set v -> Set v -> Maybe (Set v) 76 | mergeValues _k s1 s2 77 | | Set.null s3 = Nothing 78 | | otherwise = Just s3 79 | where 80 | s3 = Set.intersection s1 s2 81 | -------------------------------------------------------------------------------- /packages/monoidmap-examples/components/monoidmap-examples/Data/MonoidMap/Examples/MultiMap/Instances/MultiMap3.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: © 2022–2025 Jonathan Knowles 3 | -- License: Apache-2.0 4 | -- 5 | -- A __lawful__ implementation of 'MultiMap', implemented in terms of 'Map' and 6 | -- 'NESet'. 7 | -- 8 | module Data.MonoidMap.Examples.MultiMap.Instances.MultiMap3 where 9 | 10 | import Prelude 11 | 12 | import Data.Map.Strict 13 | ( Map ) 14 | import Data.Maybe 15 | ( mapMaybe ) 16 | import Data.MonoidMap.Examples.Set.NonEmpty 17 | ( NESet ) 18 | 19 | import qualified Data.Map.Merge.Strict as Map 20 | import qualified Data.Map.Strict as Map 21 | import qualified Data.Set as Set 22 | import qualified Data.MonoidMap.Examples.Set.NonEmpty as NESet 23 | import qualified Data.MonoidMap.Examples.MultiMap.Class as Class 24 | 25 | newtype MultiMap3 k v = MultiMap (Map k (NESet v)) 26 | deriving stock (Eq, Show) 27 | 28 | instance (Ord k, Ord v) => Class.MultiMap MultiMap3 k v where 29 | 30 | fromList 31 | = MultiMap 32 | . Map.fromListWith (<>) 33 | . mapMaybe (traverse NESet.nonEmptySet) 34 | 35 | toList (MultiMap m) = fmap NESet.toSet <$> Map.toList m 36 | 37 | empty = MultiMap Map.empty 38 | 39 | lookup k (MultiMap m) = maybe Set.empty NESet.toSet (Map.lookup k m) 40 | 41 | null (MultiMap m) = Map.null m 42 | 43 | nonNull (MultiMap m) = not (Map.null m) 44 | 45 | nonNullKey k (MultiMap m) = Map.member k m 46 | 47 | nonNullKeys (MultiMap m) = Map.keysSet m 48 | 49 | nonNullCount (MultiMap m) = Map.size m 50 | 51 | isSubmapOf (MultiMap m1) (MultiMap m2) = 52 | Map.isSubmapOfBy NESet.isSubsetOf m1 m2 53 | 54 | update k vs (MultiMap m) = 55 | case NESet.nonEmptySet vs of 56 | Nothing -> MultiMap (Map.delete k m) 57 | Just ys -> MultiMap (Map.insert k ys m) 58 | 59 | insert k vs (MultiMap m) = 60 | case NESet.nonEmptySet xs of 61 | Nothing -> MultiMap (Map.delete k m) 62 | Just ys -> MultiMap (Map.insert k ys m) 63 | where 64 | xs = maybe Set.empty NESet.toSet (Map.lookup k m) `Set.union` vs 65 | 66 | remove k vs (MultiMap m) = 67 | case NESet.nonEmptySet xs of 68 | Nothing -> MultiMap (Map.delete k m) 69 | Just ys -> MultiMap (Map.insert k ys m) 70 | where 71 | xs = maybe Set.empty NESet.toSet (Map.lookup k m) `Set.difference` vs 72 | 73 | union (MultiMap m1) (MultiMap m2) = MultiMap $ 74 | Map.unionWith NESet.union m1 m2 75 | 76 | intersection (MultiMap m1) (MultiMap m2) = MultiMap $ 77 | Map.merge 78 | Map.dropMissing 79 | Map.dropMissing 80 | (Map.zipWithMaybeMatched mergeValues) 81 | m1 82 | m2 83 | where 84 | mergeValues :: Ord v => k -> NESet v -> NESet v -> Maybe (NESet v) 85 | mergeValues _k s1 s2 = NESet.nonEmptySet (NESet.intersection s1 s2) 86 | -------------------------------------------------------------------------------- /packages/monoidmap-examples/components/monoidmap-examples/Data/MonoidMap/Examples/MultiMap/Instances/MultiMap4.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: © 2022–2025 Jonathan Knowles 3 | -- License: Apache-2.0 4 | -- 5 | -- A __lawful__ implementation of 'MultiMap', implemented in terms of 6 | -- 'MonoidMap' and 'Set'. 7 | -- 8 | module Data.MonoidMap.Examples.MultiMap.Instances.MultiMap4 where 9 | 10 | import Prelude 11 | 12 | import Data.MonoidMap 13 | ( MonoidMap ) 14 | import Data.Set 15 | ( Set ) 16 | 17 | import qualified Data.MonoidMap as MonoidMap 18 | import qualified Data.Set as Set 19 | import qualified Data.MonoidMap.Examples.MultiMap.Class as Class 20 | 21 | newtype MultiMap4 k v = MultiMap (MonoidMap k (Set v)) 22 | deriving stock (Eq, Show) 23 | 24 | instance (Ord k, Ord v) => Class.MultiMap MultiMap4 k v where 25 | 26 | fromList = MultiMap . MonoidMap.fromListWith (<>) 27 | 28 | toList (MultiMap m) = MonoidMap.toList m 29 | 30 | empty = MultiMap MonoidMap.empty 31 | 32 | lookup k (MultiMap m) = MonoidMap.get k m 33 | 34 | null (MultiMap m) = MonoidMap.null m 35 | 36 | nonNull (MultiMap m) = MonoidMap.nonNull m 37 | 38 | nonNullKey k (MultiMap m) = MonoidMap.nonNullKey k m 39 | 40 | nonNullKeys (MultiMap m) = MonoidMap.nonNullKeys m 41 | 42 | nonNullCount (MultiMap m) = MonoidMap.nonNullCount m 43 | 44 | isSubmapOf (MultiMap m1) (MultiMap m2) = m1 `MonoidMap.isSubmapOf` m2 45 | 46 | update k vs (MultiMap m) = 47 | MultiMap (MonoidMap.set k vs m) 48 | 49 | insert k vs (MultiMap m) = 50 | MultiMap (MonoidMap.adjust (`Set.union` vs) k m) 51 | 52 | remove k vs (MultiMap m) = 53 | MultiMap (MonoidMap.adjust (`Set.difference` vs) k m) 54 | 55 | union (MultiMap m1) (MultiMap m2) = 56 | MultiMap (MonoidMap.union m1 m2) 57 | 58 | intersection (MultiMap m1) (MultiMap m2) = 59 | MultiMap (MonoidMap.intersection m1 m2) 60 | -------------------------------------------------------------------------------- /packages/monoidmap-examples/components/monoidmap-examples/Data/MonoidMap/Examples/MultiSet.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: © 2022–2025 Jonathan Knowles 3 | -- License: Apache-2.0 4 | -- 5 | -- A multiset type, implemented in terms of 'MonoidMap'. 6 | -- 7 | -- See: https://en.wikipedia.org/wiki/Multiset 8 | -- 9 | module Data.MonoidMap.Examples.MultiSet 10 | ( fromList 11 | , toList 12 | , null 13 | , member 14 | , multiplicity 15 | , root 16 | , cardinality 17 | , dimension 18 | , height 19 | , isSubsetOf 20 | , intersection 21 | , union 22 | , disjointUnion 23 | , add 24 | , subtract 25 | , subtractMaybe 26 | ) 27 | where 28 | 29 | import Prelude hiding 30 | ( null, subtract ) 31 | 32 | import Data.Function 33 | ( on ) 34 | import Data.Monoid 35 | ( Sum (..) ) 36 | import Data.Monoid.GCD 37 | ( DistributiveGCDMonoid 38 | , GCDMonoid 39 | , LeftDistributiveGCDMonoid 40 | , LeftGCDMonoid 41 | , OverlappingGCDMonoid 42 | , RightDistributiveGCDMonoid 43 | , RightGCDMonoid 44 | ) 45 | import Data.Monoid.LCM 46 | ( DistributiveLCMMonoid, LCMMonoid ) 47 | import Data.Monoid.Monus 48 | ( Monus ((<\>)) ) 49 | import Data.Monoid.Null 50 | ( MonoidNull, PositiveMonoid ) 51 | import Data.MonoidMap 52 | ( MonoidMap ) 53 | import Data.Semigroup.Cancellative 54 | ( Cancellative 55 | , Commutative 56 | , LeftCancellative 57 | , LeftReductive 58 | , Reductive (()) 59 | , RightCancellative 60 | , RightReductive 61 | ) 62 | import Data.Set 63 | ( Set ) 64 | import Numeric.Natural 65 | ( Natural ) 66 | import Text.Read 67 | ( Read (..) ) 68 | 69 | import qualified Data.Foldable as F 70 | import qualified Data.MonoidMap as MonoidMap 71 | 72 | newtype MultiSet a = MultiSet 73 | { unMultiSet :: MonoidMap a (Sum Natural) 74 | } 75 | deriving newtype 76 | ( Eq 77 | , Semigroup 78 | , Commutative 79 | , Monoid 80 | , MonoidNull 81 | , PositiveMonoid 82 | , LeftReductive 83 | , LeftCancellative 84 | , LeftGCDMonoid 85 | , LeftDistributiveGCDMonoid 86 | , RightReductive 87 | , RightCancellative 88 | , RightGCDMonoid 89 | , RightDistributiveGCDMonoid 90 | , Reductive 91 | , Cancellative 92 | , GCDMonoid 93 | , LCMMonoid 94 | , DistributiveGCDMonoid 95 | , DistributiveLCMMonoid 96 | , OverlappingGCDMonoid 97 | , Monus 98 | ) 99 | 100 | instance (Ord a, Read a) => Read (MultiSet a) where 101 | readPrec = fromList <$> readPrec 102 | 103 | instance Show a => Show (MultiSet a) where 104 | show = show . toList 105 | 106 | fromList :: Ord a => [(a, Natural)] -> MultiSet a 107 | fromList = MultiSet . MonoidMap.fromList . fmap (fmap Sum) 108 | 109 | toList :: MultiSet a -> [(a, Natural)] 110 | toList = fmap (fmap getSum) . MonoidMap.toList . unMultiSet 111 | 112 | null :: MultiSet a -> Bool 113 | null = MonoidMap.null . unMultiSet 114 | 115 | member :: Ord a => a -> MultiSet a -> Bool 116 | member a = MonoidMap.nonNullKey a . unMultiSet 117 | 118 | multiplicity :: Ord a => a -> MultiSet a -> Natural 119 | multiplicity a = getSum . MonoidMap.get a . unMultiSet 120 | 121 | root :: Ord a => MultiSet a -> Set a 122 | root = MonoidMap.nonNullKeys . unMultiSet 123 | 124 | cardinality :: MultiSet a -> Natural 125 | cardinality = getSum . F.fold . unMultiSet 126 | 127 | dimension :: MultiSet a -> Natural 128 | dimension = fromIntegral . MonoidMap.nonNullCount . unMultiSet 129 | 130 | height :: Ord a => MultiSet a -> Natural 131 | height s 132 | | null s = 0 133 | | otherwise = getSum $ F.maximum $ unMultiSet s 134 | 135 | isSubsetOf :: Ord a => MultiSet a -> MultiSet a -> Bool 136 | isSubsetOf = MonoidMap.isSubmapOf `on` unMultiSet 137 | 138 | intersection :: Ord a => MultiSet a -> MultiSet a -> MultiSet a 139 | intersection (MultiSet s1) (MultiSet s2) = 140 | MultiSet (MonoidMap.intersection s1 s2) 141 | 142 | union :: Ord a => MultiSet a -> MultiSet a -> MultiSet a 143 | union (MultiSet s1) (MultiSet s2) = 144 | MultiSet (MonoidMap.union s1 s2) 145 | 146 | disjointUnion :: Ord a => MultiSet a -> MultiSet a -> MultiSet a 147 | disjointUnion m1 m2 = (m1 <\> m2) <> (m2 <\> m1) 148 | 149 | add :: Ord a => MultiSet a -> MultiSet a -> MultiSet a 150 | add = (<>) 151 | 152 | subtract :: Ord a => MultiSet a -> MultiSet a -> MultiSet a 153 | subtract = (<\>) 154 | 155 | subtractMaybe :: Ord a => MultiSet a -> MultiSet a -> Maybe (MultiSet a) 156 | subtractMaybe = () 157 | -------------------------------------------------------------------------------- /packages/monoidmap-examples/components/monoidmap-examples/Data/MonoidMap/Examples/Set/NonEmpty.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: © 2022–2025 Jonathan Knowles 3 | -- License: Apache-2.0 4 | -- 5 | -- A minimal non-empty variant of the 'Set' data type. 6 | -- 7 | module Data.MonoidMap.Examples.Set.NonEmpty 8 | ( NESet 9 | , nonEmptySet 10 | , toSet 11 | , isSubsetOf 12 | , union 13 | , intersection 14 | ) where 15 | 16 | import Prelude 17 | 18 | import Data.Coerce 19 | ( coerce ) 20 | import Data.Set 21 | ( Set ) 22 | 23 | import qualified Data.Set as Set 24 | 25 | newtype NESet v = NESet (Set v) 26 | deriving stock Eq 27 | deriving newtype (Semigroup, Show) 28 | 29 | nonEmptySet :: Set v -> Maybe (NESet v) 30 | nonEmptySet s 31 | | Set.null s = Nothing 32 | | otherwise = Just (NESet s) 33 | 34 | toSet :: NESet v -> Set v 35 | toSet = coerce 36 | 37 | isSubsetOf :: Ord v => NESet v -> NESet v -> Bool 38 | isSubsetOf = coerce Set.isSubsetOf 39 | 40 | union :: Ord v => NESet v -> NESet v -> NESet v 41 | union = coerce Set.union 42 | 43 | intersection :: Ord v => NESet v -> NESet v -> Set v 44 | intersection = coerce Set.intersection 45 | -------------------------------------------------------------------------------- /packages/monoidmap-examples/monoidmap-examples.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: monoidmap-examples 3 | version: 0.0.0.0 4 | bug-reports: https://github.com/jonathanknowles/monoidmap-examples/issues 5 | license: Apache-2.0 6 | license-file: LICENSE 7 | author: Jonathan Knowles 8 | maintainer: mail@jonathanknowles.net 9 | copyright: 2022–2025 Jonathan Knowles 10 | category: Data Structures 11 | synopsis: Examples for monoidmap. 12 | description: Examples for the monoidmap package. 13 | 14 | extra-doc-files: 15 | CHANGELOG.md 16 | README.md 17 | 18 | common dependency-base 19 | build-depends:base >= 4.14.3.0 && < 4.22 20 | common dependency-containers 21 | build-depends:containers >= 0.6.5.1 && < 0.8 22 | common dependency-hspec 23 | build-depends:hspec >= 2.10.9 && < 2.12 24 | common dependency-monoid-subclasses 25 | build-depends:monoid-subclasses >= 1.2.3 && < 1.3 26 | common dependency-monoidmap 27 | build-depends:monoidmap >= 0.0.4.4 && < 0.1 28 | common dependency-QuickCheck 29 | build-depends:QuickCheck >= 2.14.2 && < 2.16 30 | 31 | common extensions 32 | default-extensions: 33 | BangPatterns 34 | ConstraintKinds 35 | DerivingStrategies 36 | DerivingVia 37 | FlexibleContexts 38 | FlexibleInstances 39 | GeneralizedNewtypeDeriving 40 | LambdaCase 41 | MultiParamTypeClasses 42 | NoImplicitPrelude 43 | NumericUnderscores 44 | ScopedTypeVariables 45 | TupleSections 46 | TypeApplications 47 | TypeFamilies 48 | TypeOperators 49 | ViewPatterns 50 | 51 | source-repository head 52 | type: git 53 | location: https://github.com/jonathanknowles/monoidmap 54 | 55 | library 56 | import: 57 | , dependency-base 58 | , dependency-containers 59 | , dependency-monoid-subclasses 60 | , dependency-monoidmap 61 | , extensions 62 | hs-source-dirs: 63 | components/monoidmap-examples 64 | exposed-modules: 65 | Data.MonoidMap.Examples.MultiMap 66 | Data.MonoidMap.Examples.MultiMap.Class 67 | Data.MonoidMap.Examples.MultiMap.Instances.MultiMap1 68 | Data.MonoidMap.Examples.MultiMap.Instances.MultiMap2 69 | Data.MonoidMap.Examples.MultiMap.Instances.MultiMap3 70 | Data.MonoidMap.Examples.MultiMap.Instances.MultiMap4 71 | Data.MonoidMap.Examples.MultiSet 72 | Data.MonoidMap.Examples.NestedMonoidMap 73 | Data.MonoidMap.Examples.Set.NonEmpty 74 | default-language: 75 | Haskell2010 76 | 77 | test-suite monoidmap-examples-test 78 | import: 79 | , dependency-base 80 | , dependency-containers 81 | , dependency-hspec 82 | , dependency-QuickCheck 83 | , extensions 84 | build-depends: 85 | , monoidmap-examples 86 | ghc-options: 87 | -threaded -with-rtsopts=-N 88 | main-is: 89 | Spec.hs 90 | hs-source-dirs: 91 | components/monoidmap-examples-test 92 | other-modules: 93 | Data.MonoidMap.Examples.MultiMapSpec 94 | SpecHook 95 | type: 96 | exitcode-stdio-1.0 97 | default-language: 98 | Haskell2010 99 | build-tool-depends: 100 | hspec-discover:hspec-discover ==2.* 101 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # 0.0.0.0 2 | 3 | - Initial release. 4 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/README.md: -------------------------------------------------------------------------------- 1 | Internal support for the [`monoidmap`](https://github.com/jonathanknowles/monoidmap) package. 2 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-benchmark/Main.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: © 2022–2025 Jonathan Knowles 3 | -- License: Apache-2.0 4 | -- 5 | -- Benchmark for the `MonoidMap` type. 6 | -- 7 | -- Instead of benchmarking functions for the `MonoidMap` type directly, we 8 | -- benchmark functions for the `RecoveredMap` type, a newtype wrapper around 9 | -- the `MonoidMap` type designed to provide the same semantics as `Map`. 10 | -- 11 | module Main where 12 | 13 | import Control.DeepSeq 14 | ( rnf ) 15 | import Control.Exception 16 | ( evaluate ) 17 | import Data.Eq 18 | ( Eq ) 19 | import Data.Function 20 | ( flip, ($) ) 21 | import Data.Int 22 | ( Int ) 23 | import Data.List 24 | ( foldl', zip ) 25 | import Data.Maybe 26 | ( Maybe, fromMaybe ) 27 | import Data.Ord 28 | ( Ord ) 29 | import Data.Semigroup 30 | ( Semigroup ((<>)), stimes ) 31 | import Prelude 32 | ( Integer, Num, (^), (+) ) 33 | import System.IO 34 | ( IO ) 35 | import Test.Tasty.Bench 36 | ( bench, bgroup, defaultMain, nf ) 37 | 38 | import qualified Data.Map.Strict as OMap 39 | import qualified Data.MonoidMap.Internal.RecoveredMap as RMap 40 | 41 | main :: IO () 42 | main = do 43 | 44 | let om_natural = fromList elems_natural :: OMap.Map Int Int 45 | om_even = fromList elems_even :: OMap.Map Int Int 46 | om_odd = fromList elems_odd :: OMap.Map Int Int 47 | 48 | rm_natural = fromList elems_natural :: RMap.Map Int Int 49 | rm_even = fromList elems_even :: RMap.Map Int Int 50 | rm_odd = fromList elems_odd :: RMap.Map Int Int 51 | 52 | evaluate $ rnf [om_natural, om_even, om_odd] 53 | evaluate $ rnf [rm_natural, rm_even, rm_odd] 54 | 55 | defaultMain 56 | [ bgroup "delete" 57 | [ bgroup "absent" 58 | [ bench "Data.Map.Strict" $ 59 | nf (deleteMany evens) om_odd 60 | , bench "RecoveredMap" $ 61 | nf (deleteMany evens) rm_odd 62 | ] 63 | , bgroup "present" 64 | [ bench "Data.Map.Strict" $ 65 | nf (deleteMany evens) om_even 66 | , bench "RecoveredMap" $ 67 | nf (deleteMany evens) rm_even 68 | ] 69 | ] 70 | , bgroup "insert" 71 | [ bgroup "absent" 72 | [ bench "Data.Map.Strict" $ 73 | nf (insertMany elems_even) om_odd 74 | , bench "RecoveredMap" $ 75 | nf (insertMany elems_even) rm_odd 76 | ] 77 | , bgroup "present" 78 | [ bench "Data.Map.Strict" $ 79 | nf (insertMany elems_even) om_even 80 | , bench "RecoveredMap" $ 81 | nf (insertMany elems_even) rm_even 82 | ] 83 | ] 84 | , bgroup "lookup" 85 | [ bgroup "absent" 86 | [ bench "Data.Map.Strict" $ 87 | nf (lookupMany evens) om_odd 88 | , bench "RecoveredMap" $ 89 | nf (lookupMany evens) rm_odd 90 | ] 91 | , bgroup "present" 92 | [ bench "Data.Map.Strict" $ 93 | nf (lookupMany evens) om_even 94 | , bench "RecoveredMap" $ 95 | nf (lookupMany evens) rm_even 96 | ] 97 | ] 98 | , bgroup "mappend" 99 | [ bgroup "disjoint" 100 | [ bench "Data.Map.Strict" $ 101 | nf (<> om_even) om_odd 102 | , bench "RecoveredMap" $ 103 | nf (<> rm_even) rm_odd 104 | ] 105 | , bgroup "identical" 106 | [ bench "Data.Map.Strict" $ 107 | nf (<> om_even) om_even 108 | , bench "RecoveredMap" $ 109 | nf (<> rm_even) rm_even 110 | ] 111 | ] 112 | , bgroup "stimes" 113 | [ bench "Data.Map.Strict" $ 114 | nf (stimes ten_power_24) om_natural 115 | , bench "RecoveredMap" $ 116 | nf (stimes ten_power_24) rm_natural 117 | ] 118 | , bgroup "mapAccumL" 119 | [ bench "Data.Map.Strict" $ 120 | nf (mapAccumL (\s v -> (s + v, v)) 0) om_natural 121 | , bench "RecoveredMap" $ 122 | nf (mapAccumL (\s v -> (s + v, v)) 0) rm_natural 123 | ] 124 | , bgroup "mapAccumR" 125 | [ bench "Data.Map.Strict" $ 126 | nf (mapAccumR (\s v -> (s + v, v)) 0) om_natural 127 | , bench "RecoveredMap" $ 128 | nf (mapAccumR (\s v -> (s + v, v)) 0) rm_natural 129 | ] 130 | , bgroup "mapAccumLWithKey" 131 | [ bench "Data.Map.Strict" $ 132 | nf (mapAccumL (\s v -> (s + v, v)) 0) om_natural 133 | , bench "RecoveredMap" $ 134 | nf (mapAccumL (\s v -> (s + v, v)) 0) rm_natural 135 | ] 136 | , bgroup "mapAccumRWithKey" 137 | [ bench "Data.Map.Strict" $ 138 | nf (mapAccumRWithKey (\s k v -> (s + k + v, v)) 0) om_natural 139 | , bench "RecoveredMap" $ 140 | nf (mapAccumRWithKey (\s k v -> (s + k + v, v)) 0) rm_natural 141 | ] 142 | ] 143 | where 144 | bound :: Int 145 | bound = 2 ^ (16 :: Int) 146 | 147 | elems_natural :: [(Int, Int)] 148 | elems_natural = zip naturals naturals 149 | 150 | elems_even :: [(Int, Int)] 151 | elems_even = zip evens evens 152 | 153 | elems_odd :: [(Int, Int)] 154 | elems_odd = zip odds odds 155 | 156 | naturals :: [Int] 157 | naturals = [1 .. bound] 158 | 159 | evens :: [Int] 160 | evens = [2, 4 .. bound] 161 | 162 | odds :: [Int] 163 | odds = [1, 3 .. bound] 164 | 165 | ten_power_24 :: Integer 166 | ten_power_24 = 1_000_000_000_000_000_000_000_000 167 | 168 | class Ord k => Map m k v where 169 | fromList :: [(k, v)] -> m k v 170 | delete :: k -> m k v -> m k v 171 | insert :: k -> v -> m k v -> m k v 172 | lookup :: k -> m k v -> Maybe v 173 | mapAccumL :: (s -> v -> (s, v)) -> s -> m k v -> (s, m k v) 174 | mapAccumR :: (s -> v -> (s, v)) -> s -> m k v -> (s, m k v) 175 | mapAccumLWithKey :: (s -> k -> v -> (s, v)) -> s -> m k v -> (s, m k v) 176 | mapAccumRWithKey :: (s -> k -> v -> (s, v)) -> s -> m k v -> (s, m k v) 177 | 178 | instance Ord k => Map OMap.Map k v where 179 | fromList = OMap.fromList 180 | delete = OMap.delete 181 | insert = OMap.insert 182 | lookup = OMap.lookup 183 | mapAccumL = OMap.mapAccum 184 | mapAccumR f = OMap.mapAccumRWithKey (\s _ v -> f s v) 185 | mapAccumLWithKey = OMap.mapAccumWithKey 186 | mapAccumRWithKey = OMap.mapAccumRWithKey 187 | 188 | instance (Ord k, Eq v) => Map RMap.Map k v where 189 | fromList = RMap.fromList 190 | delete = RMap.delete 191 | insert = RMap.insert 192 | lookup = RMap.lookup 193 | mapAccumL = RMap.mapAccumL 194 | mapAccumR = RMap.mapAccumR 195 | mapAccumLWithKey = RMap.mapAccumLWithKey 196 | mapAccumRWithKey = RMap.mapAccumRWithKey 197 | 198 | deleteMany :: (Map m k v, Num v) => [k] -> m k v -> m k v 199 | deleteMany xs m = foldl' (flip delete) m xs 200 | 201 | insertMany :: (Map m k v, Num v) => [(k, v)] -> m k v -> m k v 202 | insertMany xs m = foldl' (\m' (k, v) -> insert k v m') m xs 203 | 204 | lookupMany :: (Map m k v, Num v) => [k] -> m k v -> v 205 | lookupMany xs m = foldl' (\n k -> fromMaybe n (lookup k m)) 0 xs 206 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-internal/Data/MonoidMap/Internal/RecoveredMap.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DerivingVia #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | 4 | -- | 5 | -- Copyright: © 2022–2025 Jonathan Knowles 6 | -- License: Apache-2.0 7 | -- 8 | -- An ordinary left-biased map similar to 'Map', implemented in terms of 9 | -- 'MonoidMap'. 10 | -- 11 | module Data.MonoidMap.Internal.RecoveredMap 12 | ( Map 13 | , empty 14 | , singleton 15 | , fromList 16 | , toList 17 | , delete 18 | , insert 19 | , keysSet 20 | , lookup 21 | , member 22 | , map 23 | , mapWithKey 24 | , mapAccumL 25 | , mapAccumLWithKey 26 | , mapAccumR 27 | , mapAccumRWithKey 28 | ) 29 | where 30 | 31 | import Prelude hiding 32 | ( lookup, map ) 33 | 34 | import Control.DeepSeq 35 | ( NFData ) 36 | import Data.Coerce 37 | ( coerce ) 38 | import Data.Maybe 39 | ( mapMaybe ) 40 | import Data.Monoid 41 | ( First (..) ) 42 | import Data.MonoidMap.Internal 43 | ( MonoidMap ) 44 | import Data.Semigroup 45 | ( Semigroup (stimes), stimesIdempotentMonoid ) 46 | import Data.Set 47 | ( Set ) 48 | 49 | import qualified Data.MonoidMap.Internal as MonoidMap 50 | 51 | newtype Map k v = Map 52 | -- 'First' is used to mimic the left-biased nature of 'Data.Map': 53 | {unMap :: MonoidMap k (First v)} 54 | deriving newtype (Eq, NFData, Monoid) 55 | 56 | instance Ord k => Semigroup (Map k v) where 57 | (<>) = coerce @(MonoidMap k (First v) -> _ -> _) (<>) 58 | stimes = stimesIdempotentMonoid 59 | 60 | instance (Show k, Show v) => Show (Map k v) where 61 | show = ("fromList " <>) . show . toList 62 | 63 | instance Functor (Map k) where 64 | fmap = map 65 | 66 | empty :: Map k v 67 | empty = Map MonoidMap.empty 68 | 69 | singleton :: Ord k => k -> v -> Map k v 70 | singleton k = Map . MonoidMap.singleton k . pure 71 | 72 | fromList :: Ord k => [(k, v)] -> Map k v 73 | fromList = Map . MonoidMap.fromListWith (const id) . fmap (fmap pure) 74 | 75 | toList :: Map k v -> [(k, v)] 76 | toList = mapMaybe (getFirst . sequenceA) . MonoidMap.toList . unMap 77 | 78 | delete :: Ord k => k -> Map k v -> Map k v 79 | delete k = Map . MonoidMap.nullify k . unMap 80 | 81 | insert :: Ord k => k -> v -> Map k v -> Map k v 82 | insert k v = Map . MonoidMap.set k (pure v) . unMap 83 | 84 | keysSet :: Map k v -> Set k 85 | keysSet = MonoidMap.nonNullKeys . unMap 86 | 87 | lookup :: Ord k => k -> Map k v -> Maybe v 88 | lookup k = getFirst . MonoidMap.get k . unMap 89 | 90 | member :: Ord k => k -> Map k v -> Bool 91 | member k = MonoidMap.nonNullKey k . unMap 92 | 93 | map :: (v1 -> v2) -> Map k v1 -> Map k v2 94 | map f = Map . MonoidMap.map (fmap f) . unMap 95 | 96 | mapWithKey :: (k -> v1 -> v2) -> Map k v1 -> Map k v2 97 | mapWithKey f = Map . MonoidMap.mapWithKey (fmap . f) . unMap 98 | 99 | mapAccumL :: (s -> v1 -> (s, v2)) -> s -> Map k v1 -> (s, Map k v2) 100 | mapAccumL f s m = Map <$> MonoidMap.mapAccumL (accum f) s (unMap m) 101 | 102 | mapAccumR :: (s -> v1 -> (s, v2)) -> s -> Map k v1 -> (s, Map k v2) 103 | mapAccumR f s m = Map <$> MonoidMap.mapAccumR (accum f) s (unMap m) 104 | 105 | mapAccumLWithKey :: (s -> k -> v1 -> (s, v2)) -> s -> Map k v1 -> (s, Map k v2) 106 | mapAccumLWithKey f s m = 107 | Map <$> MonoidMap.mapAccumLWithKey (accumWithKey f) s (unMap m) 108 | 109 | mapAccumRWithKey :: (s -> k -> v1 -> (s, v2)) -> s -> Map k v1 -> (s, Map k v2) 110 | mapAccumRWithKey f s m = 111 | Map <$> MonoidMap.mapAccumRWithKey (accumWithKey f) s (unMap m) 112 | 113 | -------------------------------------------------------------------------------- 114 | -- Utilities 115 | -------------------------------------------------------------------------------- 116 | 117 | accum :: (s -> v1 -> (s, v2)) -> s -> First v1 -> (s, First v2) 118 | accum f s1 (First mv1) = case mv1 of 119 | Just v1 -> let (s2, v2) = f s1 v1 in (s2, First (Just v2)) 120 | Nothing -> (s1, First Nothing) 121 | 122 | accumWithKey :: (s -> k -> v1 -> (s, v2)) -> s -> k -> First v1 -> (s, First v2) 123 | accumWithKey f s1 k (First mv1) = case mv1 of 124 | Just v1 -> let (s2, v2) = f s1 k v1 in (s2, First (Just v2)) 125 | Nothing -> (s1, First Nothing) 126 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-internal/Data/MonoidMap/Internal/Unsafe.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-unused-imports #-} 2 | 3 | -- | 4 | -- Copyright: © 2022–2025 Jonathan Knowles 5 | -- License: Apache-2.0 6 | -- 7 | -- Provides /unsafe/ operations for the 'MonoidMap' type. 8 | -- 9 | module Data.MonoidMap.Internal.Unsafe 10 | ( 11 | -- * Construction 12 | unsafeFromMap 13 | ) 14 | where 15 | 16 | import Prelude 17 | 18 | import Data.Coerce 19 | ( coerce ) 20 | import Data.Map.Strict 21 | ( Map ) 22 | import Data.MonoidMap.Internal 23 | ( MonoidMap (..), NonNull (..), fromMap ) 24 | 25 | import qualified Data.Foldable as F 26 | import qualified Data.Monoid.Null as Null 27 | import qualified Data.MonoidMap.Internal as Internal 28 | 29 | -------------------------------------------------------------------------------- 30 | -- Unsafe construction 31 | -------------------------------------------------------------------------------- 32 | 33 | -- | \(O(1)\). /Unsafely/ constructs a 'MonoidMap' from an ordinary 'Map'. 34 | -- 35 | -- Constructs a 'MonoidMap' in /constant time/, without imposing the burden 36 | -- of a canonicalisation step to remove 'null' values. 37 | -- 38 | -- When applied to a given 'Map' @m@, this function /expects/ but does /not/ 39 | -- check the following pre-condition: 40 | -- 41 | -- @ 42 | -- 'F.all' ('not' . 'Null.null') m 43 | -- @ 44 | -- 45 | -- Not satisfying this pre-condition will result in undefined behaviour. 46 | -- 47 | -- See 'fromMap' for a safe version of this function. 48 | -- 49 | unsafeFromMap :: Map k v -> MonoidMap k v 50 | unsafeFromMap = coerce 51 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-test/Data/MonoidMap/Internal/AccessSpec.hs: -------------------------------------------------------------------------------- 1 | {- HLINT ignore "Redundant bracket" -} 2 | {- HLINT ignore "Use camelCase" -} 3 | {- HLINT ignore "Use null" -} 4 | 5 | -- | 6 | -- Copyright: © 2022–2025 Jonathan Knowles 7 | -- License: Apache-2.0 8 | -- 9 | module Data.MonoidMap.Internal.AccessSpec 10 | ( spec 11 | ) where 12 | 13 | import Prelude 14 | 15 | import Control.Monad 16 | ( forM_ ) 17 | import Data.Function 18 | ( (&) ) 19 | import Data.MonoidMap.Internal 20 | ( MonoidMap ) 21 | import Data.Proxy 22 | ( Proxy (..) ) 23 | import Test.Common 24 | ( Key 25 | , Test 26 | , TestValueType (TestValueType) 27 | , makeSpec 28 | , property 29 | , testValueTypesAll 30 | ) 31 | import Test.Hspec 32 | ( Spec, describe, it ) 33 | import Test.QuickCheck 34 | ( Fun, Property, applyFun, cover, (===) ) 35 | 36 | import qualified Data.Monoid.Null as Null 37 | import qualified Data.MonoidMap.Internal as MonoidMap 38 | import qualified Data.Set as Set 39 | 40 | spec :: Spec 41 | spec = describe "Accessors" $ do 42 | 43 | forM_ testValueTypesAll $ 44 | \(TestValueType p) -> specFor (Proxy @Key) p 45 | 46 | specFor :: forall k v. Test k v => Proxy k -> Proxy v -> Spec 47 | specFor = makeSpec $ do 48 | 49 | describe "Get" $ do 50 | it "prop_get_nonNullKey" $ 51 | prop_get_nonNullKey 52 | @k @v & property 53 | it "prop_get_nonNullKeys" $ 54 | prop_get_nonNullKeys 55 | @k @v & property 56 | 57 | describe "Set" $ do 58 | it "prop_set_get" $ 59 | prop_set_get 60 | @k @v & property 61 | it "prop_set_nonNullKey" $ 62 | prop_set_nonNullKey 63 | @k @v & property 64 | it "prop_set_nonNullKeys" $ 65 | prop_set_nonNullKeys 66 | @k @v & property 67 | it "prop_set_toList" $ 68 | prop_set_toList 69 | @k @v & property 70 | 71 | describe "Adjust" $ do 72 | it "prop_adjust_get_set" $ 73 | prop_adjust_get_set 74 | @k @v & property 75 | 76 | -------------------------------------------------------------------------------- 77 | -- Get 78 | -------------------------------------------------------------------------------- 79 | 80 | prop_get_nonNullKey 81 | :: Test k v => MonoidMap k v -> k -> Property 82 | prop_get_nonNullKey m k = 83 | MonoidMap.nonNullKey k m === (MonoidMap.get k m /= mempty) 84 | & cover 2 85 | (MonoidMap.nonNullKey k m) 86 | "MonoidMap.nonNullKey k m" 87 | & cover 2 88 | (not (MonoidMap.nonNullKey k m)) 89 | "not (MonoidMap.nonNullKey k m)" 90 | 91 | prop_get_nonNullKeys 92 | :: Test k v => MonoidMap k v -> k -> Property 93 | prop_get_nonNullKeys m k = 94 | Set.member k (MonoidMap.nonNullKeys m) === (MonoidMap.get k m /= mempty) 95 | & cover 2 96 | (MonoidMap.nonNullKey k m) 97 | "MonoidMap.nonNullKey k m" 98 | & cover 2 99 | (not (MonoidMap.nonNullKey k m)) 100 | "not (MonoidMap.nonNullKey k m)" 101 | 102 | -------------------------------------------------------------------------------- 103 | -- Set 104 | -------------------------------------------------------------------------------- 105 | 106 | prop_set_get 107 | :: Test k v => MonoidMap k v -> k -> v -> Property 108 | prop_set_get m k v = 109 | MonoidMap.get k (MonoidMap.set k v m) === v 110 | & cover 2 111 | (MonoidMap.nonNullKey k m) 112 | "MonoidMap.nonNullKey k m" 113 | & cover 2 114 | (not (MonoidMap.nonNullKey k m)) 115 | "not (MonoidMap.nonNullKey k m)" 116 | 117 | prop_set_nonNullKey 118 | :: Test k v => MonoidMap k v -> k -> v -> Property 119 | prop_set_nonNullKey m k v = 120 | MonoidMap.nonNullKey k (MonoidMap.set k v m) === 121 | (v /= mempty) 122 | & cover 2 123 | (v == mempty) 124 | "v == mempty" 125 | & cover 2 126 | (v /= mempty) 127 | "v /= mempty" 128 | 129 | prop_set_nonNullKeys 130 | :: Test k v => MonoidMap k v -> k -> v -> Property 131 | prop_set_nonNullKeys m k v = 132 | Set.member k (MonoidMap.nonNullKeys (MonoidMap.set k v m)) === 133 | (v /= mempty) 134 | & cover 2 135 | (v == mempty) 136 | "v == mempty" 137 | & cover 2 138 | (v /= mempty) 139 | "v /= mempty" 140 | 141 | prop_set_toList 142 | :: Test k v => MonoidMap k v -> k -> v -> Property 143 | prop_set_toList m k v = 144 | filter ((== k) . fst) (MonoidMap.toList (MonoidMap.set k v m)) === 145 | [(k, v) | v /= mempty] 146 | & cover 2 147 | (v == mempty) 148 | "v == mempty" 149 | & cover 2 150 | (v /= mempty) 151 | "v /= mempty" 152 | 153 | -------------------------------------------------------------------------------- 154 | -- Adjust 155 | -------------------------------------------------------------------------------- 156 | 157 | prop_adjust_get_set 158 | :: Test k v => MonoidMap k v -> Fun v v -> k -> Property 159 | prop_adjust_get_set m (applyFun -> f) k = 160 | MonoidMap.adjust f k m === MonoidMap.set k (f (MonoidMap.get k m)) m 161 | & cover 1 162 | (MonoidMap.nullKey k m && Null.null (f mempty)) 163 | "MonoidMap.nullKey k m && Null.null (f mempty)" 164 | & cover 1 165 | (MonoidMap.nullKey k m && not (Null.null (f mempty))) 166 | "MonoidMap.nullKey k m && not (Null.null (f mempty))" 167 | & cover 0.1 168 | (MonoidMap.nonNullKey k m && Null.null (f (MonoidMap.get k m))) 169 | "MonoidMap.nonNullKey k m && Null.null (f (MonoidMap.get k m))" 170 | & cover 0.1 171 | (MonoidMap.nonNullKey k m && not (Null.null (f (MonoidMap.get k m)))) 172 | "MonoidMap.nonNullKey k m && not (Null.null (f (MonoidMap.get k m)))" 173 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-test/Data/MonoidMap/Internal/ComparisonSpec.hs: -------------------------------------------------------------------------------- 1 | {- HLINT ignore "Redundant bracket" -} 2 | {- HLINT ignore "Use camelCase" -} 3 | {- HLINT ignore "Use null" -} 4 | 5 | -- | 6 | -- Copyright: © 2022–2025 Jonathan Knowles 7 | -- License: Apache-2.0 8 | -- 9 | module Data.MonoidMap.Internal.ComparisonSpec 10 | ( spec 11 | ) where 12 | 13 | import Prelude 14 | 15 | import Control.Monad 16 | ( forM_ ) 17 | import Data.Function 18 | ( (&) ) 19 | import Data.Maybe 20 | ( isJust ) 21 | import Data.Monoid.Cancellative 22 | ( Reductive (..) ) 23 | import Data.Monoid.GCD 24 | ( GCDMonoid ) 25 | import Data.MonoidMap.Internal 26 | ( MonoidMap ) 27 | import Data.Proxy 28 | ( Proxy (..) ) 29 | import Test.Common 30 | ( Key 31 | , Test 32 | , TestValueType (TestValueType) 33 | , makeSpec 34 | , property 35 | , testValueTypesGCDMonoid 36 | , testValueTypesAll 37 | , testValueTypesReductive 38 | ) 39 | import Test.Hspec 40 | ( Spec, describe, it ) 41 | import Test.QuickCheck 42 | ( Fun (..), Property, applyFun2, cover, expectFailure, (.||.), (===) ) 43 | 44 | import qualified Data.Monoid.GCD as GCDMonoid 45 | ( GCDMonoid (..) ) 46 | import qualified Data.Monoid.Null as Null 47 | ( MonoidNull (..) ) 48 | import qualified Data.MonoidMap.Internal as MonoidMap 49 | import qualified Data.Set as Set 50 | 51 | spec :: Spec 52 | spec = describe "Comparison" $ do 53 | 54 | forM_ testValueTypesGCDMonoid $ 55 | \(TestValueType p) -> specGCDMonoid 56 | (Proxy @Key) p 57 | 58 | forM_ testValueTypesReductive $ 59 | \(TestValueType p) -> specReductive 60 | (Proxy @Key) p 61 | 62 | forM_ testValueTypesAll $ 63 | \(TestValueType p) -> specMonoidNull 64 | (Proxy @Key) p 65 | 66 | specGCDMonoid 67 | :: forall k v. (Test k v, GCDMonoid v) => Proxy k -> Proxy v -> Spec 68 | specGCDMonoid = makeSpec $ do 69 | it "prop_disjoint_gcd" $ 70 | prop_disjoint_gcd 71 | @k @v & property 72 | it "prop_disjoint_intersection" $ 73 | prop_disjoint_intersection 74 | @k @v & property 75 | 76 | specReductive 77 | :: forall k v. (Test k v, Reductive v) => Proxy k -> Proxy v -> Spec 78 | specReductive = makeSpec $ do 79 | it "prop_isSubmapOf_minusMaybe" $ 80 | prop_isSubmapOf_minusMaybe 81 | @k @v & property 82 | it "prop_isSubmapOf_reduce" $ 83 | prop_isSubmapOf_reduce 84 | @k @v & property 85 | 86 | specMonoidNull 87 | :: forall k v. Test k v => Proxy k -> Proxy v -> Spec 88 | specMonoidNull = makeSpec $ do 89 | it "prop_disjointBy_get_total" $ 90 | prop_disjointBy_get_total 91 | @k @v & property 92 | it "prop_disjointBy_get_total_failure" $ 93 | prop_disjointBy_get_total_failure 94 | @k @v & property 95 | it "prop_isSubmapOfBy_get_total" $ 96 | prop_isSubmapOfBy_get_total 97 | @k @v & property 98 | it "prop_isSubmapOfBy_get_total_failure" $ 99 | prop_isSubmapOfBy_get_total_failure 100 | @k @v & property 101 | 102 | prop_disjoint_gcd 103 | :: (Test k v, GCDMonoid v) 104 | => MonoidMap k v 105 | -> MonoidMap k v 106 | -> k 107 | -> Property 108 | prop_disjoint_gcd m1 m2 k = 109 | MonoidMap.disjoint m1 m2 ==> 110 | (Null.null (GCDMonoid.gcd (MonoidMap.get k m1) (MonoidMap.get k m2))) 111 | & cover 8 112 | (MonoidMap.disjoint m1 m2) 113 | "MonoidMap.disjoint m1 m2" 114 | & cover 8 115 | (not (MonoidMap.disjoint m1 m2)) 116 | "not (MonoidMap.disjoint m1 m2)" 117 | 118 | prop_disjoint_intersection 119 | :: (Test k v, GCDMonoid v) 120 | => MonoidMap k v 121 | -> MonoidMap k v 122 | -> Property 123 | prop_disjoint_intersection m1 m2 = 124 | MonoidMap.disjoint m1 m2 === (MonoidMap.intersection m1 m2 == mempty) 125 | & cover 8 126 | (MonoidMap.disjoint m1 m2) 127 | "MonoidMap.disjoint m1 m2" 128 | & cover 8 129 | (not (MonoidMap.disjoint m1 m2)) 130 | "not (MonoidMap.disjoint m1 m2)" 131 | 132 | prop_disjointBy_get_total 133 | :: Test k v 134 | => Fun (v, v) Bool 135 | -> MonoidMap k v 136 | -> MonoidMap k v 137 | -> k 138 | -> Property 139 | prop_disjointBy_get_total (applyFun2 -> f0) m1 m2 k = 140 | MonoidMap.disjointBy f m1 m2 141 | ==> 142 | f (MonoidMap.get k m1) (MonoidMap.get k m2) 143 | & cover 8 144 | (m1 /= mempty && m2 /= mempty && MonoidMap.disjointBy f m1 m2) 145 | "m1 /= mempty && m2 /= mempty && MonoidMap.disjointBy f m1 m2" 146 | & cover 2 147 | (keyWithinIntersection) 148 | "keyWithinIntersection" 149 | & cover 2 150 | (not keyWithinIntersection) 151 | "not keyWithinIntersection" 152 | where 153 | keyWithinIntersection = 154 | k `Set.member` Set.intersection 155 | (MonoidMap.nonNullKeys m1) 156 | (MonoidMap.nonNullKeys m2) 157 | f v1 v2 158 | | Null.null v1 = True 159 | | Null.null v2 = True 160 | | otherwise = f0 v1 v2 161 | 162 | prop_disjointBy_get_total_failure 163 | :: Test k v 164 | => Fun (v, v) Bool 165 | -> MonoidMap k v 166 | -> MonoidMap k v 167 | -> k 168 | -> Property 169 | prop_disjointBy_get_total_failure (applyFun2 -> f) m1 m2 k = 170 | expectFailure $ 171 | MonoidMap.disjointBy f m1 m2 172 | ==> 173 | f (MonoidMap.get k m1) (MonoidMap.get k m2) 174 | 175 | prop_isSubmapOf_minusMaybe 176 | :: (Test k v, Reductive v) 177 | => MonoidMap k v 178 | -> MonoidMap k v 179 | -> Property 180 | prop_isSubmapOf_minusMaybe m1 m2 = 181 | MonoidMap.isSubmapOf m1 m2 182 | ==> isJust (m2 `MonoidMap.minusMaybe` m1) 183 | & cover 0.01 184 | (nonTrivialSubmap) 185 | "nonTrivialSubmap" 186 | where 187 | nonTrivialSubmap = 188 | MonoidMap.isSubmapOf m1 m2 189 | && m1 /= mempty 190 | && m2 /= mempty 191 | && m1 /= m2 192 | 193 | prop_isSubmapOf_reduce 194 | :: (Test k v, Reductive v) 195 | => MonoidMap k v 196 | -> MonoidMap k v 197 | -> k 198 | -> Property 199 | prop_isSubmapOf_reduce m1 m2 k = 200 | MonoidMap.isSubmapOf m1 m2 201 | ==> isJust (MonoidMap.get k m2 MonoidMap.get k m1) 202 | & cover 0.001 203 | (nonTrivialSubmap && nonNullKeyL && nonNullKeyR) 204 | "nonTrivialSubmap && nonNullKeyL && nonNullKeyR" 205 | & cover 0.001 206 | (nonTrivialSubmap && nullKeyL && nonNullKeyR) 207 | "nonTrivialSubmap && nullKeyL && nonNullKeyR" 208 | & cover 0.001 209 | (nonTrivialSubmap && nullKeyL && nullKeyR) 210 | "nonTrivialSubmap && nullKeyL && nullKeyR" 211 | where 212 | nonTrivialSubmap = 213 | MonoidMap.isSubmapOf m1 m2 214 | && m1 /= mempty 215 | && m2 /= mempty 216 | && m1 /= m2 217 | nonNullKeyL = MonoidMap.nonNullKey k m1 218 | nonNullKeyR = MonoidMap.nonNullKey k m2 219 | nullKeyL = MonoidMap.nullKey k m1 220 | nullKeyR = MonoidMap.nullKey k m2 221 | 222 | prop_isSubmapOfBy_get_total 223 | :: Test k v 224 | => Fun (v, v) Bool 225 | -> MonoidMap k v 226 | -> MonoidMap k v 227 | -> k 228 | -> Property 229 | prop_isSubmapOfBy_get_total (applyFun2 -> f0) m1 m2 k = 230 | MonoidMap.isSubmapOfBy f m1 m2 231 | ==> 232 | f (MonoidMap.get k m1) (MonoidMap.get k m2) 233 | & cover 0.01 234 | (nonTrivialSubmap && nonNullKeyL && nonNullKeyR) 235 | "nonTrivialSubmap && nonNullKeyL && nonNullKeyR" 236 | & cover 0.1 237 | (nonTrivialSubmap && nullKeyL && nonNullKeyR) 238 | "nonTrivialSubmap && nullKeyL && nonNullKeyR" 239 | & cover 0.1 240 | (nonTrivialSubmap && nonNullKeyL && nullKeyR) 241 | "nonTrivialSubmap && nonNullKeyL && nullKeyR" 242 | & cover 0.1 243 | (nonTrivialSubmap && nullKeyL && nullKeyR) 244 | "nonTrivialSubmap && nullKeyL && nullKeyR" 245 | where 246 | f v1 v2 247 | | Null.null v1 = True 248 | | otherwise = f0 v1 v2 249 | nonTrivialSubmap = 250 | MonoidMap.isSubmapOfBy f m1 m2 251 | && m1 /= mempty 252 | && m2 /= mempty 253 | && m1 /= m2 254 | nonNullKeyL = MonoidMap.nonNullKey k m1 255 | nonNullKeyR = MonoidMap.nonNullKey k m2 256 | nullKeyL = MonoidMap.nullKey k m1 257 | nullKeyR = MonoidMap.nullKey k m2 258 | 259 | prop_isSubmapOfBy_get_total_failure 260 | :: Test k v 261 | => Fun (v, v) Bool 262 | -> MonoidMap k v 263 | -> MonoidMap k v 264 | -> k 265 | -> Property 266 | prop_isSubmapOfBy_get_total_failure (applyFun2 -> f) m1 m2 k = 267 | expectFailure $ 268 | MonoidMap.isSubmapOfBy f m1 m2 269 | ==> 270 | f (MonoidMap.get k m1) (MonoidMap.get k m2) 271 | 272 | -------------------------------------------------------------------------------- 273 | -- Utilities 274 | -------------------------------------------------------------------------------- 275 | 276 | infixr 3 ==> 277 | (==>) :: Bool -> Bool -> Property 278 | a ==> b = not a .||. b 279 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-test/Data/MonoidMap/Internal/DistributivitySpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | {- HLINT ignore "Redundant bracket" -} 3 | {- HLINT ignore "Use camelCase" -} 4 | {- HLINT ignore "Use null" -} 5 | 6 | -- | 7 | -- Copyright: © 2022–2025 Jonathan Knowles 8 | -- License: Apache-2.0 9 | -- 10 | module Data.MonoidMap.Internal.DistributivitySpec 11 | ( spec 12 | ) where 13 | 14 | import Prelude 15 | 16 | import Control.Monad 17 | ( forM_ ) 18 | import Data.Data 19 | ( typeRep ) 20 | import Data.Function 21 | ( (&) ) 22 | import Data.Maybe 23 | ( isJust ) 24 | import Data.MonoidMap.Internal 25 | ( MonoidMap, get ) 26 | import Data.Proxy 27 | ( Proxy (..) ) 28 | import Test.Common 29 | ( Key 30 | , Test 31 | , TestValueType (..) 32 | , TestValue 33 | , property 34 | , testValueTypesGCDMonoid 35 | , testValueTypesGroup 36 | , testValueTypesLCMMonoid 37 | , testValueTypesLeftGCDMonoid 38 | , testValueTypesLeftReductive 39 | , testValueTypesAll 40 | , testValueTypesMonus 41 | , testValueTypesOverlappingGCDMonoid 42 | , testValueTypesReductive 43 | , testValueTypesRightGCDMonoid 44 | , testValueTypesRightReductive 45 | ) 46 | import Test.Hspec 47 | ( Spec, describe, it ) 48 | import Test.QuickCheck 49 | ( Property, cover, (===) ) 50 | 51 | import qualified Data.Group as Group 52 | ( Group (..) ) 53 | import qualified Data.Monoid.GCD as LeftGCDMonoid 54 | ( LeftGCDMonoid (..) ) 55 | import qualified Data.Monoid.GCD as RightGCDMonoid 56 | ( RightGCDMonoid (..) ) 57 | import qualified Data.Monoid.GCD as OverlappingGCDMonoid 58 | ( OverlappingGCDMonoid (..) ) 59 | import qualified Data.Monoid.GCD as GCDMonoid 60 | ( GCDMonoid (..) ) 61 | import qualified Data.Monoid.LCM as LCMMonoid 62 | ( LCMMonoid (..) ) 63 | import qualified Data.Monoid.Monus as Monus 64 | ( Monus (..) ) 65 | import qualified Data.Semigroup as Semigroup 66 | ( Semigroup (..) ) 67 | import qualified Data.Semigroup.Cancellative as LeftReductive 68 | ( LeftReductive (..) ) 69 | import qualified Data.Semigroup.Cancellative as RightReductive 70 | ( RightReductive (..) ) 71 | import qualified Data.Semigroup.Cancellative as Reductive 72 | ( Reductive (..) ) 73 | 74 | spec :: Spec 75 | spec = do 76 | specDistributiveGet 77 | specDistributiveGetMaybe 78 | 79 | specDistributiveGet :: Spec 80 | specDistributiveGet = do 81 | specForAll 82 | testValueTypesAll 83 | "Semigroup.<>" 84 | (Semigroup.<>) 85 | (Semigroup.<>) 86 | specForAll 87 | testValueTypesLeftGCDMonoid 88 | "LeftGCDMonoid.commonPrefix" 89 | (LeftGCDMonoid.commonPrefix) 90 | (LeftGCDMonoid.commonPrefix) 91 | specForAll 92 | testValueTypesRightGCDMonoid 93 | "RightGCDMonoid.commonSuffix" 94 | (RightGCDMonoid.commonSuffix) 95 | (RightGCDMonoid.commonSuffix) 96 | specForAll 97 | testValueTypesOverlappingGCDMonoid 98 | "OverlappingGCDMonoid.overlap" 99 | (OverlappingGCDMonoid.overlap) 100 | (OverlappingGCDMonoid.overlap) 101 | specForAll 102 | testValueTypesGCDMonoid 103 | "GCDMonoid.gcd" 104 | (GCDMonoid.gcd) 105 | (GCDMonoid.gcd) 106 | specForAll 107 | testValueTypesLCMMonoid 108 | "LCMMonoid.lcm" 109 | (LCMMonoid.lcm) 110 | (LCMMonoid.lcm) 111 | specForAll 112 | testValueTypesGroup 113 | "Group.minus" 114 | (Group.~~) 115 | (Group.~~) 116 | specForAll 117 | testValueTypesMonus 118 | "Monus.monus" 119 | (Monus.<\>) 120 | (Monus.<\>) 121 | where 122 | specForAll 123 | :: [TestValueType c] 124 | -> String 125 | -> (forall k v m. (Test k v, c v, m ~ MonoidMap k v) => (m -> m -> m)) 126 | -> (forall v. (TestValue v, c v) => (v -> v -> v)) 127 | -> Spec 128 | specForAll testValueTypes funName f g = 129 | describe description $ forM_ testValueTypes $ specFor f g 130 | where 131 | description = "Distributivity of 'get' with '" <> funName <> "'" 132 | 133 | specFor 134 | :: (forall k v m. (Test k v, c v, m ~ MonoidMap k v) => (m -> m -> m)) 135 | -> (forall v. (TestValue v, c v) => (v -> v -> v)) 136 | -> TestValueType c 137 | -> Spec 138 | specFor f g (TestValueType (_ :: Proxy v)) = 139 | it description $ property $ propDistributiveGet @Key @v f g 140 | where 141 | description = show $ typeRep $ Proxy @(MonoidMap Key v) 142 | 143 | specDistributiveGetMaybe :: Spec 144 | specDistributiveGetMaybe = do 145 | specForAll 146 | testValueTypesLeftReductive 147 | "LeftReductive.stripPrefix" 148 | (LeftReductive.stripPrefix) 149 | (LeftReductive.stripPrefix) 150 | specForAll 151 | testValueTypesRightReductive 152 | "RightReductive.stripSuffix" 153 | (RightReductive.stripSuffix) 154 | (RightReductive.stripSuffix) 155 | specForAll 156 | testValueTypesReductive 157 | "Reductive.minusMaybe" 158 | (Reductive.) 159 | (Reductive.) 160 | where 161 | specForAll 162 | :: [TestValueType c] 163 | -> String 164 | -> (forall k v m. (Test k v, c v, m ~ MonoidMap k v) 165 | => (m -> m -> Maybe m)) 166 | -> (forall v. (TestValue v, c v) 167 | => (v -> v -> Maybe v)) 168 | -> Spec 169 | specForAll testValueTypes funName f g = 170 | describe description $ forM_ testValueTypes $ specFor f g 171 | where 172 | description = "Distributivity of 'get' with '" <> funName <> "'" 173 | 174 | specFor 175 | :: (forall k v m. (Test k v, c v, m ~ MonoidMap k v) 176 | => (m -> m -> Maybe m)) 177 | -> (forall v. (TestValue v, c v) 178 | => (v -> v -> Maybe v)) 179 | -> TestValueType c 180 | -> Spec 181 | specFor f g (TestValueType (_ :: Proxy v)) = 182 | it description $ property $ propDistributiveGetMaybe @Key @v f g 183 | where 184 | description = show $ typeRep $ Proxy @(MonoidMap Key v) 185 | 186 | propDistributiveGet 187 | :: Test k v 188 | => (MonoidMap k v -> MonoidMap k v -> MonoidMap k v) 189 | -> (v -> v -> v) 190 | -> k 191 | -> MonoidMap k v 192 | -> MonoidMap k v 193 | -> Property 194 | propDistributiveGet f g k m1 m2 = 195 | get k (f m1 m2) === g (get k m1) (get k m2) 196 | & cover 2 197 | (get k (f m1 m2) == mempty) 198 | "get k (f m1 m2) == mempty" 199 | & cover 2 200 | (get k (f m1 m2) /= mempty) 201 | "get k (f m1 m2) /= mempty" 202 | & cover 2 203 | (get k m1 == mempty && get k m2 == mempty) 204 | "get k m1 == mempty && get k m2 == mempty" 205 | & cover 2 206 | (get k m1 == mempty && get k m2 /= mempty) 207 | "get k m1 == mempty && get k m2 /= mempty" 208 | & cover 2 209 | (get k m1 /= mempty && get k m2 == mempty) 210 | "get k m1 /= mempty && get k m2 == mempty" 211 | & cover 2 212 | (get k m1 /= mempty && get k m2 /= mempty) 213 | "get k m1 /= mempty && get k m2 /= mempty" 214 | 215 | propDistributiveGetMaybe 216 | :: Test k v 217 | => (MonoidMap k v -> MonoidMap k v -> Maybe (MonoidMap k v)) 218 | -> (v -> v -> Maybe v) 219 | -> k 220 | -> MonoidMap k v 221 | -> MonoidMap k v 222 | -> Property 223 | propDistributiveGetMaybe f g k m1 m2 = property $ 224 | all (\m -> g (get k m1) (get k m2) == Just (get k m)) (f m1 m2) 225 | & cover 2 226 | (isJust (f m1 m2) && g (get k m1) (get k m2) == Just mempty) 227 | "isJust (f m1 m2) && g (get k m1) (get k m2) == Just mempty" 228 | & cover 2 229 | (isJust (f m1 m2) && g (get k m1) (get k m2) /= Just mempty) 230 | "isJust (f m1 m2) && g (get k m1) (get k m2) /= Just mempty" 231 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-test/Data/MonoidMap/Internal/FilterSpec.hs: -------------------------------------------------------------------------------- 1 | {- HLINT ignore "Redundant bracket" -} 2 | {- HLINT ignore "Use camelCase" -} 3 | {- HLINT ignore "Use null" -} 4 | 5 | -- | 6 | -- Copyright: © 2022–2025 Jonathan Knowles 7 | -- License: Apache-2.0 8 | -- 9 | module Data.MonoidMap.Internal.FilterSpec 10 | ( spec 11 | ) where 12 | 13 | import Prelude 14 | 15 | import Control.Monad 16 | ( forM_ ) 17 | import Data.Function 18 | ( (&) ) 19 | import Data.MonoidMap.Internal 20 | ( MonoidMap, nonNullCount ) 21 | import Data.Proxy 22 | ( Proxy (..) ) 23 | import GHC.Exts 24 | ( IsList (..) ) 25 | import Test.Common 26 | ( Key 27 | , Test 28 | , TestValueType (TestValueType) 29 | , makeSpec 30 | , property 31 | , testValueTypesAll 32 | ) 33 | import Test.Hspec 34 | ( Spec, describe, it ) 35 | import Test.QuickCheck 36 | ( Fun (..), Property, applyFun, applyFun2, cover, (===) ) 37 | 38 | import qualified Data.List as List 39 | import qualified Data.MonoidMap.Internal as MonoidMap 40 | 41 | spec :: Spec 42 | spec = describe "Filtering" $ do 43 | 44 | forM_ testValueTypesAll $ 45 | \(TestValueType p) -> specFor (Proxy @Key) p 46 | 47 | specFor :: forall k v. Test k v => Proxy k -> Proxy v -> Spec 48 | specFor = makeSpec $ do 49 | 50 | it "prop_filter_get" $ 51 | prop_filter_get 52 | @k @v & property 53 | it "prop_filter_asList" $ 54 | prop_filter_asList 55 | @k @v & property 56 | it "prop_filterKeys_get" $ 57 | prop_filterKeys_get 58 | @k @v & property 59 | it "prop_filterKeys_asList" $ 60 | prop_filterKeys_asList 61 | @k @v & property 62 | it "prop_filterWithKey_get" $ 63 | prop_filterWithKey_get 64 | @k @v & property 65 | it "prop_filterWithKey_asList" $ 66 | prop_filterWithKey_asList 67 | @k @v & property 68 | 69 | prop_filter_get 70 | :: Test k v => Fun v Bool -> k -> MonoidMap k v -> Property 71 | prop_filter_get (applyFun -> f) k m = 72 | MonoidMap.get k (MonoidMap.filter f m) 73 | === 74 | (MonoidMap.get k m & \v -> if f v then v else mempty) 75 | & cover 2 76 | (MonoidMap.nullKey k m && f (MonoidMap.get k m)) 77 | "MonoidMap.nullKey k m && f (MonoidMap.get k m)" 78 | & cover 2 79 | (MonoidMap.nullKey k m && not (f (MonoidMap.get k m))) 80 | "MonoidMap.nullKey k m && not (f (MonoidMap.get k m))" 81 | & cover 2 82 | (MonoidMap.nonNullKey k m && f (MonoidMap.get k m)) 83 | "MonoidMap.nonNullKey k m && f (MonoidMap.get k m)" 84 | & cover 2 85 | (MonoidMap.nonNullKey k m && not (f (MonoidMap.get k m))) 86 | "MonoidMap.nonNullKey k m && not (f (MonoidMap.get k m))" 87 | 88 | prop_filter_asList 89 | :: Test k v => Fun v Bool -> MonoidMap k v -> Property 90 | prop_filter_asList (applyFun -> f) m = 91 | n === fromList (List.filter (f . snd) (toList m)) 92 | & cover 2 93 | (MonoidMap.nonNull n && nonNullCount n == nonNullCount m) 94 | "MonoidMap.nonNull n && nonNullCount n == nonNullCount m" 95 | & cover 2 96 | (MonoidMap.nonNull n && nonNullCount n /= nonNullCount m) 97 | "MonoidMap.nonNull n && nonNullCount n /= nonNullCount m" 98 | where 99 | n = MonoidMap.filter f m 100 | 101 | prop_filterKeys_get 102 | :: Test k v => Fun k Bool -> k -> MonoidMap k v -> Property 103 | prop_filterKeys_get (applyFun -> f) k m = 104 | MonoidMap.get k (MonoidMap.filterKeys f m) 105 | === 106 | (if f k then MonoidMap.get k m else mempty) 107 | & cover 2 108 | (MonoidMap.nullKey k m && f k) 109 | "MonoidMap.nullKey k m && f k" 110 | & cover 2 111 | (MonoidMap.nullKey k m && not (f k)) 112 | "MonoidMap.nullKey k m && not (f k)" 113 | & cover 2 114 | (MonoidMap.nonNullKey k m && f k) 115 | "MonoidMap.nonNullKey k m && f k" 116 | & cover 2 117 | (MonoidMap.nonNullKey k m && not (f k)) 118 | "MonoidMap.nonNullKey k m && not (f k)" 119 | 120 | prop_filterKeys_asList 121 | :: Test k v => Fun k Bool -> MonoidMap k v -> Property 122 | prop_filterKeys_asList (applyFun -> f) m = 123 | n === MonoidMap.fromList (List.filter (f . fst) (toList m)) 124 | & cover 2 125 | (MonoidMap.nonNull n && nonNullCount n == nonNullCount m) 126 | "MonoidMap.nonNull n && nonNullCount n == nonNullCount m" 127 | & cover 2 128 | (MonoidMap.nonNull n && nonNullCount n /= nonNullCount m) 129 | "MonoidMap.nonNull n && nonNullCount n /= nonNullCount m" 130 | where 131 | n = MonoidMap.filterKeys f m 132 | 133 | prop_filterWithKey_get 134 | :: Test k v => Fun (k, v) Bool -> k -> MonoidMap k v -> Property 135 | prop_filterWithKey_get (applyFun2 -> f) k m = 136 | MonoidMap.get k (MonoidMap.filterWithKey f m) 137 | === 138 | (MonoidMap.get k m & \v -> if f k v then v else mempty) 139 | & cover 2 140 | (MonoidMap.nullKey k m && f k (MonoidMap.get k m)) 141 | "MonoidMap.nullKey k m && f k (MonoidMap.get k m)" 142 | & cover 2 143 | (MonoidMap.nullKey k m && not (f k (MonoidMap.get k m))) 144 | "MonoidMap.nullKey k m && not (f k (MonoidMap.get k m))" 145 | & cover 2 146 | (MonoidMap.nonNullKey k m && f k (MonoidMap.get k m)) 147 | "MonoidMap.nonNullKey k m && f k (MonoidMap.get k m)" 148 | & cover 2 149 | (MonoidMap.nonNullKey k m && not (f k (MonoidMap.get k m))) 150 | "MonoidMap.nonNullKey k m && not (f k (MonoidMap.get k m))" 151 | 152 | prop_filterWithKey_asList 153 | :: Test k v => Fun (k, v) Bool -> MonoidMap k v -> Property 154 | prop_filterWithKey_asList (applyFun2 -> f) m = 155 | n === MonoidMap.fromList (List.filter (uncurry f) (toList m)) 156 | & cover 2 157 | (MonoidMap.nonNull n && nonNullCount n == nonNullCount m) 158 | "MonoidMap.nonNull n && nonNullCount n == nonNullCount m" 159 | & cover 2 160 | (MonoidMap.nonNull n && nonNullCount n /= nonNullCount m) 161 | "MonoidMap.nonNull n && nonNullCount n /= nonNullCount m" 162 | where 163 | n = MonoidMap.filterWithKey f m 164 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-test/Data/MonoidMap/Internal/FoldSpec.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: © 2022–2025 Jonathan Knowles 3 | -- License: Apache-2.0 4 | -- 5 | module Data.MonoidMap.Internal.FoldSpec 6 | ( spec 7 | ) where 8 | 9 | import Prelude 10 | 11 | import Control.Monad 12 | ( forM_ ) 13 | import Data.Function 14 | ( (&) ) 15 | import Data.MonoidMap.Internal 16 | ( MonoidMap ) 17 | import Data.Proxy 18 | ( Proxy (..) ) 19 | import Test.Common 20 | ( Key 21 | , Test 22 | , TestValueType (TestValueType) 23 | , makeSpec 24 | , property 25 | , testValueTypesAll 26 | ) 27 | import Test.Hspec 28 | ( Spec, describe, it ) 29 | import Test.QuickCheck 30 | ( Fun (..), Property, applyFun2, applyFun3, (===) ) 31 | 32 | import qualified Data.Map.Strict as Map 33 | import qualified Data.MonoidMap.Internal as MonoidMap 34 | 35 | spec :: Spec 36 | spec = describe "Folding" $ do 37 | 38 | forM_ testValueTypesAll $ 39 | \(TestValueType p) -> specFor (Proxy @Key) p 40 | 41 | specFor :: forall k v. Test k v => Proxy k -> Proxy v -> Spec 42 | specFor = makeSpec $ do 43 | 44 | describe "Lazy" $ do 45 | 46 | it "prop_equivalence_foldl" $ 47 | prop_equivalence_foldl 48 | @k @v & property 49 | it "prop_equivalence_foldr" $ 50 | prop_equivalence_foldr 51 | @k @v & property 52 | it "prop_equivalence_foldlWithKey" $ 53 | prop_equivalence_foldlWithKey 54 | @k @v & property 55 | it "prop_equivalence_foldrWithKey" $ 56 | prop_equivalence_foldrWithKey 57 | @k @v & property 58 | it "prop_equivalence_foldMapWithKey" $ 59 | prop_equivalence_foldMapWithKey 60 | @k @v & property 61 | 62 | describe "Strict" $ do 63 | 64 | it "prop_equivalence_foldl'" $ 65 | prop_equivalence_foldl' 66 | @k @v & property 67 | it "prop_equivalence_foldr'" $ 68 | prop_equivalence_foldr' 69 | @k @v & property 70 | it "prop_equivalence_foldlWithKey'" $ 71 | prop_equivalence_foldlWithKey' 72 | @k @v & property 73 | it "prop_equivalence_foldrWithKey'" $ 74 | prop_equivalence_foldrWithKey' 75 | @k @v & property 76 | it "prop_equivalence_foldMapWithKey'" $ 77 | prop_equivalence_foldMapWithKey' 78 | @k @v & property 79 | 80 | -------------------------------------------------------------------------------- 81 | -- Lazy folding 82 | -------------------------------------------------------------------------------- 83 | 84 | prop_equivalence_foldl 85 | :: Test k v 86 | => r ~ v 87 | => Fun (r, v) r 88 | -> r 89 | -> MonoidMap k v 90 | -> Property 91 | prop_equivalence_foldl (applyFun2 -> f) r m = 92 | MonoidMap.foldl f r m 93 | === Map.foldl f r (MonoidMap.toMap m) 94 | 95 | prop_equivalence_foldr 96 | :: Test k v 97 | => r ~ v 98 | => Fun (v, r) r 99 | -> r 100 | -> MonoidMap k v 101 | -> Property 102 | prop_equivalence_foldr (applyFun2 -> f) r m = 103 | MonoidMap.foldr f r m 104 | === Map.foldr f r (MonoidMap.toMap m) 105 | 106 | prop_equivalence_foldlWithKey 107 | :: Test k v 108 | => r ~ v 109 | => Fun (r, k, v) r 110 | -> r 111 | -> MonoidMap k v 112 | -> Property 113 | prop_equivalence_foldlWithKey (applyFun3 -> f) r m = 114 | MonoidMap.foldlWithKey f r m 115 | === Map.foldlWithKey f r (MonoidMap.toMap m) 116 | 117 | prop_equivalence_foldrWithKey 118 | :: Test k v 119 | => r ~ v 120 | => Fun (k, v, r) r 121 | -> r 122 | -> MonoidMap k v 123 | -> Property 124 | prop_equivalence_foldrWithKey (applyFun3 -> f) r m = 125 | MonoidMap.foldrWithKey f r m 126 | === Map.foldrWithKey f r (MonoidMap.toMap m) 127 | 128 | prop_equivalence_foldMapWithKey 129 | :: Test k v 130 | => r ~ v 131 | => Fun (k, v) r 132 | -> MonoidMap k v 133 | -> Property 134 | prop_equivalence_foldMapWithKey (applyFun2 -> f) m = 135 | MonoidMap.foldMapWithKey f m 136 | === Map.foldMapWithKey f (MonoidMap.toMap m) 137 | 138 | -------------------------------------------------------------------------------- 139 | -- Strict folding 140 | -------------------------------------------------------------------------------- 141 | 142 | prop_equivalence_foldl' 143 | :: Test k v 144 | => r ~ v 145 | => Fun (r, v) r 146 | -> r 147 | -> MonoidMap k v 148 | -> Property 149 | prop_equivalence_foldl' (applyFun2 -> f) r m = 150 | MonoidMap.foldl' f r m === 151 | MonoidMap.foldl f r m 152 | 153 | prop_equivalence_foldr' 154 | :: Test k v 155 | => r ~ v 156 | => Fun (v, r) r 157 | -> r 158 | -> MonoidMap k v 159 | -> Property 160 | prop_equivalence_foldr' (applyFun2 -> f) r m = 161 | MonoidMap.foldr' f r m === 162 | MonoidMap.foldr f r m 163 | 164 | prop_equivalence_foldlWithKey' 165 | :: Test k v 166 | => r ~ v 167 | => Fun (r, k, v) r 168 | -> r 169 | -> MonoidMap k v 170 | -> Property 171 | prop_equivalence_foldlWithKey' (applyFun3 -> f) r m = 172 | MonoidMap.foldlWithKey' f r m === 173 | MonoidMap.foldlWithKey f r m 174 | 175 | prop_equivalence_foldrWithKey' 176 | :: Test k v 177 | => r ~ v 178 | => Fun (k, v, r) r 179 | -> r 180 | -> MonoidMap k v 181 | -> Property 182 | prop_equivalence_foldrWithKey' (applyFun3 -> f) r m = 183 | MonoidMap.foldrWithKey' f r m === 184 | MonoidMap.foldrWithKey f r m 185 | 186 | prop_equivalence_foldMapWithKey' 187 | :: Test k v 188 | => r ~ v 189 | => Fun (k, v) r 190 | -> MonoidMap k v 191 | -> Property 192 | prop_equivalence_foldMapWithKey' (applyFun2 -> f) m = 193 | MonoidMap.foldMapWithKey' f m === 194 | MonoidMap.foldMapWithKey f m 195 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-test/Data/MonoidMap/Internal/IntersectionSpec.hs: -------------------------------------------------------------------------------- 1 | {- HLINT ignore "Redundant bracket" -} 2 | {- HLINT ignore "Use camelCase" -} 3 | {- HLINT ignore "Use null" -} 4 | 5 | -- | 6 | -- Copyright: © 2022–2025 Jonathan Knowles 7 | -- License: Apache-2.0 8 | -- 9 | module Data.MonoidMap.Internal.IntersectionSpec 10 | ( spec 11 | ) where 12 | 13 | import Prelude 14 | 15 | import Control.Monad 16 | ( forM_ ) 17 | import Data.Function 18 | ( (&) ) 19 | import Data.Functor.Identity 20 | ( Identity (..) ) 21 | import Data.Monoid.Cancellative 22 | ( GCDMonoid ) 23 | import Data.MonoidMap.Internal 24 | ( MonoidMap ) 25 | import Data.Proxy 26 | ( Proxy (..) ) 27 | import Test.Common 28 | ( Key 29 | , Test 30 | , TestValueType (TestValueType) 31 | , makeSpec 32 | , property 33 | , testValueTypesGCDMonoid 34 | , testValueTypesAll 35 | ) 36 | import Test.Hspec 37 | ( Spec, describe, it ) 38 | import Test.QuickCheck 39 | ( Fun (..), Property, applyFun2, conjoin, cover, expectFailure, (===) ) 40 | 41 | import qualified Data.Monoid.Null as Null 42 | import qualified Data.MonoidMap.Internal as MonoidMap 43 | import qualified Data.Set as Set 44 | 45 | spec :: Spec 46 | spec = describe "Intersection" $ do 47 | 48 | forM_ testValueTypesAll $ 49 | \(TestValueType p) -> specMonoidNull 50 | (Proxy @Key) p 51 | forM_ testValueTypesGCDMonoid $ 52 | \(TestValueType p) -> specGCDMonoid 53 | (Proxy @Key) p 54 | 55 | specMonoidNull :: forall k v. Test k v => Proxy k -> Proxy v -> Spec 56 | specMonoidNull = makeSpec $ do 57 | it "prop_intersectionWith_get" $ 58 | prop_intersectionWith_get 59 | @k @v & property 60 | it "prop_intersectionWith_get_total" $ 61 | prop_intersectionWith_get_total 62 | @k @v & property 63 | it "prop_intersectionWith_get_total_failure" $ 64 | prop_intersectionWith_get_total_failure 65 | @k @v & property 66 | it "prop_intersectionWith_intersectionWithA" $ 67 | prop_intersectionWith_intersectionWithA 68 | @k @v & property 69 | 70 | specGCDMonoid 71 | :: forall k v. (Test k v, GCDMonoid v) => Proxy k -> Proxy v -> Spec 72 | specGCDMonoid = makeSpec $ do 73 | it "prop_intersection_isSubmapOf" $ 74 | prop_intersection_isSubmapOf 75 | @k @v & property 76 | 77 | prop_intersection_isSubmapOf 78 | :: (Test k v, GCDMonoid v) 79 | => MonoidMap k v 80 | -> MonoidMap k v 81 | -> Property 82 | prop_intersection_isSubmapOf m1 m2 = conjoin 83 | [ intersection_m1_m2 `MonoidMap.isSubmapOf` m1 84 | , intersection_m1_m2 `MonoidMap.isSubmapOf` m2 85 | ] 86 | & cover 2 87 | (m1 /= m2 && MonoidMap.nonNull (intersection_m1_m2)) 88 | "m1 /= m2 && MonoidMap.nonNull (intersection_m1_m2)" 89 | where 90 | intersection_m1_m2 = MonoidMap.intersection m1 m2 91 | 92 | prop_intersectionWith_get 93 | :: Test k v 94 | => Fun (v, v) v 95 | -> MonoidMap k v 96 | -> MonoidMap k v 97 | -> k 98 | -> Property 99 | prop_intersectionWith_get (applyFun2 -> f) m1 m2 k = 100 | (MonoidMap.get k result 101 | === 102 | if keyWithinIntersection 103 | then f (MonoidMap.get k m1) (MonoidMap.get k m2) 104 | else mempty) 105 | & cover 2 106 | (keyWithinIntersection) 107 | "keyWithinIntersection" 108 | & cover 2 109 | (not keyWithinIntersection) 110 | "not keyWithinIntersection" 111 | & cover 2 112 | (MonoidMap.null result) 113 | "MonoidMap.null result" 114 | & cover 2 115 | (MonoidMap.nonNull result) 116 | "MonoidMap.nonNull result" 117 | & cover 2 118 | (MonoidMap.nullKey k result) 119 | "MonoidMap.nullKey k result" 120 | & cover 2 121 | (MonoidMap.nonNullKey k result) 122 | "MonoidMap.nonNullKey k result" 123 | where 124 | keyWithinIntersection = 125 | k `Set.member` Set.intersection 126 | (MonoidMap.nonNullKeys m1) 127 | (MonoidMap.nonNullKeys m2) 128 | result = 129 | MonoidMap.intersectionWith f m1 m2 130 | 131 | prop_intersectionWith_get_total 132 | :: Test k v 133 | => Fun (v, v) v 134 | -> MonoidMap k v 135 | -> MonoidMap k v 136 | -> k 137 | -> Property 138 | prop_intersectionWith_get_total (applyFun2 -> f0) m1 m2 k = 139 | (MonoidMap.get k result 140 | === 141 | f (MonoidMap.get k m1) (MonoidMap.get k m2)) 142 | & cover 2 143 | (keyWithinIntersection) 144 | "keyWithinIntersection" 145 | & cover 2 146 | (not keyWithinIntersection) 147 | "not keyWithinIntersection" 148 | & cover 2 149 | (MonoidMap.null result) 150 | "MonoidMap.null result" 151 | & cover 2 152 | (MonoidMap.nonNull result) 153 | "MonoidMap.nonNull result" 154 | & cover 2 155 | (MonoidMap.nullKey k result) 156 | "MonoidMap.nullKey k result" 157 | & cover 2 158 | (MonoidMap.nonNullKey k result) 159 | "MonoidMap.nonNullKey k result" 160 | where 161 | result = 162 | MonoidMap.intersectionWith f m1 m2 163 | keyWithinIntersection = 164 | k `Set.member` Set.intersection 165 | (MonoidMap.nonNullKeys m1) 166 | (MonoidMap.nonNullKeys m2) 167 | f v1 v2 168 | | Null.null v1 = mempty 169 | | Null.null v2 = mempty 170 | | otherwise = f0 v1 v2 171 | 172 | prop_intersectionWith_get_total_failure 173 | :: Test k v 174 | => Fun (v, v) v 175 | -> MonoidMap k v 176 | -> MonoidMap k v 177 | -> k 178 | -> Property 179 | prop_intersectionWith_get_total_failure (applyFun2 -> f) m1 m2 k = 180 | expectFailure $ 181 | MonoidMap.get k (MonoidMap.intersectionWith f m1 m2) 182 | === 183 | f (MonoidMap.get k m1) (MonoidMap.get k m2) 184 | 185 | prop_intersectionWith_intersectionWithA 186 | :: Test k v 187 | => Fun (v, v) v 188 | -> MonoidMap k v 189 | -> MonoidMap k v 190 | -> Property 191 | prop_intersectionWith_intersectionWithA (applyFun2 -> f) m1 m2 = 192 | runIdentity (MonoidMap.intersectionWithA ((fmap . fmap) Identity f) m1 m2) 193 | === (MonoidMap.intersectionWith f m1 m2) 194 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-test/Data/MonoidMap/Internal/MembershipSpec.hs: -------------------------------------------------------------------------------- 1 | {- HLINT ignore "Redundant bracket" -} 2 | {- HLINT ignore "Use camelCase" -} 3 | {- HLINT ignore "Use null" -} 4 | 5 | -- | 6 | -- Copyright: © 2022–2025 Jonathan Knowles 7 | -- License: Apache-2.0 8 | -- 9 | module Data.MonoidMap.Internal.MembershipSpec 10 | ( spec 11 | ) where 12 | 13 | import Prelude 14 | 15 | import Control.Monad 16 | ( forM_ ) 17 | import Data.Function 18 | ( (&) ) 19 | import Data.MonoidMap.Internal 20 | ( MonoidMap ) 21 | import Data.Proxy 22 | ( Proxy (..) ) 23 | import Test.Common 24 | ( Key 25 | , Test 26 | , TestValueType (TestValueType) 27 | , makeSpec 28 | , property 29 | , testValueTypesAll 30 | ) 31 | import Test.Hspec 32 | ( Spec, describe, it ) 33 | import Test.QuickCheck 34 | ( Property, cover, (===) ) 35 | 36 | import qualified Data.MonoidMap.Internal as MonoidMap 37 | import qualified Data.Set as Set 38 | 39 | spec :: Spec 40 | spec = describe "Membership" $ do 41 | 42 | forM_ testValueTypesAll $ 43 | \(TestValueType p) -> specFor (Proxy @Key) p 44 | 45 | specFor :: forall k v. Test k v => Proxy k -> Proxy v -> Spec 46 | specFor = makeSpec $ do 47 | 48 | it "prop_nullify_get" $ 49 | prop_nullify_get 50 | @k @v & property 51 | it "prop_nullify_nonNullKey" $ 52 | prop_nullify_nonNullKey 53 | @k @v & property 54 | it "prop_nullify_nonNullKeys" $ 55 | prop_nullify_nonNullKeys 56 | @k @v & property 57 | it "prop_nonNullKeys_get" $ 58 | prop_nonNullKeys_get 59 | @k @v & property 60 | 61 | prop_nullify_get 62 | :: Test k v => MonoidMap k v -> k -> Property 63 | prop_nullify_get m k = 64 | MonoidMap.get k (MonoidMap.nullify k m) === mempty 65 | & cover 2 66 | (MonoidMap.nonNullKey k m) 67 | "MonoidMap.nonNullKey k m" 68 | & cover 2 69 | (not (MonoidMap.nonNullKey k m)) 70 | "not (MonoidMap.nonNullKey k m)" 71 | 72 | prop_nullify_nonNullKey 73 | :: Test k v => MonoidMap k v -> k -> Property 74 | prop_nullify_nonNullKey m k = 75 | MonoidMap.nonNullKey k (MonoidMap.nullify k m) === False 76 | & cover 2 77 | (MonoidMap.nonNullKey k m) 78 | "MonoidMap.nonNullKey k m" 79 | & cover 2 80 | (not (MonoidMap.nonNullKey k m)) 81 | "not (MonoidMap.nonNullKey k m)" 82 | 83 | prop_nullify_nonNullKeys 84 | :: Test k v => MonoidMap k v -> k -> Property 85 | prop_nullify_nonNullKeys m k = 86 | Set.member k (MonoidMap.nonNullKeys (MonoidMap.nullify k m)) === False 87 | & cover 2 88 | (MonoidMap.nonNullKey k m) 89 | "MonoidMap.nonNullKey k m" 90 | & cover 2 91 | (not (MonoidMap.nonNullKey k m)) 92 | "not (MonoidMap.nonNullKey k m)" 93 | 94 | prop_nonNullKeys_get 95 | :: Test k v => MonoidMap k v -> Property 96 | prop_nonNullKeys_get m = 97 | fmap 98 | (\k -> (k, MonoidMap.get k m)) 99 | (Set.toList (MonoidMap.nonNullKeys m)) 100 | === MonoidMap.toList m 101 | & cover 2 102 | (MonoidMap.null m) 103 | "MonoidMap.null m" 104 | & cover 2 105 | (not (MonoidMap.null m)) 106 | "not (MonoidMap.null m)" 107 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-test/Data/MonoidMap/Internal/PartitionSpec.hs: -------------------------------------------------------------------------------- 1 | {- HLINT ignore "Redundant bracket" -} 2 | {- HLINT ignore "Use camelCase" -} 3 | {- HLINT ignore "Use null" -} 4 | 5 | -- | 6 | -- Copyright: © 2022–2025 Jonathan Knowles 7 | -- License: Apache-2.0 8 | -- 9 | module Data.MonoidMap.Internal.PartitionSpec 10 | ( spec 11 | ) where 12 | 13 | import Prelude 14 | 15 | import Control.Monad 16 | ( forM_ ) 17 | import Data.Function 18 | ( (&) ) 19 | import Data.MonoidMap.Internal 20 | ( MonoidMap ) 21 | import Data.Proxy 22 | ( Proxy (..) ) 23 | import Test.Common 24 | ( Key 25 | , Test 26 | , TestValueType (TestValueType) 27 | , makeSpec 28 | , property 29 | , testValueTypesAll 30 | ) 31 | import Test.Hspec 32 | ( Spec, describe, it ) 33 | import Test.QuickCheck 34 | ( Fun (..), Property, applyFun, applyFun2, cover, (===) ) 35 | 36 | import qualified Data.MonoidMap.Internal as MonoidMap 37 | import qualified Data.Set as Set 38 | 39 | spec :: Spec 40 | spec = describe "Partitioning" $ do 41 | 42 | forM_ testValueTypesAll $ 43 | \(TestValueType p) -> specFor (Proxy @Key) p 44 | 45 | specFor :: forall k v. Test k v => Proxy k -> Proxy v -> Spec 46 | specFor = makeSpec $ do 47 | 48 | it "prop_partition_filter" $ 49 | prop_partition_filter 50 | @k @v & property 51 | it "prop_partition_append" $ 52 | prop_partition_append 53 | @k @v & property 54 | it "prop_partition_disjoint" $ 55 | prop_partition_disjoint 56 | @k @v & property 57 | it "prop_partitionKeys_filterKeys" $ 58 | prop_partitionKeys_filterKeys 59 | @k @v & property 60 | it "prop_partitionKeys_append" $ 61 | prop_partitionKeys_append 62 | @k @v & property 63 | it "prop_partitionKeys_disjoint" $ 64 | prop_partitionKeys_disjoint 65 | @k @v & property 66 | it "prop_partitionWithKey_filterWithKey" $ 67 | prop_partitionWithKey_filterWithKey 68 | @k @v & property 69 | it "prop_partitionWithKey_append" $ 70 | prop_partitionWithKey_append 71 | @k @v & property 72 | it "prop_partitionWithKey_disjoint" $ 73 | prop_partitionWithKey_disjoint 74 | @k @v & property 75 | 76 | prop_partition_filter 77 | :: Test k v => Fun v Bool -> MonoidMap k v -> Property 78 | prop_partition_filter (applyFun -> f) m = 79 | MonoidMap.partition f m === (m1, m2) 80 | & cover 2 81 | (MonoidMap.nonNull m1 && MonoidMap.nonNull m2) 82 | "MonoidMap.nonNull m1 && MonoidMap.nonNull m2" 83 | where 84 | m1 = MonoidMap.filter f m 85 | m2 = MonoidMap.filter (not . f) m 86 | 87 | prop_partition_append 88 | :: Test k v => Fun v Bool -> MonoidMap k v -> Property 89 | prop_partition_append (applyFun -> f) m = 90 | m1 <> m2 === m 91 | & cover 2 92 | (MonoidMap.nonNull m1 && MonoidMap.nonNull m2) 93 | "MonoidMap.nonNull m1 && MonoidMap.nonNull m2" 94 | where 95 | (m1, m2) = MonoidMap.partition f m 96 | 97 | prop_partition_disjoint 98 | :: Test k v => Fun v Bool -> MonoidMap k v -> Property 99 | prop_partition_disjoint (applyFun -> f) m = 100 | Set.disjoint 101 | (MonoidMap.nonNullKeys m1) 102 | (MonoidMap.nonNullKeys m2) 103 | & cover 2 104 | (MonoidMap.nonNull m1 && MonoidMap.nonNull m2) 105 | "MonoidMap.nonNull m1 && MonoidMap.nonNull m2" 106 | where 107 | (m1, m2) = MonoidMap.partition f m 108 | 109 | prop_partitionKeys_filterKeys 110 | :: Test k v => Fun k Bool -> MonoidMap k v -> Property 111 | prop_partitionKeys_filterKeys (applyFun -> f) m = 112 | MonoidMap.partitionKeys f m === (m1, m2) 113 | & cover 2 114 | (MonoidMap.nonNull m1 && MonoidMap.nonNull m2) 115 | "MonoidMap.nonNull m1 && MonoidMap.nonNull m2" 116 | where 117 | m1 = MonoidMap.filterKeys f m 118 | m2 = MonoidMap.filterKeys (not . f) m 119 | 120 | prop_partitionKeys_append 121 | :: Test k v => Fun k Bool -> MonoidMap k v -> Property 122 | prop_partitionKeys_append (applyFun -> f) m = 123 | m1 <> m2 === m 124 | & cover 2 125 | (MonoidMap.nonNull m1 && MonoidMap.nonNull m2) 126 | "MonoidMap.nonNull m1 && MonoidMap.nonNull m2" 127 | where 128 | (m1, m2) = MonoidMap.partitionKeys f m 129 | 130 | prop_partitionKeys_disjoint 131 | :: Test k v => Fun k Bool -> MonoidMap k v -> Property 132 | prop_partitionKeys_disjoint (applyFun -> f) m = 133 | Set.disjoint 134 | (MonoidMap.nonNullKeys m1) 135 | (MonoidMap.nonNullKeys m2) 136 | & cover 2 137 | (MonoidMap.nonNull m1 && MonoidMap.nonNull m2) 138 | "MonoidMap.nonNull m1 && MonoidMap.nonNull m2" 139 | where 140 | (m1, m2) = MonoidMap.partitionKeys f m 141 | 142 | prop_partitionWithKey_filterWithKey 143 | :: Test k v => Fun (k, v) Bool -> MonoidMap k v -> Property 144 | prop_partitionWithKey_filterWithKey (applyFun2 -> f) m = 145 | MonoidMap.partitionWithKey f m === (m1, m2) 146 | & cover 2 147 | (MonoidMap.nonNull m1 && MonoidMap.nonNull m2) 148 | "MonoidMap.nonNull m1 && MonoidMap.nonNull m2" 149 | where 150 | m1 = MonoidMap.filterWithKey f m 151 | m2 = MonoidMap.filterWithKey ((fmap . fmap) not f) m 152 | 153 | prop_partitionWithKey_append 154 | :: Test k v => Fun (k, v) Bool -> MonoidMap k v -> Property 155 | prop_partitionWithKey_append (applyFun2 -> f) m = 156 | m1 <> m2 === m 157 | & cover 2 158 | (MonoidMap.nonNull m1 && MonoidMap.nonNull m2) 159 | "MonoidMap.nonNull m1 && MonoidMap.nonNull m2" 160 | where 161 | (m1, m2) = MonoidMap.partitionWithKey f m 162 | 163 | prop_partitionWithKey_disjoint 164 | :: Test k v => Fun (k, v) Bool -> MonoidMap k v -> Property 165 | prop_partitionWithKey_disjoint (applyFun2 -> f) m = 166 | Set.disjoint 167 | (MonoidMap.nonNullKeys m1) 168 | (MonoidMap.nonNullKeys m2) 169 | & cover 2 170 | (MonoidMap.nonNull m1 && MonoidMap.nonNull m2) 171 | "MonoidMap.nonNull m1 && MonoidMap.nonNull m2" 172 | where 173 | (m1, m2) = MonoidMap.partitionWithKey f m 174 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-test/Data/MonoidMap/Internal/PrefixSpec.hs: -------------------------------------------------------------------------------- 1 | {- HLINT ignore "Redundant bracket" -} 2 | {- HLINT ignore "Use camelCase" -} 3 | {- HLINT ignore "Use null" -} 4 | 5 | -- | 6 | -- Copyright: © 2022–2025 Jonathan Knowles 7 | -- License: Apache-2.0 8 | -- 9 | module Data.MonoidMap.Internal.PrefixSpec 10 | ( spec 11 | ) where 12 | 13 | import Prelude 14 | 15 | import Control.Monad 16 | ( forM_ ) 17 | import Data.Function 18 | ( (&) ) 19 | import Data.Maybe 20 | ( isJust ) 21 | import Data.MonoidMap.Internal 22 | ( MonoidMap ) 23 | import Data.Proxy 24 | ( Proxy (..) ) 25 | import Data.Semigroup.Cancellative 26 | ( LeftReductive (..) ) 27 | import Test.Common 28 | ( Key 29 | , Test 30 | , TestValueType (TestValueType) 31 | , makeSpec 32 | , property 33 | , testValueTypesLeftReductive 34 | ) 35 | import Test.Hspec 36 | ( Spec, describe, it ) 37 | import Test.QuickCheck 38 | ( Property, cover, (===) ) 39 | 40 | import qualified Test.QuickCheck as QC 41 | 42 | spec :: Spec 43 | spec = describe "Prefixes" $ do 44 | 45 | forM_ testValueTypesLeftReductive $ 46 | \(TestValueType p) -> specFor (Proxy @Key) p 47 | 48 | specFor 49 | :: forall k v. (Test k v, LeftReductive v) => Proxy k -> Proxy v -> Spec 50 | specFor = makeSpec $ do 51 | it "prop_stripPrefix_isJust" $ 52 | prop_stripPrefix_isJust 53 | @k @v & property 54 | it "prop_stripPrefix_mappend" $ 55 | prop_stripPrefix_mappend 56 | @k @v & property 57 | 58 | prop_stripPrefix_isJust 59 | :: (Test k v, LeftReductive v) 60 | => MonoidMap k v 61 | -> MonoidMap k v 62 | -> Property 63 | prop_stripPrefix_isJust m1 m2 = 64 | isJust (stripPrefix m1 m2) === m1 `isPrefixOf` m2 65 | & cover 1 66 | (m1 `isPrefixOf` m2) 67 | "m1 `isPrefixOf` m2" 68 | 69 | prop_stripPrefix_mappend 70 | :: (Test k v, LeftReductive v) 71 | => MonoidMap k v 72 | -> MonoidMap k v 73 | -> Property 74 | prop_stripPrefix_mappend m1 m2 = QC.property $ 75 | all 76 | (\r -> m1 <> r == m2) 77 | (stripPrefix m1 m2) 78 | & cover 1 79 | (isJust (stripPrefix m1 m2)) 80 | "isJust (stripPrefix m1 m2)" 81 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-test/Data/MonoidMap/Internal/SingletonSpec.hs: -------------------------------------------------------------------------------- 1 | {- HLINT ignore "Redundant bracket" -} 2 | {- HLINT ignore "Use camelCase" -} 3 | {- HLINT ignore "Use null" -} 4 | 5 | -- | 6 | -- Copyright: © 2022–2025 Jonathan Knowles 7 | -- License: Apache-2.0 8 | -- 9 | module Data.MonoidMap.Internal.SingletonSpec 10 | ( spec 11 | ) where 12 | 13 | import Prelude 14 | 15 | import Data.Function 16 | ( (&) ) 17 | import Data.MonoidMap.Internal 18 | ( nonNullCount ) 19 | import Data.Proxy 20 | ( Proxy (..) ) 21 | import Test.Common 22 | ( Key 23 | , Test 24 | , TestValueType (TestValueType) 25 | , makeSpec 26 | , property 27 | , testValueTypesAll 28 | ) 29 | import Test.Hspec 30 | ( Spec, describe, it ) 31 | import Test.QuickCheck 32 | ( Property, cover, (===) ) 33 | 34 | import Control.Monad 35 | ( forM_ ) 36 | import qualified Data.MonoidMap.Internal as MonoidMap 37 | import qualified Data.Set as Set 38 | 39 | spec :: Spec 40 | spec = describe "Singletons" $ do 41 | 42 | forM_ testValueTypesAll $ 43 | \(TestValueType p) -> specFor (Proxy @Key) p 44 | 45 | specFor :: forall k v. Test k v => Proxy k -> Proxy v -> Spec 46 | specFor = makeSpec $ do 47 | 48 | it "prop_singleton_get" $ 49 | prop_singleton_get 50 | @k @v & property 51 | it "prop_singleton_nonNullKey" $ 52 | prop_singleton_nonNullKey 53 | @k @v & property 54 | it "prop_singleton_nonNullKeys" $ 55 | prop_singleton_nonNullKeys 56 | @k @v & property 57 | it "prop_singleton_null" $ 58 | prop_singleton_null 59 | @k @v & property 60 | it "prop_singleton_nullify" $ 61 | prop_singleton_nullify 62 | @k @v & property 63 | it "prop_singleton_nonNullCount" $ 64 | prop_singleton_nonNullCount 65 | @k @v & property 66 | it "prop_singleton_toList" $ 67 | prop_singleton_toList 68 | @k @v & property 69 | 70 | prop_singleton_get 71 | :: Test k v => k -> v -> Property 72 | prop_singleton_get k v = 73 | MonoidMap.get k (MonoidMap.singleton k v) === v 74 | & cover 2 75 | (v == mempty) 76 | "v == mempty" 77 | & cover 2 78 | (v /= mempty) 79 | "v /= mempty" 80 | 81 | prop_singleton_nonNullKey 82 | :: Test k v => k -> v -> Property 83 | prop_singleton_nonNullKey k v = 84 | MonoidMap.nonNullKey k (MonoidMap.singleton k v) === (v /= mempty) 85 | & cover 2 86 | (v == mempty) 87 | "v == mempty" 88 | & cover 2 89 | (v /= mempty) 90 | "v /= mempty" 91 | 92 | prop_singleton_nonNullKeys 93 | :: Test k v => k -> v -> Property 94 | prop_singleton_nonNullKeys k v = 95 | MonoidMap.nonNullKeys (MonoidMap.singleton k v) === 96 | (if v == mempty then Set.empty else Set.singleton k) 97 | & cover 2 98 | (v == mempty) 99 | "v == mempty" 100 | & cover 2 101 | (v /= mempty) 102 | "v /= mempty" 103 | 104 | prop_singleton_null 105 | :: Test k v => k -> v -> Property 106 | prop_singleton_null k v = 107 | MonoidMap.null (MonoidMap.singleton k v) === (v == mempty) 108 | & cover 2 109 | (v == mempty) 110 | "v == mempty" 111 | & cover 2 112 | (v /= mempty) 113 | "v /= mempty" 114 | 115 | prop_singleton_nullify 116 | :: Test k v => k -> v -> Property 117 | prop_singleton_nullify k v = 118 | MonoidMap.nullify k (MonoidMap.singleton k v) === mempty 119 | & cover 2 120 | (v == mempty) 121 | "v == mempty" 122 | & cover 2 123 | (v /= mempty) 124 | "v /= mempty" 125 | 126 | prop_singleton_nonNullCount 127 | :: Test k v => k -> v -> Property 128 | prop_singleton_nonNullCount k v = 129 | nonNullCount (MonoidMap.singleton k v) === 130 | (if v == mempty then 0 else 1) 131 | & cover 2 132 | (v == mempty) 133 | "v == mempty" 134 | & cover 2 135 | (v /= mempty) 136 | "v /= mempty" 137 | 138 | prop_singleton_toList 139 | :: Test k v => k -> v -> Property 140 | prop_singleton_toList k v = 141 | MonoidMap.toList (MonoidMap.singleton k v) === 142 | [(k, v) | v /= mempty] 143 | & cover 2 144 | (v == mempty) 145 | "v == mempty" 146 | & cover 2 147 | (v /= mempty) 148 | "v /= mempty" 149 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-test/Data/MonoidMap/Internal/SliceSpec.hs: -------------------------------------------------------------------------------- 1 | {- HLINT ignore "Redundant bracket" -} 2 | {- HLINT ignore "Use camelCase" -} 3 | {- HLINT ignore "Use null" -} 4 | 5 | -- | 6 | -- Copyright: © 2022–2025 Jonathan Knowles 7 | -- License: Apache-2.0 8 | -- 9 | module Data.MonoidMap.Internal.SliceSpec 10 | ( spec 11 | , Slice (..) 12 | ) where 13 | 14 | import Prelude 15 | 16 | import Control.Monad 17 | ( forM_ ) 18 | import Data.Bifunctor 19 | ( Bifunctor (bimap) ) 20 | import Data.Function 21 | ( (&) ) 22 | import Data.Monoid.Null 23 | ( MonoidNull ) 24 | import Data.MonoidMap.Internal 25 | ( MonoidMap, nonNullCount ) 26 | import Data.Proxy 27 | ( Proxy (..) ) 28 | import GHC.Exts 29 | ( IsList (..) ) 30 | import Test.Common 31 | ( Key 32 | , Test 33 | , TestValueType (TestValueType) 34 | , makeSpec 35 | , property 36 | , testValueTypesAll 37 | ) 38 | import Test.Hspec 39 | ( Spec, describe, it ) 40 | import Test.QuickCheck 41 | ( Arbitrary (..), Gen, Property, choose, cover, oneof, (===) ) 42 | 43 | import qualified Data.MonoidMap.Internal as MonoidMap 44 | 45 | spec :: Spec 46 | spec = describe "Slicing" $ do 47 | 48 | forM_ testValueTypesAll $ 49 | \(TestValueType p) -> specFor (Proxy @Key) p 50 | 51 | specFor :: forall k v. Test k v => Proxy k -> Proxy v -> Spec 52 | specFor = makeSpec $ do 53 | 54 | it "prop_take_toList_fromList" $ 55 | prop_take_toList_fromList 56 | @k @v & property 57 | it "prop_drop_toList_fromList" $ 58 | prop_drop_toList_fromList 59 | @k @v & property 60 | it "prop_splitAt_toList_fromList" $ 61 | prop_splitAt_toList_fromList 62 | @k @v & property 63 | 64 | data Slice k v = Slice Int (MonoidMap k v) 65 | deriving (Eq, Show) 66 | 67 | instance (Arbitrary k, Arbitrary v, MonoidNull v, Ord k) => 68 | Arbitrary (Slice k v) 69 | where 70 | arbitrary = do 71 | m <- genMap 72 | i <- genIndex m 73 | pure $ Slice i m 74 | where 75 | genMap :: Gen (MonoidMap k v) 76 | genMap = arbitrary 77 | 78 | genIndex :: MonoidMap k v -> Gen Int 79 | genIndex m = oneof 80 | [ choose (negate (length m), -1) 81 | , pure 0 82 | , choose (1, length m - 1) 83 | , pure (length m) 84 | , choose (length m + 1, 2 * length m) 85 | ] 86 | 87 | prop_take_toList_fromList 88 | :: Test k v => Slice k v -> Property 89 | prop_take_toList_fromList (Slice i m) = 90 | MonoidMap.take i m 91 | === (fromList . Prelude.take i . toList) m 92 | & cover 2 93 | (i == 0 && 0 < nonNullCount m) 94 | "i == 0 && 0 < nonNullCount m" 95 | & cover 2 96 | (0 < i && i < nonNullCount m) 97 | "0 < i && i < nonNullCount m" 98 | & cover 2 99 | (0 < nonNullCount m && nonNullCount m == i) 100 | "0 < nonNullCount m && nonNullCount m == i" 101 | & cover 2 102 | (0 < nonNullCount m && nonNullCount m < i) 103 | "0 < nonNullCount m && nonNullCount m < i" 104 | 105 | prop_drop_toList_fromList 106 | :: Test k v => Slice k v -> Property 107 | prop_drop_toList_fromList (Slice i m) = 108 | MonoidMap.drop i m 109 | === (fromList . Prelude.drop i . toList) m 110 | & cover 2 111 | (i == 0 && 0 < nonNullCount m) 112 | "i == 0 && 0 < nonNullCount m" 113 | & cover 2 114 | (0 < i && i < nonNullCount m) 115 | "0 < i && i < nonNullCount m" 116 | & cover 2 117 | (0 < nonNullCount m && nonNullCount m == i) 118 | "0 < nonNullCount m && nonNullCount m == i" 119 | & cover 2 120 | (0 < nonNullCount m && nonNullCount m < i) 121 | "0 < nonNullCount m && nonNullCount m < i" 122 | 123 | prop_splitAt_toList_fromList 124 | :: Test k v => Slice k v -> Property 125 | prop_splitAt_toList_fromList (Slice i m) = 126 | MonoidMap.splitAt i m 127 | === (bimap fromList fromList . Prelude.splitAt i . toList) m 128 | & cover 2 129 | (i == 0 && 0 < nonNullCount m) 130 | "i == 0 && 0 < nonNullCount m" 131 | & cover 2 132 | (0 < i && i < nonNullCount m) 133 | "0 < i && i < nonNullCount m" 134 | & cover 2 135 | (0 < nonNullCount m && nonNullCount m == i) 136 | "0 < nonNullCount m && nonNullCount m == i" 137 | & cover 2 138 | (0 < nonNullCount m && nonNullCount m < i) 139 | "0 < nonNullCount m && nonNullCount m < i" 140 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-test/Data/MonoidMap/Internal/SuffixSpec.hs: -------------------------------------------------------------------------------- 1 | {- HLINT ignore "Redundant bracket" -} 2 | {- HLINT ignore "Use camelCase" -} 3 | {- HLINT ignore "Use null" -} 4 | 5 | -- | 6 | -- Copyright: © 2022–2025 Jonathan Knowles 7 | -- License: Apache-2.0 8 | -- 9 | module Data.MonoidMap.Internal.SuffixSpec 10 | ( spec 11 | ) where 12 | 13 | import Prelude 14 | 15 | import Control.Monad 16 | ( forM_ ) 17 | import Data.Function 18 | ( (&) ) 19 | import Data.Maybe 20 | ( isJust ) 21 | import Data.MonoidMap.Internal 22 | ( MonoidMap ) 23 | import Data.Proxy 24 | ( Proxy (..) ) 25 | import Data.Semigroup.Cancellative 26 | ( RightReductive (..) ) 27 | import Test.Common 28 | ( Key 29 | , Test 30 | , TestValueType (TestValueType) 31 | , makeSpec 32 | , property 33 | , testValueTypesRightReductive 34 | ) 35 | import Test.Hspec 36 | ( Spec, describe, it ) 37 | import Test.QuickCheck 38 | ( Property, cover, (===) ) 39 | 40 | import qualified Test.QuickCheck as QC 41 | 42 | spec :: Spec 43 | spec = describe "Suffixes" $ do 44 | 45 | forM_ testValueTypesRightReductive $ 46 | \(TestValueType p) -> specFor (Proxy @Key) p 47 | 48 | specFor 49 | :: forall k v. (Test k v, RightReductive v) => Proxy k -> Proxy v -> Spec 50 | specFor = makeSpec $ do 51 | it "prop_stripSuffix_isJust" $ 52 | prop_stripSuffix_isJust 53 | @k @v & property 54 | it "prop_stripSuffix_mappend" $ 55 | prop_stripSuffix_mappend 56 | @k @v & property 57 | 58 | prop_stripSuffix_isJust 59 | :: (Test k v, RightReductive v) 60 | => MonoidMap k v 61 | -> MonoidMap k v 62 | -> Property 63 | prop_stripSuffix_isJust m1 m2 = 64 | isJust (stripSuffix m1 m2) === m1 `isSuffixOf` m2 65 | & cover 1 66 | (m1 `isSuffixOf` m2) 67 | "m1 `isSuffixOf` m2" 68 | 69 | prop_stripSuffix_mappend 70 | :: (Test k v, RightReductive v) 71 | => MonoidMap k v 72 | -> MonoidMap k v 73 | -> Property 74 | prop_stripSuffix_mappend m1 m2 = QC.property $ 75 | all 76 | (\r -> r <> m1 == m2) 77 | (stripSuffix m1 m2) 78 | & cover 1 79 | (isJust (stripSuffix m1 m2)) 80 | "isJust (stripSuffix m1 m2)" 81 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-test/Data/MonoidMap/Internal/TraversalSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE StandaloneDeriving #-} 2 | {-# OPTIONS_GHC -Wno-orphans #-} 3 | -- | 4 | -- Copyright: © 2022–2025 Jonathan Knowles 5 | -- License: Apache-2.0 6 | -- 7 | module Data.MonoidMap.Internal.TraversalSpec 8 | ( spec 9 | ) where 10 | 11 | import Prelude 12 | 13 | import Control.Monad 14 | ( forM_ ) 15 | import Data.Function 16 | ( (&) ) 17 | import Data.Functor.Identity 18 | ( Identity (..) ) 19 | import Data.MonoidMap.Internal 20 | ( MonoidMap ) 21 | import Data.Proxy 22 | ( Proxy (..) ) 23 | import Test.Common 24 | ( Key 25 | , Test 26 | , TestValueType (TestValueType) 27 | , makeSpec 28 | , property 29 | , testValueTypesAll 30 | ) 31 | import Test.Hspec 32 | ( Spec, describe, it ) 33 | import Test.QuickCheck 34 | ( Arbitrary (..) 35 | , Fun (..) 36 | , Property 37 | , applyFun 38 | , applyFun2 39 | , applyFun3 40 | , (===) 41 | ) 42 | import Data.Semigroup 43 | ( First (..), Last (..) ) 44 | 45 | import qualified Data.Map.Strict as Map 46 | import qualified Data.MonoidMap.Internal as MonoidMap 47 | import qualified Data.Traversable as Traversable 48 | 49 | spec :: Spec 50 | spec = describe "Traversal" $ do 51 | 52 | forM_ testValueTypesAll $ 53 | \(TestValueType p) -> specFor (Proxy @Key) p 54 | 55 | specFor :: forall k v. Test k v => Proxy k -> Proxy v -> Spec 56 | specFor = makeSpec $ do 57 | 58 | describe "traverse" $ do 59 | 60 | it "prop_traverse_@Identity" $ 61 | prop_traverse @Identity 62 | @k @v & property 63 | it "prop_traverse_@Maybe" $ 64 | prop_traverse @Maybe 65 | @k @v & property 66 | it "prop_traverse_@First" $ 67 | prop_traverse @First 68 | @k @v & property 69 | it "prop_traverse_@Last" $ 70 | prop_traverse @Last 71 | @k @v & property 72 | 73 | describe "traverseWithKey" $ do 74 | 75 | it "prop_traverseWithKey_@Identity" $ 76 | prop_traverseWithKey @Identity 77 | @k @v & property 78 | it "prop_traverseWithKey_@Maybe" $ 79 | prop_traverseWithKey @Maybe 80 | @k @v & property 81 | it "prop_traverseWithKey_@First" $ 82 | prop_traverseWithKey @First 83 | @k @v & property 84 | it "prop_traverseWithKey_@Last" $ 85 | prop_traverseWithKey @Last 86 | @k @v & property 87 | 88 | describe "mapAccumL" $ do 89 | 90 | it "prop_mapAccumL_@Int" $ 91 | prop_mapAccumL @Int 92 | @k @v & property 93 | it "prop_mapAccumL_@String" $ 94 | prop_mapAccumL @String 95 | @k @v & property 96 | 97 | describe "mapAccumR" $ do 98 | 99 | it "prop_mapAccumR_@Int" $ 100 | prop_mapAccumR @Int 101 | @k @v & property 102 | it "prop_mapAccumR_@String" $ 103 | prop_mapAccumR @String 104 | @k @v & property 105 | 106 | describe "mapAccumLWithKey" $ do 107 | 108 | it "prop_mapAccumLWithKey_@Int" $ 109 | prop_mapAccumLWithKey @Int 110 | @k @v & property 111 | it "prop_mapAccumLWithKey_@String" $ 112 | prop_mapAccumLWithKey @String 113 | @k @v & property 114 | 115 | describe "mapAccumRWithKey" $ do 116 | 117 | it "prop_mapAccumRWithKey_@Int" $ 118 | prop_mapAccumRWithKey @Int 119 | @k @v & property 120 | it "prop_mapAccumRWithKey_@String" $ 121 | prop_mapAccumRWithKey @String 122 | @k @v & property 123 | 124 | prop_traverse 125 | :: forall t k v. Test k v 126 | => (Applicative t, Eq (t (MonoidMap k v)), Show (t (MonoidMap k v))) 127 | => Fun v (t v) 128 | -> MonoidMap k v 129 | -> Property 130 | prop_traverse (applyFun -> f) m = 131 | MonoidMap.traverse f m 132 | === 133 | fmap MonoidMap.fromMap (Traversable.traverse f (MonoidMap.toMap m)) 134 | 135 | prop_traverseWithKey 136 | :: forall t k v. Test k v 137 | => (Applicative t, Eq (t (MonoidMap k v)), Show (t (MonoidMap k v))) 138 | => Fun (k, v) (t v) 139 | -> MonoidMap k v 140 | -> Property 141 | prop_traverseWithKey (applyFun2 -> f) m = 142 | MonoidMap.traverseWithKey f m 143 | === 144 | fmap MonoidMap.fromMap (Map.traverseWithKey f (MonoidMap.toMap m)) 145 | 146 | prop_mapAccumL 147 | :: forall s k v. (Test k v, Eq s, Show s) 148 | => Fun (s, v) (s, v) 149 | -> s 150 | -> MonoidMap k v 151 | -> Property 152 | prop_mapAccumL (applyFun2 -> f) s m = 153 | MonoidMap.mapAccumL f s m 154 | === 155 | fmap MonoidMap.fromMap (Traversable.mapAccumL f s (MonoidMap.toMap m)) 156 | 157 | prop_mapAccumR 158 | :: forall s k v. (Test k v, Eq s, Show s) 159 | => Fun (s, v) (s, v) 160 | -> s 161 | -> MonoidMap k v 162 | -> Property 163 | prop_mapAccumR (applyFun2 -> f) s m = 164 | MonoidMap.mapAccumR f s m 165 | === 166 | fmap MonoidMap.fromMap (Traversable.mapAccumR f s (MonoidMap.toMap m)) 167 | 168 | prop_mapAccumLWithKey 169 | :: forall s k v. (Test k v, Eq s, Show s) 170 | => Fun (s, k, v) (s, v) 171 | -> s 172 | -> MonoidMap k v 173 | -> Property 174 | prop_mapAccumLWithKey (applyFun3 -> f) s m = 175 | MonoidMap.mapAccumLWithKey f s m 176 | === 177 | fmap MonoidMap.fromMap (Map.mapAccumWithKey f s (MonoidMap.toMap m)) 178 | 179 | prop_mapAccumRWithKey 180 | :: forall s k v. (Test k v, Eq s, Show s) 181 | => Fun (s, k, v) (s, v) 182 | -> s 183 | -> MonoidMap k v 184 | -> Property 185 | prop_mapAccumRWithKey (applyFun3 -> f) s m = 186 | MonoidMap.mapAccumRWithKey f s m 187 | === 188 | fmap MonoidMap.fromMap (Map.mapAccumRWithKey f s (MonoidMap.toMap m)) 189 | 190 | deriving newtype instance Arbitrary a => Arbitrary (First a) 191 | deriving newtype instance Arbitrary a => Arbitrary (Last a) 192 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-test/Data/MonoidMap/Internal/UnionSpec.hs: -------------------------------------------------------------------------------- 1 | {- HLINT ignore "Redundant bracket" -} 2 | {- HLINT ignore "Use camelCase" -} 3 | {- HLINT ignore "Use null" -} 4 | 5 | -- | 6 | -- Copyright: © 2022–2025 Jonathan Knowles 7 | -- License: Apache-2.0 8 | -- 9 | module Data.MonoidMap.Internal.UnionSpec 10 | ( spec 11 | ) where 12 | 13 | import Prelude 14 | 15 | import Control.Monad 16 | ( forM_ ) 17 | import Data.Function 18 | ( (&) ) 19 | import Data.Functor.Identity 20 | ( Identity (..) ) 21 | import Data.Monoid.LCM 22 | ( LCMMonoid ) 23 | import Data.MonoidMap.Internal 24 | ( MonoidMap ) 25 | import Data.Proxy 26 | ( Proxy (..) ) 27 | import Test.Common 28 | ( Key 29 | , Test 30 | , TestValueType (TestValueType) 31 | , makeSpec 32 | , property 33 | , testValueTypesLCMMonoid 34 | , testValueTypesAll 35 | ) 36 | import Test.Hspec 37 | ( Spec, describe, it ) 38 | import Test.QuickCheck 39 | ( Fun (..), Property, applyFun2, conjoin, cover, expectFailure, (===) ) 40 | 41 | import qualified Data.Monoid.Null as Null 42 | import qualified Data.MonoidMap.Internal as MonoidMap 43 | import qualified Data.Set as Set 44 | 45 | spec :: Spec 46 | spec = describe "Union" $ do 47 | 48 | forM_ testValueTypesAll $ 49 | \(TestValueType p) -> specMonoidNull 50 | (Proxy @Key) p 51 | forM_ testValueTypesLCMMonoid $ 52 | \(TestValueType p) -> specLCMMonoid 53 | (Proxy @Key) p 54 | 55 | specMonoidNull :: forall k v. Test k v => Proxy k -> Proxy v -> Spec 56 | specMonoidNull = makeSpec $ do 57 | it "prop_unionWith_get" $ 58 | prop_unionWith_get 59 | @k @v & property 60 | it "prop_unionWith_get_total" $ 61 | prop_unionWith_get_total 62 | @k @v & property 63 | it "prop_unionWith_get_total_failure" $ 64 | prop_unionWith_get_total_failure 65 | @k @v & property 66 | it "prop_unionWith_unionWithA" $ 67 | prop_unionWith_unionWithA 68 | @k @v & property 69 | 70 | specLCMMonoid 71 | :: forall k v. (Test k v, LCMMonoid v) => Proxy k -> Proxy v -> Spec 72 | specLCMMonoid = makeSpec $ do 73 | it "prop_union_isSubmapOf" $ 74 | prop_union_isSubmapOf 75 | @k @v & property 76 | 77 | prop_union_isSubmapOf 78 | :: (Test k v, LCMMonoid v) 79 | => MonoidMap k v 80 | -> MonoidMap k v 81 | -> Property 82 | prop_union_isSubmapOf m1 m2 = conjoin 83 | [ m1 `MonoidMap.isSubmapOf` union_m1_m2 84 | , m2 `MonoidMap.isSubmapOf` union_m1_m2 85 | ] 86 | & cover 2 87 | (m1 /= m2 && MonoidMap.nonNull (union_m1_m2)) 88 | "m1 /= m2 && MonoidMap.nonNull (union_m1_m2)" 89 | where 90 | union_m1_m2 = MonoidMap.union m1 m2 91 | 92 | prop_unionWith_get 93 | :: Test k v 94 | => Fun (v, v) v 95 | -> MonoidMap k v 96 | -> MonoidMap k v 97 | -> k 98 | -> Property 99 | prop_unionWith_get (applyFun2 -> f) m1 m2 k = 100 | (MonoidMap.get k result 101 | === 102 | if keyWithinUnion 103 | then f (MonoidMap.get k m1) (MonoidMap.get k m2) 104 | else mempty) 105 | & cover 2 106 | (keyWithinUnion) 107 | "keyWithinUnion" 108 | & cover 2 109 | (not keyWithinUnion) 110 | "not keyWithinUnion" 111 | & cover 2 112 | (MonoidMap.null result) 113 | "MonoidMap.null result" 114 | & cover 2 115 | (MonoidMap.nonNull result) 116 | "MonoidMap.nonNull result)" 117 | & cover 2 118 | (MonoidMap.nullKey k result) 119 | "MonoidMap.nullKey k result" 120 | & cover 2 121 | (MonoidMap.nonNullKey k result) 122 | "MonoidMap.nonNullKey k result" 123 | where 124 | keyWithinUnion = 125 | k `Set.member` Set.union 126 | (MonoidMap.nonNullKeys m1) 127 | (MonoidMap.nonNullKeys m2) 128 | result = 129 | MonoidMap.unionWith f m1 m2 130 | 131 | prop_unionWith_get_total 132 | :: Test k v 133 | => Fun (v, v) v 134 | -> MonoidMap k v 135 | -> MonoidMap k v 136 | -> k 137 | -> Property 138 | prop_unionWith_get_total (applyFun2 -> f0) m1 m2 k = 139 | (MonoidMap.get k result 140 | === 141 | f (MonoidMap.get k m1) (MonoidMap.get k m2)) 142 | & cover 2 143 | (keyWithinUnion) 144 | "keyWithinUnion" 145 | & cover 2 146 | (not keyWithinUnion) 147 | "not keyWithinUnion" 148 | & cover 2 149 | (MonoidMap.null result) 150 | "MonoidMap.null result" 151 | & cover 2 152 | (MonoidMap.nonNull result) 153 | "MonoidMap.nonNull result)" 154 | & cover 2 155 | (MonoidMap.nullKey k result) 156 | "MonoidMap.nullKey k result" 157 | & cover 2 158 | (MonoidMap.nonNullKey k result) 159 | "MonoidMap.nonNullKey k result" 160 | where 161 | keyWithinUnion = 162 | k `Set.member` Set.union 163 | (MonoidMap.nonNullKeys m1) 164 | (MonoidMap.nonNullKeys m2) 165 | result = 166 | MonoidMap.unionWith f m1 m2 167 | f v1 v2 168 | | Null.null v1 && Null.null v2 = mempty 169 | | otherwise = f0 v1 v2 170 | 171 | prop_unionWith_get_total_failure 172 | :: Test k v 173 | => Fun (v, v) v 174 | -> MonoidMap k v 175 | -> MonoidMap k v 176 | -> k 177 | -> Property 178 | prop_unionWith_get_total_failure (applyFun2 -> f) m1 m2 k = 179 | expectFailure $ 180 | MonoidMap.get k (MonoidMap.unionWith f m1 m2) 181 | === 182 | f (MonoidMap.get k m1) (MonoidMap.get k m2) 183 | 184 | prop_unionWith_unionWithA 185 | :: Test k v 186 | => Fun (v, v) v 187 | -> MonoidMap k v 188 | -> MonoidMap k v 189 | -> Property 190 | prop_unionWith_unionWithA (applyFun2 -> f) m1 m2 = 191 | runIdentity (MonoidMap.unionWithA ((fmap . fmap) Identity f) m1 m2) 192 | === (MonoidMap.unionWith f m1 m2) 193 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-test/SpecHook.hs: -------------------------------------------------------------------------------- 1 | module SpecHook where 2 | 3 | import Test.Hspec 4 | 5 | hook :: Spec -> Spec 6 | hook = parallel 7 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-test/Test/Combinators/NonZero.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: © 2022–2025 Jonathan Knowles 3 | -- License: Apache-2.0 4 | -- 5 | module Test.Combinators.NonZero 6 | ( NonZero 7 | , genNonZero 8 | , getNonZero 9 | , maybeNonZero 10 | , shrinkNonZero 11 | ) 12 | where 13 | 14 | import Prelude 15 | 16 | import Data.Group 17 | ( Group ) 18 | import Data.Maybe 19 | ( mapMaybe ) 20 | import Data.Monoid.Null 21 | ( MonoidNull ) 22 | import Data.Semigroup.Cancellative 23 | ( Commutative ) 24 | import Test.QuickCheck 25 | ( Gen, suchThatMap ) 26 | 27 | -- | A combinator for non-zero values. 28 | newtype NonZero a = NonZero a 29 | deriving newtype (Eq, Num, Read, Show) 30 | deriving newtype (Semigroup, Commutative, Monoid, MonoidNull, Group) 31 | 32 | genNonZero :: (Eq a, Num a) => Gen a -> Gen (NonZero a) 33 | genNonZero genA = suchThatMap genA maybeNonZero 34 | 35 | getNonZero :: NonZero a -> a 36 | getNonZero (NonZero a) = a 37 | 38 | maybeNonZero :: (Eq a, Num a) => a -> Maybe (NonZero a) 39 | maybeNonZero p 40 | | p == 0 = Nothing 41 | | otherwise = Just (NonZero p) 42 | 43 | shrinkNonZero :: (Eq a, Num a) => (a -> [a]) -> NonZero a -> [NonZero a] 44 | shrinkNonZero shrinkA = mapMaybe maybeNonZero . shrinkA . getNonZero 45 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-test/Test/Hspec/Unit.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FunctionalDependencies #-} 2 | 3 | -- | 4 | -- Copyright: © 2022–2025 Jonathan Knowles 5 | -- License: Apache-2.0 6 | -- 7 | module Test.Hspec.Unit where 8 | 9 | import Prelude 10 | 11 | import Data.Functor 12 | ( (<&>) ) 13 | import Test.Hspec 14 | ( Spec, describe, it ) 15 | import Test.QuickCheck 16 | ( counterexample, property ) 17 | import Text.Show.Pretty 18 | ( ppShow ) 19 | 20 | import qualified Data.Foldable as F 21 | 22 | class IsUnitTestDatum d f r | d -> f, d -> r where 23 | params :: d -> [String] 24 | resultActual :: f -> d -> r 25 | resultExpected :: d -> r 26 | 27 | data UnitTestDatum1 p1 r = UnitTestDatum1 p1 r 28 | data UnitTestDatum2 p1 p2 r = UnitTestDatum2 p1 p2 r 29 | data UnitTestDatum3 p1 p2 p3 r = UnitTestDatum3 p1 p2 p3 r 30 | data UnitTestDatum4 p1 p2 p3 p4 r = UnitTestDatum4 p1 p2 p3 p4 r 31 | 32 | type UnitTestData1 p1 r = [UnitTestDatum1 p1 r] 33 | type UnitTestData2 p1 p2 r = [UnitTestDatum2 p1 p2 r] 34 | type UnitTestData3 p1 p2 p3 r = [UnitTestDatum3 p1 p2 p3 r] 35 | type UnitTestData4 p1 p2 p3 p4 r = [UnitTestDatum4 p1 p2 p3 p4 r] 36 | 37 | unitTestDatum1 :: (p1, r) -> UnitTestDatum1 p1 r 38 | unitTestDatum1 (p1, r) = UnitTestDatum1 p1 r 39 | unitTestDatum2 :: (p1, p2, r) -> UnitTestDatum2 p1 p2 r 40 | unitTestDatum2 (p1, p2, r) = UnitTestDatum2 p1 p2 r 41 | unitTestDatum3 :: (p1, p2, p3, r) -> UnitTestDatum3 p1 p2 p3 r 42 | unitTestDatum3 (p1, p2, p3, r) = UnitTestDatum3 p1 p2 p3 r 43 | unitTestDatum4 :: (p1, p2, p3, p4, r) -> UnitTestDatum4 p1 p2 p3 p4 r 44 | unitTestDatum4 (p1, p2, p3, p4, r) = UnitTestDatum4 p1 p2 p3 p4 r 45 | 46 | unitTestData1 :: [(p1, r)] -> UnitTestData1 p1 r 47 | unitTestData1 = fmap unitTestDatum1 48 | unitTestData2 :: [(p1, p2, r)] -> UnitTestData2 p1 p2 r 49 | unitTestData2 = fmap unitTestDatum2 50 | unitTestData3 :: [(p1, p2, p3, r)] -> UnitTestData3 p1 p2 p3 r 51 | unitTestData3 = fmap unitTestDatum3 52 | unitTestData4 :: [(p1, p2, p3, p4, r)] -> UnitTestData4 p1 p2 p3 p4 r 53 | unitTestData4 = fmap unitTestDatum4 54 | 55 | instance Show p1 => 56 | IsUnitTestDatum (UnitTestDatum1 p1 r) (p1 -> r) r 57 | where 58 | params (UnitTestDatum1 p1 _) = [show p1] 59 | resultActual f (UnitTestDatum1 p1 _) = f p1 60 | resultExpected (UnitTestDatum1 _ r) = r 61 | 62 | instance (Show p1, Show p2) => 63 | IsUnitTestDatum (UnitTestDatum2 p1 p2 r) (p1 -> p2 -> r) r 64 | where 65 | params (UnitTestDatum2 p1 p2 _) = [show p1, show p2] 66 | resultActual f (UnitTestDatum2 p1 p2 _) = f p1 p2 67 | resultExpected (UnitTestDatum2 _ _ r) = r 68 | 69 | instance (Show p1, Show p2, Show p3) => 70 | IsUnitTestDatum (UnitTestDatum3 p1 p2 p3 r) (p1 -> p2 -> p3 -> r) r 71 | where 72 | params (UnitTestDatum3 p1 p2 p3 _) = [show p1, show p2, show p3] 73 | resultActual f (UnitTestDatum3 p1 p2 p3 _) = f p1 p2 p3 74 | resultExpected (UnitTestDatum3 _ _ _ r) = r 75 | 76 | instance (Show p1, Show p2, Show p3, Show p4) => 77 | IsUnitTestDatum (UnitTestDatum4 p1 p2 p3 p4 r) (p1 -> p2 -> p3 -> p4 -> r) r 78 | where 79 | params (UnitTestDatum4 p1 p2 p3 p4 _) = [show p1, show p2, show p3, show p4] 80 | resultActual f (UnitTestDatum4 p1 p2 p3 p4 _) = f p1 p2 p3 p4 81 | resultExpected (UnitTestDatum4 _ _ _ _ r) = r 82 | 83 | unitTestSpec 84 | :: forall d f r. (IsUnitTestDatum d f r, Eq r, Show r) 85 | => String 86 | -> String 87 | -> f 88 | -> [d] 89 | -> Spec 90 | unitTestSpec specDescription functionName function = 91 | describe specDescription . mapM_ unitTest 92 | where 93 | unitTest :: d -> Spec 94 | unitTest d = it description 95 | $ property 96 | $ counterexample counterexampleText 97 | $ resultExpected d == resultActual function d 98 | where 99 | counterexampleText = unlines 100 | [ "" 101 | , "expected" 102 | , "/=" 103 | , "actual" 104 | , "" 105 | , showWrap (resultExpected d) 106 | , "/=" 107 | , showWrap (resultActual function d) 108 | ] 109 | description = unwords 110 | [ functionName 111 | , unwords (params d <&> \s -> "(" <> s <> ")") 112 | ] 113 | 114 | -------------------------------------------------------------------------------- 115 | -- Utilities 116 | -------------------------------------------------------------------------------- 117 | 118 | showWrap :: Show a => a -> String 119 | showWrap x 120 | | singleLineMaxLengthExceeded = 121 | multiLine 122 | | otherwise = 123 | singleLine 124 | where 125 | multiLine = ppShow x 126 | singleLine = show x 127 | singleLineMaxLength = 80 128 | singleLineMaxLengthExceeded = F.length singleLine > singleLineMaxLength 129 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-test/Test/Key.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | 5 | -- | 6 | -- Copyright: © 2022–2025 Jonathan Knowles 7 | -- License: Apache-2.0 8 | -- 9 | -- Quasi-unique keys. 10 | -- 11 | module Test.Key 12 | ( Key1 13 | , Key2 14 | , Key4 15 | , Key8 16 | ) 17 | where 18 | 19 | import Prelude 20 | 21 | import GHC.Generics 22 | ( Generic 23 | ) 24 | import GHC.TypeLits 25 | ( Nat 26 | ) 27 | import Test.QuickCheck 28 | ( Arbitrary 29 | , CoArbitrary 30 | , Function 31 | ) 32 | import Test.QuickCheck.Quid 33 | ( Latin (Latin) 34 | , Quid 35 | , Size (Size) 36 | ) 37 | 38 | newtype Key (size :: Nat) = Key Quid 39 | deriving stock (Eq, Generic, Ord) 40 | deriving (Read, Show) via Latin Quid 41 | deriving (Arbitrary) via Size size Quid 42 | deriving (CoArbitrary) via Quid 43 | deriving anyclass (Function) 44 | 45 | type Key1 = Key 1 46 | type Key2 = Key 2 47 | type Key4 = Key 4 48 | type Key8 = Key 8 49 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/components/monoidmap-test/Test/QuickCheck/Classes/Hspec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE PolyKinds #-} 2 | 3 | -- | 4 | -- Copyright: © 2022–2025 Jonathan Knowles 5 | -- License: Apache-2.0 6 | -- 7 | -- Provides testing functions to check that type class instances obey laws. 8 | -- 9 | module Test.QuickCheck.Classes.Hspec 10 | ( testLaws 11 | , testLawsMany 12 | ) where 13 | 14 | import Prelude 15 | 16 | import Control.Monad 17 | ( forM_ ) 18 | import Data.Proxy 19 | ( Proxy (..) ) 20 | import Data.Typeable 21 | ( Typeable, typeRep ) 22 | import Test.Hspec 23 | ( Spec, describe, it, parallel ) 24 | import Test.QuickCheck.Classes 25 | ( Laws (..) ) 26 | 27 | -- | Constructs a test to check that the given type class instance obeys the 28 | -- given set of laws. 29 | -- 30 | -- Example usage: 31 | -- 32 | -- >>> testLaws @Natural ordLaws 33 | -- >>> testLaws @(Map Int) functorLaws 34 | -- 35 | testLaws 36 | :: forall a. Typeable a 37 | => (Proxy a -> Laws) 38 | -> Spec 39 | testLaws getLaws = 40 | parallel $ describe description $ 41 | forM_ (lawsProperties laws) $ uncurry it 42 | where 43 | description = mconcat 44 | [ "Testing " 45 | , lawsTypeclass laws 46 | , " laws for type " 47 | , show (typeRep $ Proxy @a) 48 | ] 49 | laws = getLaws $ Proxy @a 50 | 51 | -- | Calls `testLaws` with multiple sets of laws. 52 | -- 53 | -- Example usage: 54 | -- 55 | -- >>> testLawsMany @Natural [eqLaws, ordLaws] 56 | -- >>> testLawsMany @(Map Int) [foldableLaws, functorLaws] 57 | -- 58 | testLawsMany 59 | :: forall a. Typeable a 60 | => [Proxy a -> Laws] 61 | -> Spec 62 | testLawsMany getLawsMany = 63 | testLaws @a `mapM_` getLawsMany 64 | -------------------------------------------------------------------------------- /packages/monoidmap-internal/monoidmap-internal.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: monoidmap-internal 3 | version: 0.0.0.0 4 | bug-reports: https://github.com/jonathanknowles/monoidmap-internal/issues 5 | license: Apache-2.0 6 | license-file: LICENSE 7 | author: Jonathan Knowles 8 | maintainer: mail@jonathanknowles.net 9 | copyright: 2022–2025 Jonathan Knowles 10 | category: Data Structures 11 | synopsis: Internal support for monoidmap. 12 | description: Internal support for the monoidmap package. 13 | 14 | extra-doc-files: 15 | CHANGELOG.md 16 | README.md 17 | 18 | common dependency-base 19 | build-depends:base >= 4.14.3.0 && < 4.22 20 | common dependency-containers 21 | build-depends:containers >= 0.6.5.1 && < 0.8 22 | common dependency-deepseq 23 | build-depends:deepseq >= 1.4.4.0 && < 1.6 24 | common dependency-groups 25 | build-depends:groups >= 0.5.3 && < 0.6 26 | common dependency-hspec 27 | build-depends:hspec >= 2.10.9 && < 2.12 28 | common dependency-monoid-subclasses 29 | build-depends:monoid-subclasses >= 1.2.3 && < 1.3 30 | common dependency-nothunks 31 | build-depends:nothunks >= 0.1.3 && < 0.4 32 | common dependency-pretty-show 33 | build-depends:pretty-show >= 1.10 && < 1.11 34 | common dependency-QuickCheck 35 | build-depends:QuickCheck >= 2.14.2 && < 2.16 36 | common dependency-quickcheck-classes 37 | build-depends:quickcheck-classes >= 0.6.5.0 && < 0.7 38 | common dependency-quickcheck-groups 39 | build-depends:quickcheck-groups >= 0.0.0.0 && < 0.1 40 | common dependency-quickcheck-monoid-subclasses 41 | build-depends:quickcheck-monoid-subclasses >= 0.3.0.0 && < 0.4 42 | common dependency-quickcheck-quid 43 | build-depends:quickcheck-quid >= 0.0.1.7 && < 0.1 44 | common dependency-tasty-bench 45 | build-depends:tasty-bench >= 0.3.2 && < 0.5 46 | common dependency-tasty-hunit 47 | build-depends:tasty-hunit >= 0.10.0.3 && < 0.11 48 | common dependency-text 49 | build-depends:text >= 1.2.4.1 && < 2.2 50 | 51 | common extensions 52 | default-extensions: 53 | BangPatterns 54 | ConstraintKinds 55 | DerivingStrategies 56 | DerivingVia 57 | FlexibleContexts 58 | FlexibleInstances 59 | GeneralizedNewtypeDeriving 60 | LambdaCase 61 | MultiParamTypeClasses 62 | NoImplicitPrelude 63 | NumericUnderscores 64 | ScopedTypeVariables 65 | TupleSections 66 | TypeApplications 67 | TypeFamilies 68 | TypeOperators 69 | ViewPatterns 70 | 71 | source-repository head 72 | type: git 73 | location: https://github.com/jonathanknowles/monoidmap 74 | 75 | library 76 | import: 77 | , dependency-base 78 | , dependency-containers 79 | , dependency-deepseq 80 | , dependency-groups 81 | , dependency-monoid-subclasses 82 | , dependency-nothunks 83 | , extensions 84 | hs-source-dirs: 85 | components/monoidmap-internal 86 | exposed-modules: 87 | Data.MonoidMap.Internal 88 | Data.MonoidMap.Internal.RecoveredMap 89 | Data.MonoidMap.Internal.Unsafe 90 | default-language: 91 | Haskell2010 92 | 93 | benchmark monoidmap-benchmark 94 | import: 95 | , dependency-base 96 | , dependency-containers 97 | , dependency-deepseq 98 | , dependency-tasty-bench 99 | , dependency-tasty-hunit 100 | , extensions 101 | build-depends: 102 | , monoidmap-internal 103 | default-language: 104 | Haskell2010 105 | type: 106 | exitcode-stdio-1.0 107 | hs-source-dirs: 108 | components/monoidmap-benchmark 109 | main-is: 110 | Main.hs 111 | 112 | test-suite monoidmap-test 113 | import: 114 | , dependency-base 115 | , dependency-containers 116 | , dependency-groups 117 | , dependency-hspec 118 | , dependency-monoid-subclasses 119 | , dependency-pretty-show 120 | , dependency-QuickCheck 121 | , dependency-quickcheck-classes 122 | , dependency-quickcheck-groups 123 | , dependency-quickcheck-monoid-subclasses 124 | , dependency-quickcheck-quid 125 | , dependency-text 126 | , extensions 127 | build-depends: 128 | , monoidmap-internal 129 | ghc-options: 130 | -threaded -with-rtsopts=-N 131 | main-is: 132 | Spec.hs 133 | hs-source-dirs: 134 | components/monoidmap-test 135 | other-modules: 136 | SpecHook 137 | Data.MonoidMap.Internal.AccessSpec 138 | Data.MonoidMap.Internal.ClassSpec 139 | Data.MonoidMap.Internal.ComparisonSpec 140 | Data.MonoidMap.Internal.ConversionSpec 141 | Data.MonoidMap.Internal.DistributivitySpec 142 | Data.MonoidMap.Internal.ExampleSpec 143 | Data.MonoidMap.Internal.FilterSpec 144 | Data.MonoidMap.Internal.FoldSpec 145 | Data.MonoidMap.Internal.IntersectionSpec 146 | Data.MonoidMap.Internal.MapSpec 147 | Data.MonoidMap.Internal.MembershipSpec 148 | Data.MonoidMap.Internal.PartitionSpec 149 | Data.MonoidMap.Internal.PrefixSpec 150 | Data.MonoidMap.Internal.RecoveredMapSpec 151 | Data.MonoidMap.Internal.SingletonSpec 152 | Data.MonoidMap.Internal.SliceSpec 153 | Data.MonoidMap.Internal.SuffixSpec 154 | Data.MonoidMap.Internal.TraversalSpec 155 | Data.MonoidMap.Internal.UnionSpec 156 | Data.MonoidMap.Internal.ValiditySpec 157 | Test.Combinators.NonZero 158 | Test.Common 159 | Test.Hspec.Unit 160 | Test.Key 161 | Test.QuickCheck.Classes.Hspec 162 | type: 163 | exitcode-stdio-1.0 164 | default-language: 165 | Haskell2010 166 | build-tool-depends: 167 | hspec-discover:hspec-discover ==2.* 168 | -------------------------------------------------------------------------------- /packages/monoidmap-quickcheck/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # 0.0.0.2 2 | 3 | - Bumped lower bound on `monoidmap`. 4 | 5 | # 0.0.0.1 6 | 7 | - Refreshed documentation. 8 | 9 | # 0.0.0.0 10 | 11 | - Initial release. 12 | -------------------------------------------------------------------------------- /packages/monoidmap-quickcheck/README.md: -------------------------------------------------------------------------------- 1 | # `monoidmap-quickcheck` 2 | 3 | 4 | ## Overview 5 | 6 | This package provides [`QuickCheck`](https://hackage.haskell.org/package/QuickCheck) support for the [`monoidmap`](https://hackage.haskell.org/package/monoidmap) package. 7 | -------------------------------------------------------------------------------- /packages/monoidmap-quickcheck/components/monoidmap-quickcheck/Data/MonoidMap/QuickCheck/Instances.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: © 2025 Jonathan Knowles 3 | -- License: Apache-2.0 4 | -- 5 | module Data.MonoidMap.QuickCheck.Instances 6 | ( module Data.MonoidMap.QuickCheck.Instances.Arbitrary 7 | , module Data.MonoidMap.QuickCheck.Instances.CoArbitrary 8 | , module Data.MonoidMap.QuickCheck.Instances.Function 9 | ) 10 | where 11 | 12 | import Data.MonoidMap.QuickCheck.Instances.Arbitrary () 13 | import Data.MonoidMap.QuickCheck.Instances.CoArbitrary () 14 | import Data.MonoidMap.QuickCheck.Instances.Function () 15 | -------------------------------------------------------------------------------- /packages/monoidmap-quickcheck/components/monoidmap-quickcheck/Data/MonoidMap/QuickCheck/Instances/Arbitrary.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: © 2025 Jonathan Knowles 3 | -- License: Apache-2.0 4 | -- 5 | module Data.MonoidMap.QuickCheck.Instances.Arbitrary () 6 | where 7 | 8 | import Data.Functor 9 | ( (<$>) 10 | ) 11 | import Data.Monoid.Null 12 | ( MonoidNull 13 | ) 14 | import Data.MonoidMap 15 | ( MonoidMap 16 | ) 17 | import Data.Ord 18 | ( Ord 19 | ) 20 | import Test.QuickCheck 21 | ( Arbitrary (arbitrary, shrink) 22 | , shrinkMap 23 | ) 24 | 25 | import qualified Data.MonoidMap as MonoidMap 26 | 27 | instance 28 | ( Arbitrary k 29 | , Arbitrary v 30 | , Ord k 31 | , MonoidNull v 32 | ) 33 | => (Arbitrary (MonoidMap k v)) 34 | where 35 | arbitrary = MonoidMap.fromMap <$> arbitrary 36 | shrink = shrinkMap MonoidMap.fromMap MonoidMap.toMap 37 | -------------------------------------------------------------------------------- /packages/monoidmap-quickcheck/components/monoidmap-quickcheck/Data/MonoidMap/QuickCheck/Instances/CoArbitrary.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: © 2025 Jonathan Knowles 3 | -- License: Apache-2.0 4 | module Data.MonoidMap.QuickCheck.Instances.CoArbitrary () 5 | where 6 | 7 | import Data.Function 8 | ( (.) 9 | ) 10 | import Data.MonoidMap 11 | ( MonoidMap 12 | ) 13 | import Test.QuickCheck 14 | ( CoArbitrary (coarbitrary) 15 | ) 16 | 17 | import qualified Data.MonoidMap as MonoidMap 18 | 19 | instance 20 | ( CoArbitrary k 21 | , CoArbitrary v 22 | ) 23 | => CoArbitrary (MonoidMap k v) 24 | where 25 | coarbitrary = coarbitrary . MonoidMap.toMap 26 | -------------------------------------------------------------------------------- /packages/monoidmap-quickcheck/components/monoidmap-quickcheck/Data/MonoidMap/QuickCheck/Instances/Function.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: © 2025 Jonathan Knowles 3 | -- License: Apache-2.0 4 | -- 5 | module Data.MonoidMap.QuickCheck.Instances.Function () 6 | where 7 | 8 | import Data.Monoid.Null 9 | ( MonoidNull 10 | ) 11 | import Data.MonoidMap 12 | ( MonoidMap 13 | ) 14 | import Data.Ord 15 | ( Ord 16 | ) 17 | import Test.QuickCheck 18 | ( Function (function) 19 | , functionMap 20 | ) 21 | 22 | import qualified Data.MonoidMap as MonoidMap 23 | 24 | instance 25 | ( Function k 26 | , Function v 27 | , Ord k 28 | , MonoidNull v 29 | ) 30 | => Function (MonoidMap k v) 31 | where 32 | function = functionMap MonoidMap.toMap MonoidMap.fromMap 33 | -------------------------------------------------------------------------------- /packages/monoidmap-quickcheck/monoidmap-quickcheck.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: monoidmap-quickcheck 3 | version: 0.0.0.2 4 | bug-reports: https://github.com/jonathanknowles/monoidmap-quickcheck/issues 5 | license: Apache-2.0 6 | license-file: LICENSE 7 | author: Jonathan Knowles 8 | maintainer: mail@jonathanknowles.net 9 | copyright: 2025 Jonathan Knowles 10 | category: Data Structures 11 | synopsis: QuickCheck support for monoidmap. 12 | description: QuickCheck support for the monoidmap package. 13 | 14 | extra-doc-files: 15 | CHANGELOG.md 16 | README.md 17 | 18 | common dependency-base 19 | build-depends:base >= 4.14.3.0 && < 4.22 20 | common dependency-containers 21 | build-depends:containers >= 0.6.5.1 && < 0.8 22 | common dependency-monoid-subclasses 23 | build-depends:monoid-subclasses >= 1.2.3 && < 1.3 24 | common dependency-monoidmap 25 | build-depends:monoidmap >= 0.0.4.4 && < 0.1 26 | common dependency-QuickCheck 27 | build-depends:QuickCheck >= 2.14.2 && < 2.16 28 | 29 | common extensions 30 | default-extensions: 31 | BangPatterns 32 | DerivingStrategies 33 | DerivingVia 34 | FlexibleContexts 35 | FlexibleInstances 36 | GeneralizedNewtypeDeriving 37 | LambdaCase 38 | NoImplicitPrelude 39 | NumericUnderscores 40 | ScopedTypeVariables 41 | TupleSections 42 | TypeApplications 43 | TypeFamilies 44 | TypeOperators 45 | 46 | source-repository head 47 | type: git 48 | location: https://github.com/jonathanknowles/monoidmap-quickcheck 49 | 50 | library 51 | import: 52 | , dependency-base 53 | , dependency-containers 54 | , dependency-monoid-subclasses 55 | , dependency-monoidmap 56 | , dependency-QuickCheck 57 | , extensions 58 | hs-source-dirs: 59 | components/monoidmap-quickcheck 60 | exposed-modules: 61 | Data.MonoidMap.QuickCheck.Instances 62 | Data.MonoidMap.QuickCheck.Instances.Arbitrary 63 | Data.MonoidMap.QuickCheck.Instances.CoArbitrary 64 | Data.MonoidMap.QuickCheck.Instances.Function 65 | default-language: 66 | Haskell2010 67 | -------------------------------------------------------------------------------- /packages/monoidmap/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # 0.0.4.4 2 | 3 | - Moved implementation, tests, and benchmark to the `monoidmap-internal` 4 | package. 5 | 6 | # 0.0.4.3 7 | 8 | - Moved all modules from `monoidmap-internal` to main library. 9 | 10 | # 0.0.4.2 11 | 12 | - Removed the dependency on `nonempty-containers`. 13 | 14 | # 0.0.4.1 15 | 16 | - Fixed spelling error in documentation. 17 | - Added the haddock `not-home` marker to `Data.MonoidMap.Internal`. 18 | 19 | # 0.0.4.0 20 | 21 | - Added the `fromMapWith` function to `MonoidMap`. 22 | 23 | # 0.0.3.0 24 | 25 | - Added the `mapWithKey` function to `MonoidMap`. 26 | 27 | # 0.0.2.1 28 | 29 | - Added support for GHC 9.12. 30 | 31 | # 0.0.2.0 32 | 33 | - Added the `fromSet` function to `MonoidMap`. 34 | 35 | # 0.0.1.9 36 | 37 | - Added the following traversal functions to `MonoidMap`: 38 | - `traverse` 39 | - `traverseWithKey` 40 | - `mapAccumL` 41 | - `mapAccumLWithKey` 42 | - `mapAccumR` 43 | - `mapAccumRWithKey` 44 | 45 | # 0.0.1.8 46 | 47 | - Added strict variant of the `foldMapWithKey` function. 48 | 49 | # 0.0.1.7 50 | 51 | - Added a selection of folding operations for `MonoidMap`. 52 | 53 | # 0.0.1.6 54 | 55 | - Updated version bounds for dependencies. 56 | 57 | # 0.0.1.5 58 | 59 | - Updated version bounds for dependencies. 60 | 61 | # 0.0.1.4 62 | 63 | - Added support for GHC 9.10. 64 | 65 | # 0.0.1.3 66 | 67 | - Updated version bounds for dependencies. 68 | 69 | # 0.0.1.2 70 | 71 | - Updated version bounds for dependencies. 72 | 73 | # 0.0.1.1 74 | 75 | - Updated version bounds for dependencies. 76 | 77 | # 0.0.1.0 78 | 79 | - Added support for GHC 9.8. 80 | - Optimised performance of `Semigroup.stimes` operation for `MonoidMap`. 81 | 82 | # 0.0.0.1 83 | 84 | - Revised `MultiMap` examples and documentation. 85 | 86 | # 0.0.0.0 87 | 88 | - Initial release. 89 | -------------------------------------------------------------------------------- /packages/monoidmap/monoidmap.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: monoidmap 3 | version: 0.0.4.4 4 | bug-reports: https://github.com/jonathanknowles/monoidmap/issues 5 | license: Apache-2.0 6 | license-file: LICENSE 7 | author: Jonathan Knowles 8 | maintainer: mail@jonathanknowles.net 9 | copyright: 2022–2025 Jonathan Knowles 10 | category: Data Structures 11 | synopsis: Monoidal map type 12 | description: 13 | Monoidal map type with support for semigroup and monoid subclasses. 14 | 15 | extra-doc-files: 16 | CHANGELOG.md 17 | README.md 18 | 19 | common dependency-base 20 | build-depends:base >= 4.14.3.0 && < 4.22 21 | common dependency-containers 22 | build-depends:containers >= 0.6.5.1 && < 0.8 23 | common dependency-deepseq 24 | build-depends:deepseq >= 1.4.4.0 && < 1.6 25 | common dependency-groups 26 | build-depends:groups >= 0.5.3 && < 0.6 27 | common dependency-monoid-subclasses 28 | build-depends:monoid-subclasses >= 1.2.3 && < 1.3 29 | common dependency-monoidmap-internal 30 | build-depends:monoidmap-internal >= 0.0.0.0 && < 0.1 31 | common dependency-nothunks 32 | build-depends:nothunks >= 0.1.3 && < 0.4 33 | 34 | common extensions 35 | default-extensions: 36 | BangPatterns 37 | ConstraintKinds 38 | DerivingStrategies 39 | DerivingVia 40 | FlexibleContexts 41 | FlexibleInstances 42 | GeneralizedNewtypeDeriving 43 | LambdaCase 44 | MultiParamTypeClasses 45 | NoImplicitPrelude 46 | NumericUnderscores 47 | ScopedTypeVariables 48 | TupleSections 49 | TypeApplications 50 | TypeFamilies 51 | TypeOperators 52 | ViewPatterns 53 | 54 | source-repository head 55 | type: git 56 | location: https://github.com/jonathanknowles/monoidmap 57 | 58 | library 59 | import: 60 | , dependency-base 61 | , dependency-containers 62 | , dependency-deepseq 63 | , dependency-groups 64 | , dependency-monoid-subclasses 65 | , dependency-monoidmap-internal 66 | , dependency-nothunks 67 | , extensions 68 | hs-source-dirs: 69 | components/monoidmap 70 | exposed-modules: 71 | Data.MonoidMap 72 | default-language: 73 | Haskell2010 74 | --------------------------------------------------------------------------------