├── .github └── workflows │ └── haskell-ci.yml ├── .gitignore ├── .stylish-haskell.yaml ├── CHANGELOG.md ├── CONTRIBUTING.md ├── LICENSE ├── Makefile ├── README.md ├── Setup.hs ├── cabal.haskell-ci ├── cabal.project ├── insert-ordered-containers.cabal ├── src └── Data │ ├── HashMap │ ├── InsOrd │ │ └── Internal.hs │ └── Strict │ │ └── InsOrd.hs │ └── HashSet │ └── InsOrd.hs └── test └── Tests.hs /.github/workflows/haskell-ci.yml: -------------------------------------------------------------------------------- 1 | # This GitHub workflow config has been generated by a script via 2 | # 3 | # haskell-ci 'github' 'cabal.project' 4 | # 5 | # To regenerate the script (for example after adjusting tested-with) run 6 | # 7 | # haskell-ci regenerate 8 | # 9 | # For more information, see https://github.com/haskell-CI/haskell-ci 10 | # 11 | # version: 0.19.20240702 12 | # 13 | # REGENDATA ("0.19.20240702",["github","cabal.project"]) 14 | # 15 | name: Haskell-CI 16 | on: 17 | push: 18 | branches: 19 | - master 20 | pull_request: 21 | branches: 22 | - master 23 | jobs: 24 | linux: 25 | name: Haskell-CI - Linux - ${{ matrix.compiler }} 26 | runs-on: ubuntu-20.04 27 | timeout-minutes: 28 | 60 29 | container: 30 | image: buildpack-deps:jammy 31 | continue-on-error: ${{ matrix.allow-failure }} 32 | strategy: 33 | matrix: 34 | include: 35 | - compiler: ghc-9.10.1 36 | compilerKind: ghc 37 | compilerVersion: 9.10.1 38 | setup-method: ghcup 39 | allow-failure: false 40 | - compiler: ghc-9.8.2 41 | compilerKind: ghc 42 | compilerVersion: 9.8.2 43 | setup-method: ghcup 44 | allow-failure: false 45 | - compiler: ghc-9.6.6 46 | compilerKind: ghc 47 | compilerVersion: 9.6.6 48 | setup-method: ghcup 49 | allow-failure: false 50 | - compiler: ghc-9.4.8 51 | compilerKind: ghc 52 | compilerVersion: 9.4.8 53 | setup-method: ghcup 54 | allow-failure: false 55 | - compiler: ghc-9.2.8 56 | compilerKind: ghc 57 | compilerVersion: 9.2.8 58 | setup-method: ghcup 59 | allow-failure: false 60 | - compiler: ghc-9.0.2 61 | compilerKind: ghc 62 | compilerVersion: 9.0.2 63 | setup-method: ghcup 64 | allow-failure: false 65 | - compiler: ghc-8.10.7 66 | compilerKind: ghc 67 | compilerVersion: 8.10.7 68 | setup-method: ghcup 69 | allow-failure: false 70 | - compiler: ghc-8.8.4 71 | compilerKind: ghc 72 | compilerVersion: 8.8.4 73 | setup-method: ghcup 74 | allow-failure: false 75 | - compiler: ghc-8.6.5 76 | compilerKind: ghc 77 | compilerVersion: 8.6.5 78 | setup-method: ghcup 79 | allow-failure: false 80 | fail-fast: false 81 | steps: 82 | - name: apt 83 | run: | 84 | apt-get update 85 | apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 86 | mkdir -p "$HOME/.ghcup/bin" 87 | curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup" 88 | chmod a+x "$HOME/.ghcup/bin/ghcup" 89 | "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) 90 | "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) 91 | env: 92 | HCKIND: ${{ matrix.compilerKind }} 93 | HCNAME: ${{ matrix.compiler }} 94 | HCVER: ${{ matrix.compilerVersion }} 95 | - name: Set PATH and environment variables 96 | run: | 97 | echo "$HOME/.cabal/bin" >> $GITHUB_PATH 98 | echo "LANG=C.UTF-8" >> "$GITHUB_ENV" 99 | echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" 100 | echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" 101 | HCDIR=/opt/$HCKIND/$HCVER 102 | HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") 103 | HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') 104 | HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') 105 | echo "HC=$HC" >> "$GITHUB_ENV" 106 | echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" 107 | echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" 108 | echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" 109 | HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') 110 | echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" 111 | echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" 112 | echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" 113 | echo "HEADHACKAGE=false" >> "$GITHUB_ENV" 114 | echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" 115 | echo "GHCJSARITH=0" >> "$GITHUB_ENV" 116 | env: 117 | HCKIND: ${{ matrix.compilerKind }} 118 | HCNAME: ${{ matrix.compiler }} 119 | HCVER: ${{ matrix.compilerVersion }} 120 | - name: env 121 | run: | 122 | env 123 | - name: write cabal config 124 | run: | 125 | mkdir -p $CABAL_DIR 126 | cat >> $CABAL_CONFIG <> $CABAL_CONFIG < cabal-plan.xz 159 | echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c - 160 | xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan 161 | rm -f cabal-plan.xz 162 | chmod a+x $HOME/.cabal/bin/cabal-plan 163 | cabal-plan --version 164 | - name: checkout 165 | uses: actions/checkout@v4 166 | with: 167 | path: source 168 | - name: initial cabal.project for sdist 169 | run: | 170 | touch cabal.project 171 | echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project 172 | cat cabal.project 173 | - name: sdist 174 | run: | 175 | mkdir -p sdist 176 | $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist 177 | - name: unpack 178 | run: | 179 | mkdir -p unpacked 180 | find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \; 181 | - name: generate cabal.project 182 | run: | 183 | PKGDIR_insert_ordered_containers="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/insert-ordered-containers-[0-9.]*')" 184 | echo "PKGDIR_insert_ordered_containers=${PKGDIR_insert_ordered_containers}" >> "$GITHUB_ENV" 185 | rm -f cabal.project cabal.project.local 186 | touch cabal.project 187 | touch cabal.project.local 188 | echo "packages: ${PKGDIR_insert_ordered_containers}" >> cabal.project 189 | echo "package insert-ordered-containers" >> cabal.project 190 | echo " ghc-options: -Werror=missing-methods" >> cabal.project 191 | cat >> cabal.project <> cabal.project.local 194 | cat cabal.project 195 | cat cabal.project.local 196 | - name: dump install plan 197 | run: | 198 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all 199 | cabal-plan 200 | - name: restore cache 201 | uses: actions/cache/restore@v4 202 | with: 203 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 204 | path: ~/.cabal/store 205 | restore-keys: ${{ runner.os }}-${{ matrix.compiler }}- 206 | - name: install dependencies 207 | run: | 208 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all 209 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all 210 | - name: build w/o tests 211 | run: | 212 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 213 | - name: build 214 | run: | 215 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always 216 | - name: tests 217 | run: | 218 | $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct 219 | - name: cabal check 220 | run: | 221 | cd ${PKGDIR_insert_ordered_containers} || false 222 | ${CABAL} -vnormal check 223 | - name: haddock 224 | run: | 225 | $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all 226 | - name: unconstrained build 227 | run: | 228 | rm -f cabal.project.local 229 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 230 | - name: save cache 231 | uses: actions/cache/save@v4 232 | if: always() 233 | with: 234 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 235 | path: ~/.cabal/store 236 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | cabal.sandbox.config 2 | .cabal-sandbox/ 3 | dist/ 4 | dist-newstyle/ 5 | .stack-work/ 6 | -------------------------------------------------------------------------------- /.stylish-haskell.yaml: -------------------------------------------------------------------------------- 1 | steps: 2 | - imports: 3 | align: group 4 | list_align: after_alias 5 | long_list_align: new_line 6 | empty_list_align: right_after 7 | list_padding: module_name 8 | - language_pragmas: 9 | style: vertical 10 | remove_redundant: true 11 | - trailing_whitespace: {} 12 | columns: 80 13 | language_extensions: 14 | - DataKinds 15 | - EmptyCase 16 | - ExplicitForAll 17 | - FlexibleContexts 18 | - MultiParamTypeClasses 19 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | - 0.2.6 2 | - Support GHC-8.6.5...9.10.1 3 | 4 | - 0.2.5.3 5 | - Support `aeson-2.2` 6 | - Make `Prelude` import explicit (safe guard against additions to `Prelude`). 7 | 8 | - 0.2.5.2 9 | - Actually drop `semigroups` dependency 10 | - Update bounds 11 | 12 | - 0.2.5.1 13 | - Drop unnecessary dependencies `semigroups`, `base-compat` 14 | - Update bounds 15 | 16 | - 0.2.5 17 | - Add `NFData(/1/2)` instances 18 | 19 | - 0.2.4 20 | - Add `indexed-traversable` instances 21 | - lens-5 and optics-0.4 support 22 | 23 | - 0.2.3 24 | - Add support for indexed `optics` 25 | - Only support GHC-8.0+ 26 | 27 | - 0.2.2 28 | - Add `Data.HashSet.InsOrd` 29 | 30 | - 0.2.1.0 31 | - Fix `Traversable`, `TraversableWithIndex`, `FoldableWithIndex` to traverse 32 | in insertion order 33 | ([#12](https://github.com/phadej/insert-ordered-containers/issues/12)) 34 | - Add `unorderedTraverse`, `unorderedTraverseWithKey`, `unoderedFoldMap`, and 35 | `unorderedFoldMapWithKey`. 36 | - `union` doesn't overflow the internal counter 37 | ([#10](https://github.com/phadej/insert-ordered-containers/issues/10)) 38 | 39 | - 0.2.0.0 40 | - Use `aeson-1` 41 | - removed our `FromJSONKey` and `ToJSONKey` in favour of `aeson` variants 42 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | Patches welcome! 2 | 3 | - If you are only going to bump bounds: 4 | - If it's really **only bounds**, please simply open an issue (so you'll have a URL to refer to). I have a semi-automated process to make revisions, pull requests only disturb it. 5 | - If patch includes **source code change** (i.e. I'll need to make a release), and it's a patch to support **newer base/GHC version**: 6 | - Amend `tested-with` to include that GHC 7 | - Regenerate `.github/workflows/haskell-ci.yml` with `haskell-ci regenerate` (get the latest from [GitHub haskell-ci/haskell-ci](https://github.com/haskell-ci/haskell-ci)) 8 | 9 | - Don't edit `CHANGELOG.md`, rather include a copyable entry in your pull request description. I often process pull requests in bulk, and everyone editing the `CHANGELOG.md` causes unnecessary conflicts. 10 | - For the same reason, do not edit `version` or `x-revision` 11 | 12 | - I use [`stylish-haskell`](https://github.com/jaspervdj/stylish-haskell) to format imports. I encourage you to use it too, when contributing. 13 | - General code style is 4 spaces, just look around how it looks, it's not so strict. 14 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015, Oleg Grenrus 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Oleg Grenrus nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | ghcid : 2 | ghcid -c 'cabal new-repl' 3 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # insert-ordered-containers 2 | 3 | Associative containers retaining insertion order for traversals. 4 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /cabal.haskell-ci: -------------------------------------------------------------------------------- 1 | branches: master 2 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: . 2 | -------------------------------------------------------------------------------- /insert-ordered-containers.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: insert-ordered-containers 3 | version: 0.2.6 4 | synopsis: 5 | Associative containers retaining insertion order for traversals. 6 | 7 | description: 8 | Associative containers retaining insertion order for traversals. 9 | . 10 | The implementation is based on `unordered-containers`. 11 | 12 | category: Web 13 | homepage: https://github.com/phadej/insert-ordered-containers#readme 14 | bug-reports: https://github.com/phadej/insert-ordered-containers/issues 15 | author: Oleg Grenrus 16 | maintainer: Oleg Grenrus 17 | license: BSD-3-Clause 18 | license-file: LICENSE 19 | build-type: Simple 20 | tested-with: 21 | GHC ==8.6.5 22 | || ==8.8.4 23 | || ==8.10.7 24 | || ==9.0.2 25 | || ==9.2.8 26 | || ==9.4.8 27 | || ==9.6.6 28 | || ==9.8.2 29 | || ==9.10.1 30 | 31 | extra-source-files: 32 | CHANGELOG.md 33 | README.md 34 | 35 | source-repository head 36 | type: git 37 | location: https://github.com/phadej/insert-ordered-containers 38 | 39 | library 40 | default-language: Haskell2010 41 | hs-source-dirs: src 42 | ghc-options: -Wall 43 | build-depends: 44 | , aeson >=2.2.3.0 && <2.3 45 | , base >=4.12.0.0 && <4.21 46 | , deepseq >=1.4.4.0 && <1.6 47 | , hashable >=1.4.7.0 && <1.5 48 | , indexed-traversable >=0.1.4 && <0.2 49 | , lens >=5.2.3 && <5.4 50 | , optics-core >=0.4.1.1 && <0.5 51 | , optics-extra >=0.4.2.1 && <0.5 52 | , semigroupoids >=6.0.1 && <6.1 53 | , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2 54 | , transformers >=0.5.6.2 && <0.7 55 | , unordered-containers >=0.2.20 && <0.3 56 | 57 | exposed-modules: 58 | Data.HashMap.Strict.InsOrd 59 | Data.HashSet.InsOrd 60 | 61 | other-modules: Data.HashMap.InsOrd.Internal 62 | 63 | test-suite ins-ord-containers-tests 64 | default-language: Haskell2010 65 | type: exitcode-stdio-1.0 66 | main-is: Tests.hs 67 | hs-source-dirs: test 68 | ghc-options: -Wall 69 | 70 | -- inherited from library 71 | build-depends: 72 | , aeson 73 | , base 74 | , base-compat 75 | , hashable 76 | , insert-ordered-containers 77 | , lens 78 | , QuickCheck >=2.13.2 && <2.16 79 | , semigroupoids 80 | , tasty >=0.10.1.2 && <1.6 81 | , tasty-quickcheck >=0.8.3.2 && <0.12 82 | , text 83 | , unordered-containers 84 | -------------------------------------------------------------------------------- /src/Data/HashMap/InsOrd/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | module Data.HashMap.InsOrd.Internal where 3 | 4 | import Prelude hiding (filter, foldr, lookup, map, null) 5 | 6 | import Control.Applicative ((<**>)) 7 | 8 | ------------------------------------------------------------------------------- 9 | -- SortedAp 10 | ------------------------------------------------------------------------------- 11 | 12 | -- Sort using insertion sort 13 | -- Hopefully it's fast enough for where we need it 14 | -- otherwise: https://gist.github.com/treeowl/9621f58d55fe0c4f9162be0e074b1b29 15 | -- http://elvishjerricco.github.io/2017/03/23/applicative-sorting.html also related 16 | 17 | -- Free applicative which re-orders effects 18 | -- Mostly from Edward Kmett's `free` package. 19 | data SortedAp f a where 20 | Pure :: a -> SortedAp f a 21 | SortedAp :: !Int -> f a -> SortedAp f (a -> b) -> SortedAp f b 22 | 23 | instance Functor (SortedAp f) where 24 | fmap f (Pure a) = Pure (f a) 25 | fmap f (SortedAp i x y) = SortedAp i x ((f .) <$> y) 26 | 27 | instance Applicative (SortedAp f) where 28 | pure = Pure 29 | Pure f <*> y = fmap f y 30 | -- This is different from real Ap 31 | f <*> Pure y = fmap ($ y) f 32 | f@(SortedAp i x y) <*> z@(SortedAp j u v) 33 | | i < j = SortedAp i x (flip <$> y <*> z) 34 | | otherwise = SortedAp j u ((.) <$> f <*> v) 35 | 36 | liftSortedAp :: Int -> f a -> SortedAp f a 37 | liftSortedAp i x = SortedAp i x (Pure id) 38 | 39 | retractSortedAp :: Applicative f => SortedAp f a -> f a 40 | retractSortedAp (Pure x) = pure x 41 | retractSortedAp (SortedAp _ f x) = f <**> retractSortedAp x 42 | -------------------------------------------------------------------------------- /src/Data/HashMap/Strict/InsOrd.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE DeriveFoldable #-} 3 | {-# LANGUAGE DeriveFunctor #-} 4 | {-# LANGUAGE DeriveTraversable #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE GADTs #-} 7 | {-# LANGUAGE MultiParamTypeClasses #-} 8 | {-# LANGUAGE ScopedTypeVariables #-} 9 | {-# LANGUAGE Trustworthy #-} 10 | {-# LANGUAGE TypeFamilies #-} 11 | -- | 'InsOrdHashMap' is like 'HashMap', but it folds and traverses in insertion order. 12 | -- 13 | -- This module interface mimics "Data.HashMap.Strict", with some additions. 14 | module Data.HashMap.Strict.InsOrd ( 15 | InsOrdHashMap, 16 | -- * Construction 17 | empty, 18 | singleton, 19 | -- * Basic interface 20 | null, 21 | size, 22 | member, 23 | lookup, 24 | lookupDefault, 25 | insert, 26 | insertWith, 27 | delete, 28 | adjust, 29 | update, 30 | alter, 31 | -- * Combine 32 | union, 33 | unionWith, 34 | unionWithKey, 35 | unions, 36 | -- * Transformations 37 | map, 38 | mapKeys, 39 | traverseKeys, 40 | mapWithKey, 41 | traverseWithKey, 42 | -- ** Unordered 43 | unorderedTraverse, 44 | unorderedTraverseWithKey, 45 | -- * Difference and intersection 46 | difference, 47 | intersection, 48 | intersectionWith, 49 | intersectionWithKey, 50 | -- * Folds 51 | foldl', 52 | foldlWithKey', 53 | foldr, 54 | foldrWithKey, 55 | foldMapWithKey, 56 | -- ** Unordered 57 | unorderedFoldMap, 58 | unorderedFoldMapWithKey, 59 | -- * Filter 60 | filter, 61 | filterWithKey, 62 | mapMaybe, 63 | mapMaybeWithKey, 64 | -- * Conversions 65 | keys, 66 | elems, 67 | toList, 68 | toRevList, 69 | fromList, 70 | toHashMap, 71 | fromHashMap, 72 | -- * Lenses 73 | hashMap, 74 | unorderedTraversal, 75 | -- * Debugging 76 | valid, 77 | ) where 78 | 79 | import Prelude 80 | (Bool (..), Eq, Functor, Int, Maybe (..), all, const, flip, fmap, fst, 81 | id, maybe, otherwise, pure, return, snd, uncurry, ($), (&&), (+), (.), 82 | (<$>), (<), (==), (>), (>=), (>>=), (||)) 83 | 84 | import Control.Applicative (Applicative, Const (..)) 85 | import Control.Arrow (first, second) 86 | import Control.DeepSeq (NFData (..)) 87 | import Data.Data (Data, Typeable) 88 | import Data.Foldable (Foldable (foldMap)) 89 | import Data.Foldable.WithIndex (FoldableWithIndex (..)) 90 | import Data.Functor.Apply (Apply (..)) 91 | import Data.Functor.Bind (Bind (..)) 92 | import Data.Functor.WithIndex (FunctorWithIndex (..)) 93 | import Data.Hashable (Hashable (..)) 94 | import Data.List (nub, sortBy) 95 | import Data.Maybe (fromMaybe) 96 | import Data.Monoid (Monoid, mappend, mempty) 97 | import Data.Ord (comparing) 98 | import Data.Semigroup (Semigroup (..)) 99 | import Data.Traversable (Traversable (traverse)) 100 | import Data.Traversable.WithIndex (TraversableWithIndex (..)) 101 | import Text.ParserCombinators.ReadPrec (prec) 102 | import Text.Read 103 | (Lexeme (..), Read (..), lexP, parens, readListPrecDefault) 104 | import Text.Show (Show (..), showParen, showString) 105 | 106 | import Control.Lens 107 | (At (..), Index, Iso, IxValue, Ixed (..), Traversal, _1, _2, iso, (<&>)) 108 | import Control.Monad.Trans.State.Strict (State, runState, state) 109 | 110 | import qualified Control.Lens as Lens 111 | import qualified Data.Aeson as A 112 | import qualified Data.Aeson.Encoding as E 113 | import qualified Data.Foldable as F 114 | import qualified Optics.At as Optics 115 | import qualified Optics.Core as Optics 116 | 117 | import Data.HashMap.Strict (HashMap) 118 | import qualified Data.HashMap.Strict as HashMap 119 | 120 | import qualified GHC.Exts as Exts 121 | 122 | import qualified Control.DeepSeq as NF 123 | 124 | import Data.HashMap.InsOrd.Internal 125 | 126 | ------------------------------------------------------------------------------- 127 | -- Strict Pair Int a 128 | ------------------------------------------------------------------------------- 129 | 130 | data P a = P !Int !a 131 | deriving (Functor, Foldable, Traversable, Typeable, Data) 132 | 133 | instance NFData a => NFData (P a) where 134 | rnf (P _ a) = rnf a 135 | 136 | -- | @since 0.2.5 137 | instance NF.NFData1 P where 138 | liftRnf rnf1 (P _ a) = rnf1 a 139 | 140 | getPK :: P a -> Int 141 | getPK (P i _) = i 142 | {-# INLINABLE getPK #-} 143 | 144 | getPV :: P a -> a 145 | getPV (P _ a) = a 146 | {-# INLINABLE getPV #-} 147 | 148 | incPK :: Int -> P a -> P a 149 | incPK i (P j x) = P (i + j) x 150 | {-# INLINABLE incPK #-} 151 | 152 | instance Eq a => Eq (P a) where 153 | P _ a == P _ b = a == b 154 | 155 | instance Show a => Show (P a) where 156 | showsPrec d (P _ x) = showsPrec d x 157 | 158 | instance Hashable a => Hashable (P a) where 159 | hashWithSalt salt (P _ x) = hashWithSalt salt x 160 | 161 | ------------------------------------------------------------------------------- 162 | -- InsOrdHashMap 163 | ------------------------------------------------------------------------------- 164 | 165 | -- | 'HashMap' which tries its best to remember insertion order of elements. 166 | 167 | data InsOrdHashMap k v = InsOrdHashMap 168 | { _getIndex :: !Int 169 | , getInsOrdHashMap :: !(HashMap k (P v)) 170 | } 171 | deriving (Functor, Typeable, Data) 172 | 173 | -- | @since 0.2.5 174 | instance (NFData k, NFData v) => NFData (InsOrdHashMap k v) where 175 | rnf (InsOrdHashMap _ hm) = rnf hm 176 | 177 | -- | @since 0.2.5 178 | instance NFData k => NF.NFData1 (InsOrdHashMap k) where 179 | liftRnf rnf2 = NF.liftRnf2 rnf rnf2 180 | 181 | -- | @since 0.2.5 182 | instance NF.NFData2 InsOrdHashMap where 183 | liftRnf2 rnf1 rnf2 (InsOrdHashMap _ m) = NF.liftRnf2 rnf1 (NF.liftRnf rnf2) m 184 | 185 | instance (Eq k, Eq v) => Eq (InsOrdHashMap k v) where 186 | InsOrdHashMap _ a == InsOrdHashMap _ b = a == b 187 | 188 | instance (Show k, Show v) => Show (InsOrdHashMap k v) where 189 | showsPrec d m = showParen (d > 10) $ 190 | showString "fromList " . showsPrec 11 (toList m) 191 | 192 | instance (Eq k, Hashable k, Read k, Read v) => Read (InsOrdHashMap k v) where 193 | readPrec = parens $ prec 10 $ do 194 | Ident "fromList" <- lexP 195 | xs <- readPrec 196 | return (fromList xs) 197 | 198 | readListPrec = readListPrecDefault 199 | 200 | instance (Eq k, Hashable k) => Semigroup (InsOrdHashMap k v) where 201 | (<>) = union 202 | 203 | instance (Eq k, Hashable k) => Monoid (InsOrdHashMap k v) where 204 | mempty = empty 205 | mappend = union 206 | 207 | -- We cannot derive this, as we want to ordered folding and traversing 208 | instance Foldable (InsOrdHashMap k) where 209 | -- in newer base only 210 | -- length = length . getInsOrdHashMap 211 | foldMap f = foldMap (f . snd) . toList 212 | 213 | null = null 214 | toList = elems 215 | length = size 216 | 217 | instance Traversable (InsOrdHashMap k) where 218 | traverse f m = traverseWithKey (\_ -> f) m 219 | 220 | instance (Eq k, Hashable k) => Apply (InsOrdHashMap k) where 221 | (<.>) = intersectionWith id 222 | (<. ) = intersectionWith const 223 | ( .>) = intersectionWith (const id) 224 | 225 | instance (Eq k, Hashable k) => Bind (InsOrdHashMap k) where 226 | m >>- f = mapMaybeWithKey (\k -> lookup k . f) m 227 | 228 | -- | @hashWithSalt salt . toHashMap = hashWithSalt salt@. 229 | instance (Hashable k, Hashable v) => Hashable (InsOrdHashMap k v) where 230 | hashWithSalt salt (InsOrdHashMap _ m) = 231 | hashWithSalt salt m 232 | 233 | instance (Eq k, Hashable k) => Exts.IsList (InsOrdHashMap k v) where 234 | type Item (InsOrdHashMap k v) = (k, v) 235 | fromList = fromList 236 | toList = toList 237 | 238 | ------------------------------------------------------------------------------- 239 | -- Aeson 240 | ------------------------------------------------------------------------------- 241 | 242 | instance (A.ToJSONKey k) => A.ToJSON1 (InsOrdHashMap k) where 243 | liftToJSON _ t _ = case A.toJSONKey :: A.ToJSONKeyFunction k of 244 | A.ToJSONKeyText f _ -> A.object . fmap (\(k, v) -> (f k, t v)) . toList 245 | A.ToJSONKeyValue f _ -> A.toJSON . fmap (\(k,v) -> A.toJSON (f k, t v)) . toList 246 | 247 | liftToEncoding o t _ = case A.toJSONKey :: A.ToJSONKeyFunction k of 248 | A.ToJSONKeyText _ f -> E.dict f t foldrWithKey 249 | A.ToJSONKeyValue _ f -> E.list (A.liftToEncoding2 (const False) f (E.list f) o t (E.list t)) . toList 250 | 251 | instance (A.ToJSONKey k, A.ToJSON v) => A.ToJSON (InsOrdHashMap k v) where 252 | toJSON = A.toJSON1 253 | toEncoding = A.toEncoding1 254 | 255 | ------------------------------------------------------------------------------- 256 | 257 | instance (Eq k, Hashable k, A.FromJSONKey k) => A.FromJSON1 (InsOrdHashMap k) where 258 | liftParseJSON o p pl v = fromList . HashMap.toList <$> A.liftParseJSON o p pl v 259 | 260 | instance (Eq k, Hashable k, A.FromJSONKey k, A.FromJSON v) => A.FromJSON (InsOrdHashMap k v) where 261 | parseJSON = A.parseJSON1 262 | 263 | ------------------------------------------------------------------------------- 264 | -- indexed-traversals 265 | ------------------------------------------------------------------------------- 266 | 267 | instance (Eq k, Hashable k) => FunctorWithIndex k (InsOrdHashMap k) where 268 | imap = mapWithKey 269 | instance (Eq k, Hashable k) => FoldableWithIndex k (InsOrdHashMap k) where 270 | ifoldMap = foldMapWithKey 271 | ifoldr = foldrWithKey 272 | instance (Eq k, Hashable k) => TraversableWithIndex k (InsOrdHashMap k) where 273 | itraverse = traverseWithKey 274 | 275 | ------------------------------------------------------------------------------- 276 | -- Lens 277 | ------------------------------------------------------------------------------- 278 | 279 | type instance Index (InsOrdHashMap k v) = k 280 | type instance IxValue (InsOrdHashMap k v) = v 281 | 282 | instance (Eq k, Hashable k) => Ixed (InsOrdHashMap k v) where 283 | ix k f m = ixImpl k pure f m 284 | {-# INLINABLE ix #-} 285 | 286 | ixImpl 287 | :: (Eq k, Hashable k, Functor f) 288 | => k 289 | -> (InsOrdHashMap k v -> f (InsOrdHashMap k v)) 290 | -> (v -> f v) 291 | -> InsOrdHashMap k v 292 | -> f (InsOrdHashMap k v) 293 | ixImpl k point f m = case lookup k m of 294 | Just v -> f v <&> \v' -> insert k v' m 295 | Nothing -> point m 296 | {-# INLINE ixImpl #-} 297 | 298 | instance (Eq k, Hashable k) => At (InsOrdHashMap k a) where 299 | at k f m = f mv <&> \r -> case r of 300 | Nothing -> maybe m (const (delete k m)) mv 301 | Just v' -> insert k v' m 302 | where mv = lookup k m 303 | {-# INLINABLE at #-} 304 | 305 | -- | This is a slight lie, as roundtrip doesn't preserve ordering. 306 | hashMap :: Iso (InsOrdHashMap k a) (InsOrdHashMap k b) (HashMap k a) (HashMap k b) 307 | hashMap = iso toHashMap fromHashMap 308 | 309 | unorderedTraversal :: Traversal (InsOrdHashMap k a) (InsOrdHashMap k b) a b 310 | unorderedTraversal = hashMap . traverse 311 | 312 | ------------------------------------------------------------------------------- 313 | -- Optics 314 | ------------------------------------------------------------------------------- 315 | 316 | type instance Optics.Index (InsOrdHashMap k v) = k 317 | type instance Optics.IxValue (InsOrdHashMap k v) = v 318 | 319 | instance (Eq k, Hashable k) => Optics.Ixed (InsOrdHashMap k v) where 320 | ix k = Optics.atraversalVL $ \point f m -> ixImpl k point f m 321 | {-# INLINE ix #-} 322 | 323 | instance (Eq k, Hashable k) => Optics.At (InsOrdHashMap k a) where 324 | at k = Optics.lensVL $ \f m -> Lens.at k f m 325 | {-# INLINE at #-} 326 | 327 | ------------------------------------------------------------------------------- 328 | -- Construction 329 | ------------------------------------------------------------------------------- 330 | 331 | empty :: InsOrdHashMap k v 332 | empty = InsOrdHashMap 0 HashMap.empty 333 | {-# INLINABLE empty #-} 334 | 335 | singleton :: Hashable k => k -> v -> InsOrdHashMap k v 336 | singleton k v = InsOrdHashMap 1 (HashMap.singleton k (P 0 v)) 337 | {-# INLINABLE singleton #-} 338 | 339 | ------------------------------------------------------------------------------- 340 | -- Basic interface 341 | ------------------------------------------------------------------------------- 342 | 343 | null :: InsOrdHashMap k v -> Bool 344 | null = HashMap.null . getInsOrdHashMap 345 | {-# INLINABLE null #-} 346 | 347 | size :: InsOrdHashMap k v -> Int 348 | size = HashMap.size . getInsOrdHashMap 349 | {-# INLINABLE size #-} 350 | 351 | member :: (Eq k, Hashable k) => k -> InsOrdHashMap k a -> Bool 352 | member k = HashMap.member k . getInsOrdHashMap 353 | {-# INLINABLE member #-} 354 | 355 | lookup :: (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v 356 | lookup k = fmap getPV . HashMap.lookup k . getInsOrdHashMap 357 | {-# INLINABLE lookup #-} 358 | 359 | lookupDefault 360 | :: (Eq k, Hashable k) 361 | => v -- ^ Default value to return. 362 | -> k -> InsOrdHashMap k v -> v 363 | lookupDefault def k m = fromMaybe def $ lookup k m 364 | {-# INLINABLE lookupDefault #-} 365 | 366 | delete :: (Eq k, Hashable k) => k -> InsOrdHashMap k v -> InsOrdHashMap k v 367 | delete k (InsOrdHashMap i m) = InsOrdHashMap i $ HashMap.delete k m 368 | {-# INLINABLE delete #-} 369 | 370 | insert :: (Eq k, Hashable k) => k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v 371 | insert = insertWith const 372 | {-# INLINABLE insert #-} 373 | 374 | insertWith 375 | :: (Eq k, Hashable k) 376 | => (v -> v -> v) -> k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v 377 | insertWith f k v = alter (Just . maybe v (f v)) k 378 | {-# INLINABLE insertWith #-} 379 | 380 | adjust 381 | :: (Eq k, Hashable k) 382 | => (v -> v) -> k -> InsOrdHashMap k v -> InsOrdHashMap k v 383 | adjust f = alter (fmap f) 384 | {-# INLINABLE adjust #-} 385 | 386 | update 387 | :: (Eq k, Hashable k) 388 | => (a -> Maybe a) -> k -> InsOrdHashMap k a -> InsOrdHashMap k a 389 | update f = alter (>>= f) 390 | {-# INLINABLE update #-} 391 | 392 | alter 393 | :: (Eq k, Hashable k) 394 | => (Maybe v -> Maybe v) -> k -> InsOrdHashMap k v -> InsOrdHashMap k v 395 | alter f k insm@(InsOrdHashMap j m) = 396 | case HashMap.lookup k m of 397 | Nothing -> case f Nothing of 398 | Nothing -> insm 399 | Just v -> InsOrdHashMap (j + 1) (HashMap.insert k (P j v) m) 400 | Just (P i v) -> case f (Just v) of 401 | Nothing -> InsOrdHashMap j (HashMap.delete k m) 402 | Just u -> InsOrdHashMap j (HashMap.insert k (P i u) m) 403 | {-# INLINABLE alter #-} 404 | 405 | ------------------------------------------------------------------------------- 406 | -- Combine 407 | ------------------------------------------------------------------------------- 408 | 409 | -- | The union of two maps. If a key occurs in both maps, 410 | -- the provided function (first argument) will be used to compute the result. 411 | -- 412 | -- Ordered traversal will go thru keys in the first map first. 413 | unionWith 414 | :: (Eq k, Hashable k) 415 | => (v -> v -> v) 416 | -> InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v 417 | unionWith f (InsOrdHashMap i a) (InsOrdHashMap j b) = 418 | mk $ HashMap.unionWith f' a b' 419 | where 420 | -- the threshold is arbitrary, it meant to amortise need for packing of indices 421 | mk | i > 0xfffff || j >= 0xfffff = fromHashMapP 422 | | otherwise = InsOrdHashMap (i + j) 423 | b' = fmap (incPK i) b 424 | f' (P ii x) (P _ y) = P ii (f x y) 425 | 426 | unionWithKey 427 | :: (Eq k, Hashable k) 428 | => (k -> v -> v -> v) 429 | -> InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v 430 | unionWithKey f (InsOrdHashMap i a) (InsOrdHashMap j b) = 431 | InsOrdHashMap (i + j) $ HashMap.unionWithKey f' a b' 432 | where 433 | b' = fmap (incPK i) b 434 | f' k (P ii x) (P _ y) = P ii (f k x y) 435 | 436 | union 437 | :: (Eq k, Hashable k) 438 | => InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v 439 | union = unionWith const 440 | 441 | unions 442 | :: (Eq k, Hashable k, Foldable f) 443 | => f (InsOrdHashMap k v) -> InsOrdHashMap k v 444 | unions = F.foldl' union empty 445 | 446 | ------------------------------------------------------------------------------- 447 | -- Transformations 448 | ------------------------------------------------------------------------------- 449 | 450 | -- | Order preserving mapping of keys. 451 | mapKeys :: (Eq k', Hashable k') => (k -> k') -> InsOrdHashMap k v -> InsOrdHashMap k' v 452 | mapKeys f (InsOrdHashMap i m) = InsOrdHashMap i $ 453 | HashMap.fromList . fmap (first f) . HashMap.toList $ m 454 | 455 | traverseKeys 456 | :: (Eq k', Hashable k', Applicative f) 457 | => (k -> f k') -> InsOrdHashMap k v -> f (InsOrdHashMap k' v) 458 | traverseKeys f (InsOrdHashMap i m) = InsOrdHashMap i . HashMap.fromList <$> 459 | (traverse . _1) f (HashMap.toList m) 460 | 461 | map :: (v1 -> v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2 462 | map = fmap 463 | 464 | mapWithKey :: (k -> v1 -> v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2 465 | mapWithKey f (InsOrdHashMap i m) = 466 | InsOrdHashMap i $ HashMap.mapWithKey f' m 467 | where 468 | f' k (P j x) = P j (f k x) 469 | 470 | foldMapWithKey :: Monoid m => (k -> a -> m) -> InsOrdHashMap k a -> m 471 | foldMapWithKey f = foldMap (uncurry f) . toList 472 | 473 | traverseWithKey :: Applicative f => (k -> a -> f b) -> InsOrdHashMap k a -> f (InsOrdHashMap k b) 474 | traverseWithKey f (InsOrdHashMap n m) = InsOrdHashMap n <$> retractSortedAp 475 | (HashMap.traverseWithKey (\k (P i v) -> liftSortedAp i (P i <$> f k v)) m) 476 | 477 | ------------------------------------------------------------------------------- 478 | -- Unordered 479 | ------------------------------------------------------------------------------- 480 | 481 | -- | More efficient than 'foldMap', when folding in insertion order is not important. 482 | unorderedFoldMap :: Monoid m => (a -> m) -> InsOrdHashMap k a -> m 483 | unorderedFoldMap f (InsOrdHashMap _ m) = foldMap (f . getPV) m 484 | 485 | -- | More efficient than 'foldMapWithKey', when folding in insertion order is not important. 486 | unorderedFoldMapWithKey :: Monoid m => (k -> a -> m) -> InsOrdHashMap k a -> m 487 | unorderedFoldMapWithKey f m = 488 | getConst (unorderedTraverseWithKey (\k a -> Const (f k a)) m) 489 | 490 | -- | More efficient than 'traverse', when traversing in insertion order is not important. 491 | unorderedTraverse :: Applicative f => (a -> f b) -> InsOrdHashMap k a -> f (InsOrdHashMap k b) 492 | unorderedTraverse f (InsOrdHashMap i m) = 493 | InsOrdHashMap i <$> (traverse . traverse) f m 494 | 495 | -- | More efficient than `traverseWithKey`, when traversing in insertion order is not important. 496 | unorderedTraverseWithKey :: Applicative f => (k -> a -> f b) -> InsOrdHashMap k a -> f (InsOrdHashMap k b) 497 | unorderedTraverseWithKey f (InsOrdHashMap i m) = 498 | InsOrdHashMap i <$> HashMap.traverseWithKey f' m 499 | where 500 | f' k (P j x) = P j <$> f k x 501 | 502 | ------------------------------------------------------------------------------- 503 | -- Difference and intersection 504 | ------------------------------------------------------------------------------- 505 | 506 | difference 507 | :: (Eq k, Hashable k) 508 | => InsOrdHashMap k v -> InsOrdHashMap k w -> InsOrdHashMap k v 509 | difference (InsOrdHashMap i a) (InsOrdHashMap _ b) = 510 | InsOrdHashMap i $ HashMap.difference a b 511 | 512 | intersection 513 | :: (Eq k, Hashable k) 514 | => InsOrdHashMap k v -> InsOrdHashMap k w -> InsOrdHashMap k v 515 | intersection = intersectionWith const 516 | 517 | intersectionWith 518 | :: (Eq k, Hashable k) 519 | => (v1 -> v2 -> v3) 520 | -> InsOrdHashMap k v1 -> InsOrdHashMap k v2 -> InsOrdHashMap k v3 521 | intersectionWith f = intersectionWithKey (\_ -> f) 522 | 523 | intersectionWithKey 524 | :: (Eq k, Hashable k) 525 | => (k -> v1 -> v2 -> v3) 526 | -> InsOrdHashMap k v1 -> InsOrdHashMap k v2 -> InsOrdHashMap k v3 527 | intersectionWithKey f (InsOrdHashMap i a) (InsOrdHashMap _ b) = 528 | InsOrdHashMap i $ HashMap.intersectionWithKey f' a b 529 | where 530 | f' k (P j x) (P _ y) = P j (f k x y) 531 | 532 | ------------------------------------------------------------------------------- 533 | -- Folds 534 | ------------------------------------------------------------------------------- 535 | 536 | foldl' :: (a -> v -> a) -> a -> InsOrdHashMap k v -> a 537 | foldl' f x = F.foldl' f' x . toList 538 | where 539 | f' a (_, v) = f a v 540 | 541 | foldlWithKey' :: (a -> k -> v -> a) -> a -> InsOrdHashMap k v -> a 542 | foldlWithKey' f x = F.foldl' f' x . toList 543 | where 544 | f' a (k, v) = f a k v 545 | 546 | foldr :: (v -> a -> a) -> a -> InsOrdHashMap k v -> a 547 | foldr f x = F.foldr f' x . toList 548 | where 549 | f' (_, v) a = f v a 550 | 551 | foldrWithKey :: (k -> v -> a -> a) -> a -> InsOrdHashMap k v -> a 552 | foldrWithKey f x = F.foldr f' x . toList 553 | where 554 | f' (k, v) a = f k v a 555 | 556 | ------------------------------------------------------------------------------- 557 | -- Filter 558 | ------------------------------------------------------------------------------- 559 | 560 | filter :: (v -> Bool) -> InsOrdHashMap k v -> InsOrdHashMap k v 561 | filter f (InsOrdHashMap i m) = 562 | InsOrdHashMap i $ HashMap.filter (f . getPV) m 563 | 564 | filterWithKey :: (k -> v -> Bool) -> InsOrdHashMap k v -> InsOrdHashMap k v 565 | filterWithKey f (InsOrdHashMap i m) = 566 | InsOrdHashMap i $ HashMap.filterWithKey f' m 567 | where 568 | f' k (P _ x) = f k x 569 | 570 | mapMaybe :: (v1 -> Maybe v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2 571 | mapMaybe f (InsOrdHashMap i m) = InsOrdHashMap i $ HashMap.mapMaybe f' m 572 | where 573 | f' (P j x) = P j <$> f x 574 | 575 | mapMaybeWithKey :: (k -> v1 -> Maybe v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2 576 | mapMaybeWithKey f (InsOrdHashMap i m) = 577 | InsOrdHashMap i $ HashMap.mapMaybeWithKey f' m 578 | where 579 | f' k (P j x) = P j <$> f k x 580 | 581 | ------------------------------------------------------------------------------- 582 | -- Conversions 583 | ------------------------------------------------------------------------------- 584 | 585 | keys :: InsOrdHashMap k v -> [k] 586 | keys = fmap fst . toList 587 | {-# INLINABLE keys #-} 588 | 589 | elems :: InsOrdHashMap k v -> [v] 590 | elems = fmap snd . toList 591 | {-# INLINABLE elems #-} 592 | 593 | fromList :: forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v 594 | fromList 595 | = mk 596 | . flip runState 0 597 | . (traverse . _2) newP 598 | where 599 | mk :: ([(k, P v)], Int) -> InsOrdHashMap k v 600 | mk (m, i) = InsOrdHashMap i (HashMap.fromList m) 601 | 602 | toList :: InsOrdHashMap k v -> [(k, v)] 603 | toList 604 | = fmap (second getPV) 605 | . sortBy (comparing (getPK . snd)) 606 | . HashMap.toList 607 | . getInsOrdHashMap 608 | 609 | toRevList :: InsOrdHashMap k v -> [(k, v)] 610 | toRevList 611 | = fmap (second getPV) 612 | . sortBy (flip $ comparing (getPK . snd)) 613 | . HashMap.toList 614 | . getInsOrdHashMap 615 | 616 | fromHashMap :: HashMap k v -> InsOrdHashMap k v 617 | fromHashMap = mk . flip runState 0 . traverse newP 618 | where 619 | mk (m, i) = InsOrdHashMap i m 620 | 621 | toHashMap :: InsOrdHashMap k v -> HashMap k v 622 | toHashMap (InsOrdHashMap _ m) = fmap getPV m 623 | 624 | ------------------------------------------------------------------------------- 625 | -- Internal 626 | ------------------------------------------------------------------------------- 627 | 628 | -- TODO: more efficient way is to do two traversals 629 | -- - collect the indexes 630 | -- - pack the indexes (Map old new) 631 | -- - traverse second time, changing the indexes 632 | fromHashMapP :: HashMap k (P v) -> InsOrdHashMap k v 633 | fromHashMapP = mk . flip runState 0 . retractSortedAp . traverse f 634 | where 635 | mk (m, i) = InsOrdHashMap i m 636 | f (P i v) = liftSortedAp i (newP v) 637 | 638 | -- | Test if the internal map structure is valid. 639 | valid :: InsOrdHashMap k v -> Bool 640 | valid (InsOrdHashMap i m) = indexesDistinct && indexesSmaller 641 | where 642 | indexes :: [Int] 643 | indexes = getPK <$> HashMap.elems m 644 | 645 | indexesDistinct = indexes == nub indexes 646 | indexesSmaller = all (< i) indexes 647 | 648 | newP :: a -> State Int (P a) 649 | newP x = state $ \s -> (P s x, s + 1) 650 | -------------------------------------------------------------------------------- /src/Data/HashSet/InsOrd.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE GADTs #-} 4 | {-# LANGUAGE MultiParamTypeClasses #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# LANGUAGE Trustworthy #-} 7 | {-# LANGUAGE TypeFamilies #-} 8 | -- | 'InsOrdHashSet' is like 'HashSet', but it folds in insertion order. 9 | -- 10 | -- This module interface mimics "Data.HashSet", with some additions. 11 | module Data.HashSet.InsOrd ( 12 | InsOrdHashSet, 13 | -- * Construction 14 | empty, 15 | singleton, 16 | -- * Basic interface 17 | null, 18 | size, 19 | member, 20 | insert, 21 | delete, 22 | -- * Combine 23 | union, 24 | -- * Transformations 25 | map, 26 | -- ** Unordered 27 | -- * Difference and intersection 28 | difference, 29 | intersection, 30 | -- * Folds 31 | -- ** Unordered 32 | -- * Filter 33 | filter, 34 | -- * Conversions 35 | toList, 36 | fromList, 37 | toHashSet, 38 | fromHashSet, 39 | -- * Lenses 40 | hashSet, 41 | -- * Debugging 42 | valid, 43 | )where 44 | 45 | import Prelude 46 | (Bool, Eq ((==)), Int, Maybe (..), const, flip, fmap, fst, 47 | maybe, otherwise, return, snd, ($), (&&), (+), (.), (<$), (<$>), (<), 48 | (>), (>=), (||)) 49 | 50 | import Control.Arrow (first) 51 | import Control.DeepSeq (NFData (..)) 52 | import Data.Data (Data, Typeable) 53 | import Data.Foldable (Foldable (foldMap), all) 54 | import Data.Hashable (Hashable (..)) 55 | import Data.List (nub, sortBy) 56 | import Data.Monoid (Monoid (..)) 57 | import Data.Ord (comparing) 58 | import Data.Semigroup (Semigroup (..)) 59 | import Data.Traversable (Traversable (traverse)) 60 | import Text.ParserCombinators.ReadPrec (prec) 61 | import Text.Read 62 | (Lexeme (..), Read (..), lexP, parens, readListPrecDefault) 63 | import Text.Show (Show (..), showParen, showString) 64 | 65 | import Control.Lens 66 | (At (..), Contains (..), Index, Iso', IxValue, Ixed (..), iso, (<&>)) 67 | import Control.Monad.Trans.State.Strict (State, runState, state) 68 | 69 | import qualified Data.Aeson as A 70 | import qualified Control.Lens as Lens 71 | import qualified Optics.At as Optics 72 | import qualified Optics.Core as Optics 73 | 74 | import Data.HashMap.Strict (HashMap) 75 | import qualified Data.HashMap.Strict as HashMap 76 | import Data.HashSet (HashSet) 77 | import qualified Data.HashSet as HashSet 78 | 79 | import qualified Data.Foldable 80 | import qualified GHC.Exts as Exts 81 | 82 | import qualified Control.DeepSeq as NF 83 | 84 | import Data.HashMap.InsOrd.Internal 85 | 86 | ------------------------------------------------------------------------------- 87 | -- InsOrdHashSet 88 | ------------------------------------------------------------------------------- 89 | 90 | -- | 'HashSet' which tries its best to remember insertion order of elements. 91 | 92 | data InsOrdHashSet k = InsOrdHashSet 93 | { _getIndex :: !Int 94 | , getInsOrdHashSet :: !(HashMap k Int) 95 | } 96 | deriving (Typeable, Data) 97 | 98 | -- | @since 0.2.5 99 | instance NFData k => NFData (InsOrdHashSet k) where 100 | rnf (InsOrdHashSet _ hs) = rnf hs 101 | 102 | -- | @since 0.2.5 103 | instance NF.NFData1 InsOrdHashSet where 104 | liftRnf rnf1 (InsOrdHashSet _ m) = NF.liftRnf2 rnf1 rnf m 105 | 106 | instance Eq k => Eq (InsOrdHashSet k) where 107 | InsOrdHashSet _ a == InsOrdHashSet _ b = a == b 108 | 109 | instance Show k => Show (InsOrdHashSet k) where 110 | showsPrec d m = showParen (d > 10) $ 111 | showString "fromList " . showsPrec 11 (toList m) 112 | 113 | instance (Eq k, Hashable k, Read k) => Read (InsOrdHashSet k) where 114 | readPrec = parens $ prec 10 $ do 115 | Ident "fromList" <- lexP 116 | xs <- readPrec 117 | return (fromList xs) 118 | 119 | readListPrec = readListPrecDefault 120 | 121 | instance (Eq k, Hashable k) => Semigroup (InsOrdHashSet k) where 122 | (<>) = union 123 | 124 | instance (Eq k, Hashable k) => Monoid (InsOrdHashSet k) where 125 | mempty = empty 126 | mappend = union 127 | 128 | instance Foldable InsOrdHashSet where 129 | -- in newer base only 130 | -- length = length . getInsOrdHashSet 131 | foldMap f = foldMap f . toList 132 | 133 | null = null 134 | toList = toList 135 | length = size 136 | 137 | -- | @'hashWithSalt' salt . 'toHashSet' = 'hashWithSalt' salt@. 138 | instance Hashable k => Hashable (InsOrdHashSet k) where 139 | hashWithSalt salt (InsOrdHashSet _ m) = 140 | hashWithSalt salt m 141 | 142 | instance (Eq k, Hashable k) => Exts.IsList (InsOrdHashSet k) where 143 | type Item (InsOrdHashSet k) = k 144 | fromList = fromList 145 | toList = toList 146 | 147 | ------------------------------------------------------------------------------- 148 | -- Aeson 149 | ------------------------------------------------------------------------------- 150 | 151 | instance A.ToJSON a => A.ToJSON (InsOrdHashSet a) where 152 | toJSON = A.toJSON . toList 153 | toEncoding = A.toEncoding . toList 154 | 155 | instance (Eq a, Hashable a, A.FromJSON a) => A.FromJSON (InsOrdHashSet a) where 156 | parseJSON v = fromList <$> A.parseJSON v 157 | 158 | ------------------------------------------------------------------------------- 159 | -- Lens 160 | ------------------------------------------------------------------------------- 161 | 162 | type instance Index (InsOrdHashSet a) = a 163 | type instance IxValue (InsOrdHashSet a) = () 164 | 165 | instance (Eq k, Hashable k) => Ixed (InsOrdHashSet k) where 166 | ix k f (InsOrdHashSet i m) = InsOrdHashSet i <$> ix k (\j -> j <$ f ()) m 167 | {-# INLINE ix #-} 168 | 169 | instance (Eq k, Hashable k) => At (InsOrdHashSet k) where 170 | at k f m = f mv <&> \r -> case r of 171 | Nothing -> maybe m (const (delete k m)) mv 172 | Just () -> insert k m 173 | where mv = if member k m then Just () else Nothing 174 | {-# INLINE at #-} 175 | 176 | instance (Eq a, Hashable a) => Contains (InsOrdHashSet a) where 177 | contains k f s = f (member k s) <&> \b -> 178 | if b then insert k s else delete k s 179 | {-# INLINE contains #-} 180 | 181 | -- | This is a slight lie, as roundtrip doesn't preserve ordering. 182 | hashSet :: Iso' (InsOrdHashSet a) (HashSet a) 183 | hashSet = iso toHashSet fromHashSet 184 | 185 | ------------------------------------------------------------------------------- 186 | -- Optics 187 | ------------------------------------------------------------------------------- 188 | 189 | type instance Optics.Index (InsOrdHashSet a) = a 190 | type instance Optics.IxValue (InsOrdHashSet a) = () 191 | 192 | instance (Eq k, Hashable k) => Optics.Ixed (InsOrdHashSet k) where 193 | ix k = Optics.atraversalVL $ \point f (InsOrdHashSet i m) -> 194 | InsOrdHashSet i <$> 195 | Optics.atraverseOf 196 | (Optics.ix k) point (\j -> j <$ f ()) m 197 | {-# INLINE ix #-} 198 | 199 | instance (Eq k, Hashable k) => Optics.At (InsOrdHashSet k) where 200 | at k = Optics.lensVL $ \f m -> Lens.at k f m 201 | {-# INLINE at #-} 202 | 203 | instance (Eq a, Hashable a) => Optics.Contains (InsOrdHashSet a) where 204 | contains k = Optics.lensVL $ \f s -> Lens.contains k f s 205 | {-# INLINE contains #-} 206 | 207 | ------------------------------------------------------------------------------- 208 | -- Construction 209 | ------------------------------------------------------------------------------- 210 | 211 | empty :: InsOrdHashSet k 212 | empty = InsOrdHashSet 0 HashMap.empty 213 | {-# INLINABLE empty #-} 214 | 215 | singleton :: Hashable k => k -> InsOrdHashSet k 216 | singleton k = InsOrdHashSet 1 (HashMap.singleton k 0) 217 | {-# INLINABLE singleton #-} 218 | 219 | ------------------------------------------------------------------------------- 220 | -- Basic interface 221 | ------------------------------------------------------------------------------- 222 | 223 | null :: InsOrdHashSet k -> Bool 224 | null = HashMap.null . getInsOrdHashSet 225 | {-# INLINABLE null #-} 226 | 227 | size :: InsOrdHashSet k -> Int 228 | size = HashMap.size . getInsOrdHashSet 229 | {-# INLINABLE size #-} 230 | 231 | member :: (Eq k, Hashable k) => k -> InsOrdHashSet k -> Bool 232 | member k = HashMap.member k . getInsOrdHashSet 233 | {-# INLINABLE member #-} 234 | 235 | insert :: (Eq k, Hashable k) => k -> InsOrdHashSet k -> InsOrdHashSet k 236 | insert k (InsOrdHashSet i m) = InsOrdHashSet (i + 1) (HashMap.insert k i m) 237 | 238 | delete :: (Eq k, Hashable k) => k -> InsOrdHashSet k -> InsOrdHashSet k 239 | delete k (InsOrdHashSet i m) = InsOrdHashSet i (HashMap.delete k m) 240 | 241 | ------------------------------------------------------------------------------- 242 | -- Combine 243 | ------------------------------------------------------------------------------- 244 | 245 | union 246 | :: (Eq k, Hashable k) 247 | => InsOrdHashSet k -> InsOrdHashSet k -> InsOrdHashSet k 248 | union (InsOrdHashSet i a) (InsOrdHashSet j b) = 249 | mk $ HashMap.union a b' 250 | where 251 | mk | i >= 0xfffff || j >= 0xfffff = fromHashMapInt 252 | | otherwise = InsOrdHashSet (i + j) 253 | 254 | b' = fmap (\k -> k + i + 1) b 255 | 256 | ------------------------------------------------------------------------------- 257 | -- Transformations 258 | ------------------------------------------------------------------------------- 259 | 260 | map :: (Hashable b, Eq b) => (a -> b) -> InsOrdHashSet a -> InsOrdHashSet b 261 | map f (InsOrdHashSet i m) = InsOrdHashSet i 262 | $ HashMap.fromList . fmap (first f) . HashMap.toList 263 | $ m 264 | 265 | ------------------------------------------------------------------------------- 266 | -- Difference and intersection 267 | ------------------------------------------------------------------------------- 268 | 269 | difference :: (Eq a, Hashable a) => InsOrdHashSet a -> InsOrdHashSet a -> InsOrdHashSet a 270 | difference (InsOrdHashSet i a) (InsOrdHashSet _ b) = 271 | InsOrdHashSet i $ HashMap.difference a b 272 | 273 | intersection :: (Eq a, Hashable a) => InsOrdHashSet a -> InsOrdHashSet a -> InsOrdHashSet a 274 | intersection (InsOrdHashSet i a) (InsOrdHashSet _ b) = 275 | InsOrdHashSet i $ HashMap.intersection a b 276 | 277 | ------------------------------------------------------------------------------- 278 | -- Filter 279 | ------------------------------------------------------------------------------- 280 | 281 | filter :: (a -> Bool) -> InsOrdHashSet a -> InsOrdHashSet a 282 | filter p (InsOrdHashSet i m) = InsOrdHashSet i $ 283 | HashMap.filterWithKey (\k _ -> p k) m 284 | 285 | ------------------------------------------------------------------------------- 286 | -- Conversions 287 | ------------------------------------------------------------------------------- 288 | 289 | fromList :: (Eq k, Hashable k) => [k] -> InsOrdHashSet k 290 | fromList = mk . flip runState 0 . traverse newInt where 291 | mk (m, i) = InsOrdHashSet i (HashMap.fromList m) 292 | 293 | toList :: InsOrdHashSet k -> [k] 294 | toList 295 | = fmap fst 296 | . sortBy (comparing snd) 297 | . HashMap.toList 298 | . getInsOrdHashSet 299 | 300 | fromHashSet :: HashSet k -> InsOrdHashSet k 301 | fromHashSet = mk . flip runState 0 . traverse (const newInt') . HashSet.toMap where 302 | mk (m, i) = InsOrdHashSet i m 303 | 304 | toHashSet :: InsOrdHashSet k -> HashSet k 305 | toHashSet (InsOrdHashSet _ m) = 306 | HashMap.keysSet m 307 | 308 | ------------------------------------------------------------------------------- 309 | -- Internal 310 | ------------------------------------------------------------------------------- 311 | 312 | fromHashMapInt :: HashMap k Int -> InsOrdHashSet k 313 | fromHashMapInt = mk . flip runState 0 . retractSortedAp . traverse f 314 | where 315 | mk (m, i) = InsOrdHashSet i m 316 | f i = liftSortedAp i newInt' 317 | 318 | newInt :: a -> State Int (a, Int) 319 | newInt a = state $ \s -> ((a, s), s + 1) 320 | 321 | newInt' :: State Int Int 322 | newInt' = state $ \s -> (s, s + 1) 323 | 324 | ------------------------------------------------------------------------------- 325 | -- Valid 326 | ------------------------------------------------------------------------------- 327 | 328 | -- | Test if the internal map structure is valid. 329 | valid :: InsOrdHashSet a -> Bool 330 | valid (InsOrdHashSet i m) = indexesDistinct && indexesSmaller 331 | where 332 | indexes :: [Int] 333 | indexes = HashMap.elems m 334 | 335 | indexesDistinct = indexes == nub indexes 336 | indexesSmaller = all (< i) indexes 337 | -------------------------------------------------------------------------------- /test/Tests.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Prelude () 4 | import Prelude.Compat 5 | 6 | import Control.Lens (folded, ifolded, (^..), (^@..)) 7 | import Data.Function (on) 8 | import Data.Hashable (Hashable (..)) 9 | import Data.List (nubBy) 10 | import Data.Semigroup ((<>)) 11 | import Data.Traversable (foldMapDefault) 12 | import Data.Word (Word8) 13 | import Text.Read (readMaybe) 14 | 15 | import qualified Data.Aeson as Aeson 16 | import qualified Data.HashMap.Strict as HashMap 17 | import qualified Data.HashMap.Strict.InsOrd as InsOrd 18 | 19 | import Test.QuickCheck.Function 20 | import Test.Tasty 21 | import Test.Tasty.QuickCheck 22 | 23 | main :: IO () 24 | main = defaultMain $ testGroup "tests" 25 | [ testGroup "Properties" $ 26 | [ testProperty "toList . fromList ~= id" $ toListFromList 27 | , testProperty "toList distributes over mappend" $ toListMappendDistribute 28 | , testProperty "behaves like HashMap" $ operationModel 29 | , testProperty "valid" $ validProperty 30 | , testProperty "Hashable agree" $ hashableProperty 31 | , testProperty "aeson roundtrip" $ aesonRoundtrip 32 | , testProperty "show . read = id" showReadRoundtrip 33 | ] 34 | , testGroup "Regressions" 35 | [ testProperty "issue 10: union overflow" $ issue10 36 | , testProperty "issue 12 Foldable" $ issue12a 37 | , testProperty "issue 12 Traversable" $ issue12b 38 | , testProperty "issue 12 FoldableWithIndex ^.." $ issue12c 39 | , testProperty "issue 12 FoldableWithIndex ^@.." $ issue12d 40 | ] 41 | ] 42 | 43 | toListFromList :: [(Int, Int)] -> Property 44 | toListFromList l = l' === InsOrd.toList (InsOrd.fromList l) 45 | where l' = reverse . nubBy (on (==) fst) . reverse $ l 46 | 47 | toListMappendDistribute :: [(Int, Int)] -> [(Int, Int)] -> Property 48 | toListMappendDistribute a b = rhs === lhs 49 | where 50 | a' = InsOrd.fromList a 51 | b' = foldr InsOrd.delete (InsOrd.fromList b) (InsOrd.keys a') 52 | rhs = InsOrd.toList (a' <> b') 53 | lhs = InsOrd.toList a' <> InsOrd.toList b' 54 | 55 | ------------------------------------------------------------------------------- 56 | -- Model 57 | ------------------------------------------------------------------------------- 58 | 59 | data Operation k v 60 | = FromList [(k, v)] 61 | | Empty 62 | | Singleton k v 63 | | Insert k v (Operation k v) 64 | | Delete k (Operation k v) 65 | | Union (Operation k v) (Operation k v) 66 | | Difference (Operation k v) (Operation k v) 67 | | Intersection (Operation k v) (Operation k v) 68 | | Filter (Fun v Bool) (Operation k v) 69 | deriving (Show) 70 | 71 | instance (Arbitrary k, Arbitrary v, Function v, CoArbitrary v) => Arbitrary (Operation k v) where 72 | arbitrary = sized a 73 | where 74 | term = 75 | [ FromList <$> arbitrary 76 | , pure Empty 77 | , Singleton <$> arbitrary <*> arbitrary 78 | ] 79 | a 0 = oneof term 80 | a n = oneof $ term ++ 81 | [ Insert <$> arbitrary <*> arbitrary <*> aMinus1 82 | , Delete <$> arbitrary <*> aMinus1 83 | , Union <$> aDiv2 <*> aDiv2 84 | , Difference <$> aDiv2 <*> aDiv2 85 | , Intersection <$> aDiv2 <*> aDiv2 86 | , Filter <$> arbitrary <*> aMinus1 87 | ] 88 | where 89 | aMinus1 = a (n - 1) 90 | aDiv2 = a (n `div` 2) 91 | 92 | evalOpInsOrd 93 | :: (Eq k, Hashable k) 94 | => Operation k v -> InsOrd.InsOrdHashMap k v 95 | evalOpInsOrd op = case op of 96 | FromList l -> InsOrd.fromList l 97 | Empty -> InsOrd.empty 98 | Singleton k v -> InsOrd.singleton k v 99 | Insert k v a -> InsOrd.insert k v (evalOpInsOrd a) 100 | Delete k a -> InsOrd.delete k (evalOpInsOrd a) 101 | Union a b -> InsOrd.union (evalOpInsOrd a) (evalOpInsOrd b) 102 | Difference a b -> InsOrd.difference (evalOpInsOrd a) (evalOpInsOrd b) 103 | Intersection a b -> InsOrd.intersection (evalOpInsOrd a) (evalOpInsOrd b) 104 | Filter (Fun _ f) a -> InsOrd.filter f (evalOpInsOrd a) 105 | 106 | evalOpHashMap 107 | :: (Eq k, Hashable k) 108 | => Operation k v-> HashMap.HashMap k v 109 | evalOpHashMap op = case op of 110 | FromList l -> HashMap.fromList l 111 | Empty -> HashMap.empty 112 | Singleton k v -> HashMap.singleton k v 113 | Insert k v a -> HashMap.insert k v (evalOpHashMap a) 114 | Delete k a -> HashMap.delete k (evalOpHashMap a) 115 | Union a b -> HashMap.union (evalOpHashMap a) (evalOpHashMap b) 116 | Difference a b -> HashMap.difference (evalOpHashMap a) (evalOpHashMap b) 117 | Intersection a b -> HashMap.intersection (evalOpHashMap a) (evalOpHashMap b) 118 | Filter (Fun _ f) a -> HashMap.filter f (evalOpHashMap a) 119 | 120 | operationModel :: Operation Word8 Int -> Property 121 | operationModel op = rhs === lhs 122 | where 123 | iom = evalOpInsOrd op 124 | lhs = InsOrd.toHashMap iom 125 | rhs = evalOpHashMap op 126 | 127 | validProperty :: Operation Word8 Int -> Property 128 | validProperty op = property $ InsOrd.valid iom 129 | where 130 | iom = evalOpInsOrd op 131 | 132 | hashableProperty :: Operation Word8 Int -> Int -> Property 133 | hashableProperty op salt = rhs === lhs 134 | where 135 | iom = evalOpInsOrd op 136 | lhs = hashWithSalt salt $ iom 137 | rhs = hashWithSalt salt $ evalOpHashMap op 138 | 139 | aesonRoundtrip :: Operation Int Int -> Property 140 | aesonRoundtrip op = rhs === lhs 141 | where 142 | iom = evalOpInsOrd op 143 | rhs = Right iom 144 | lhs = Aeson.eitherDecode $ Aeson.encode iom 145 | 146 | showReadRoundtrip :: Operation Word8 Int -> Property 147 | showReadRoundtrip op = rhs === lhs 148 | where 149 | iom = evalOpInsOrd op 150 | rhs = Just iom 151 | lhs = readMaybe $ show iom 152 | 153 | ------------------------------------------------------------------------------- 154 | -- Regressions 155 | ------------------------------------------------------------------------------- 156 | 157 | issue12a :: Property 158 | issue12a = (m ^.. folded) === "wold" 159 | where 160 | m :: InsOrd.InsOrdHashMap Char Char 161 | m = InsOrd.fromList (zip "hello" "world") 162 | 163 | issue12b :: Property 164 | issue12b = foldMapDefault (:[]) m === "wold" 165 | where 166 | m :: InsOrd.InsOrdHashMap Char Char 167 | m = InsOrd.fromList (zip "hello" "world") 168 | 169 | issue12c :: Property 170 | issue12c = (m ^.. ifolded) === "wold" 171 | where 172 | m :: InsOrd.InsOrdHashMap Char Char 173 | m = InsOrd.fromList (zip "hello" "world") 174 | 175 | issue12d :: Property 176 | issue12d = (m ^@.. ifolded) === (zip "helo" "wold") 177 | where 178 | m :: InsOrd.InsOrdHashMap Char Char 179 | m = InsOrd.fromList (zip "hello" "world") 180 | 181 | 182 | issue10 :: Property 183 | issue10 = (p ^.. folded) === "wold!" .&&. property (InsOrd.valid p) 184 | where 185 | m, n, p :: InsOrd.InsOrdHashMap Char Char 186 | m = InsOrd.fromList (zip "hello" "world") 187 | n = iterate (\x -> InsOrd.union x x) m !! 64 188 | p = InsOrd.insert '!' '!' n 189 | --------------------------------------------------------------------------------