insert-ordered-containers 0.2.1.0 → 0.3.0
raw patch · 6 files changed
Files
- CHANGELOG.md +39/−0
- insert-ordered-containers.cabal +66/−49
- src/Data/HashMap/InsOrd/Internal.hs +41/−0
- src/Data/HashMap/Strict/InsOrd.hs +127/−93
- src/Data/HashSet/InsOrd.hs +335/−0
- test/Tests.hs +7/−1
CHANGELOG.md view
@@ -1,3 +1,42 @@+- 0.3.0+ - Fix ordering when decoding from JSON (with tests)+ https://github.com/erikd/insert-ordered-containers/issues/7+ This is a breaking change.+ - GHC-9.14.1 support++- 0.2.7+ - Support GHC-8.6.5...9.12.1+ - Haskell code modernisation++- 0.2.6+ - Support GHC-8.6.5...9.10.1++- 0.2.5.3+ - Support `aeson-2.2`+ - Make `Prelude` import explicit (safe guard against additions to `Prelude`).++- 0.2.5.2+ - Actually drop `semigroups` dependency+ - Update bounds++- 0.2.5.1+ - Drop unnecessary dependencies `semigroups`, `base-compat`+ - Update bounds++- 0.2.5+ - Add `NFData(/1/2)` instances++- 0.2.4+ - Add `indexed-traversable` instances+ - lens-5 and optics-0.4 support++- 0.2.3+ - Add support for indexed `optics`+ - Only support GHC-8.0+++- 0.2.2+ - Add `Data.HashSet.InsOrd`+ - 0.2.1.0 - Fix `Traversable`, `TraversableWithIndex`, `FoldableWithIndex` to traverse in insertion order
insert-ordered-containers.cabal view
@@ -1,65 +1,82 @@-name: insert-ordered-containers-version: 0.2.1.0-synopsis: Associative containers retating insertion order for traversals.-description: Associative containers retating insertion order for traversals.-category: Web-homepage: https://github.com/phadej/insert-ordered-containers#readme-bug-reports: https://github.com/phadej/insert-ordered-containers/issues-author: Oleg Grenrus <oleg.grenrus@iki.fi>-maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>-license: BSD3-license-file: LICENSE-tested-with: GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.1-build-type: Simple-cabal-version: >= 1.10+cabal-version: 2.2+name: insert-ordered-containers+version: 0.3.0+synopsis:+ Associative containers retaining insertion order for traversals. +description:+ Associative containers retaining insertion order for traversals.+ .+ The implementation is based on `unordered-containers`.++category: Web+homepage: https://github.com/erikd/insert-ordered-containers#readme+bug-reports: https://github.com/erikd/insert-ordered-containers/issues+author: Oleg Grenrus <oleg.grenrus@iki.fi>+maintainer: Erik de Castro Lopo <erikd@mega-nerd.com>, Oleg Grenrus <oleg.grenrus@iki.fi>+license: BSD-3-Clause+license-file: LICENSE+build-type: Simple+tested-with:+ GHC ==8.6.5+ || ==8.8.4+ || ==8.10.7+ || ==9.0.2+ || ==9.2.8+ || ==9.4.8+ || ==9.6.7+ || ==9.8.4+ || ==9.10.3+ || ==9.12.2+ || ==9.14.1+ extra-source-files:- CHANGELOG.md- README.md+ CHANGELOG.md+ README.md source-repository head- type: git- location: https://github.com/phadej/insert-ordered-containers+ type: git+ location: https://github.com/erikd/insert-ordered-containers library- hs-source-dirs:- src- ghc-options: -Wall+ default-language: Haskell2010+ hs-source-dirs: src+ ghc-options: -Wall -Wunused-packages build-depends:- base >=4.6 && <4.10- , aeson >=1.0.0.0 && <1.2- , base-compat >=0.6.0 && <0.10- , hashable >=1.2.3.3 && <1.4- , lens >=4.7 && <4.16- , semigroupoids >=4.3 && <5.2- , semigroups >=0.16.2.2 && <0.19- , text >=1.2.0.6 && <1.3- , transformers >=0.3.0.0 && <0.6- , unordered-containers >=0.2.7.0 && <0.3+ , aeson >=2.2.3.0 && <2.3+ , base >=4.12.0.0 && <4.23+ , deepseq >=1.4.4.0 && <1.6+ , hashable >=1.4.7.0 && <1.6+ , indexed-traversable >=0.1.4 && <0.2+ , lens >=5.2.3 && <5.4+ , optics-core >=0.4.1.1 && <0.5+ , optics-extra >=0.4.2.1 && <0.5+ , semigroupoids >=6.0.1 && <6.1+ , transformers >=0.5.6.2 && <0.7+ , unordered-containers >=0.2.20 && <0.3+ exposed-modules:- Data.HashMap.Strict.InsOrd- default-language: Haskell2010+ Data.HashMap.Strict.InsOrd+ Data.HashSet.InsOrd + other-modules: Data.HashMap.InsOrd.Internal+ test-suite ins-ord-containers-tests- type: exitcode-stdio-1.0- main-is: Tests.hs- hs-source-dirs:- test- ghc-options: -Wall+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: Tests.hs+ hs-source-dirs: test+ ghc-options: -Wall++ -- inherited from library build-depends:- base , aeson+ , base , base-compat , hashable+ , insert-ordered-containers , lens- , semigroupoids- , semigroups- , text- , transformers+ , QuickCheck >=2.13.2 && <2.19+ , tasty >=0.10.1.2 && <1.6+ , tasty-quickcheck >=0.8.3.2 && <0.12 , unordered-containers- , base- , insert-ordered-containers- , tasty >= 0.10.1.2 && <0.12- , tasty-quickcheck >= 0.8.3.2 && <0.9- , QuickCheck >=2.7.6 && <2.10- default-language: Haskell2010
+ src/Data/HashMap/InsOrd/Internal.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE GADTs #-}+module Data.HashMap.InsOrd.Internal where++import Prelude hiding (filter, foldr, lookup, map, null)++import Control.Applicative ((<**>))++-------------------------------------------------------------------------------+-- SortedAp+-------------------------------------------------------------------------------++-- Sort using insertion sort+-- Hopefully it's fast enough for where we need it+-- otherwise: https://gist.github.com/treeowl/9621f58d55fe0c4f9162be0e074b1b29+-- http://elvishjerricco.github.io/2017/03/23/applicative-sorting.html also related++-- Free applicative which re-orders effects+-- Mostly from Edward Kmett's `free` package.+data SortedAp f a where+ Pure :: a -> SortedAp f a+ SortedAp :: !Int -> f a -> SortedAp f (a -> b) -> SortedAp f b++instance Functor (SortedAp f) where+ fmap f (Pure a) = Pure (f a)+ fmap f (SortedAp i x y) = SortedAp i x ((f .) <$> y)++instance Applicative (SortedAp f) where+ pure = Pure+ Pure f <*> y = fmap f y+ -- This is different from real Ap+ f <*> Pure y = fmap ($ y) f+ f@(SortedAp i x y) <*> z@(SortedAp j u v)+ | i < j = SortedAp i x (flip <$> y <*> z)+ | otherwise = SortedAp j u ((.) <$> f <*> v)++liftSortedAp :: Int -> f a -> SortedAp f a+liftSortedAp i x = SortedAp i x (Pure id)++retractSortedAp :: Applicative f => SortedAp f a -> f a+retractSortedAp (Pure x) = pure x+retractSortedAp (SortedAp _ f x) = f <**> retractSortedAp x
src/Data/HashMap/Strict/InsOrd.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-}@@ -77,50 +76,67 @@ valid, ) where -#ifndef MIN_VERSION_aeson-#define MIN_VERSION_aeson(x,y,z) 0-#endif--import Prelude ()-import Prelude.Compat hiding (filter, foldr, lookup, map, null)+import Prelude+ (Bool (..), Eq, Functor, Int, Maybe (..), all, const, flip, fmap, fst,+ id, maybe, otherwise, pure, return, snd, uncurry, ($), (&&), (+), (.),+ (<$>), (<), (==), (>), (>=), (>>=), (||)) -import Control.Applicative (Const (..), (<**>))-import Control.Arrow (first, second)-import Data.Aeson-import qualified Data.Aeson.Encoding as E-import Data.Data (Data, Typeable)-import qualified Data.Foldable as F-import Data.Functor.Apply (Apply (..))-import Data.Functor.Bind (Bind (..))-import Data.Hashable (Hashable (..))-import Data.List (nub, sortBy)-import Data.Maybe (fromMaybe)-import Data.Ord (comparing)-import Data.Semigroup (Semigroup (..))-import Text.ParserCombinators.ReadPrec (prec)-import Text.Read (Lexeme (..), Read (..), lexP,- parens, readListPrecDefault)+import Control.Applicative (Applicative, Const (..))+import Control.Arrow (first, second)+import Control.DeepSeq (NFData (..))+import Data.Data (Data)+import Data.Foldable (Foldable (foldMap))+import Data.Foldable.WithIndex (FoldableWithIndex (..))+import Data.Functor.Apply (Apply (..))+import Data.Functor.Bind (Bind (..))+import Data.Functor.WithIndex (FunctorWithIndex (..))+import Data.Hashable (Hashable (..))+import Data.List (nub, sortBy)+import Data.Maybe (fromMaybe)+import Data.Monoid (Monoid, mempty)+import Data.Ord (comparing)+import Data.Semigroup (Semigroup (..))+import Data.Traversable (Traversable (traverse))+import Data.Traversable.WithIndex (TraversableWithIndex (..))+import Text.ParserCombinators.ReadPrec (prec)+import Text.Read+ (Lexeme (..), Read (..), lexP, parens, readListPrecDefault)+import Text.Show (Show (..), showParen, showString) -import Control.Lens (At (..), FoldableWithIndex (..),- FunctorWithIndex (..), Index, Iso, IxValue,- Ixed (..), TraversableWithIndex (..),- Traversal, iso, (<&>), _1, _2)+import Control.Lens+ (At (..), Index, Iso, IxValue, Ixed (..), Traversal, _1, _2, iso, (<&>)) import Control.Monad.Trans.State.Strict (State, runState, state) +import qualified Control.Lens as Lens+import qualified Data.Aeson as A+import qualified Data.Aeson.Types as A+import qualified Data.Foldable as F+import qualified Optics.At as Optics+import qualified Optics.Core as Optics+ import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap -#if MIN_VERSION_base(4,7,0) import qualified GHC.Exts as Exts-#endif +import qualified Control.DeepSeq as NF++import Data.HashMap.InsOrd.Internal+ ------------------------------------------------------------------------------- -- Strict Pair Int a ------------------------------------------------------------------------------- data P a = P !Int !a- deriving (Functor, Foldable, Traversable, Typeable, Data)+ deriving (Functor, Foldable, Traversable, Data) +instance NFData a => NFData (P a) where+ rnf (P _ a) = rnf a++-- | @since 0.2.5+instance NF.NFData1 P where+ liftRnf rnf1 (P _ a) = rnf1 a+ getPK :: P a -> Int getPK (P i _) = i {-# INLINABLE getPK #-}@@ -146,16 +162,28 @@ -- InsOrdHashMap ------------------------------------------------------------------------------- --- | 'HashMap' which tries it's best to remember insertion order of elements.+-- | 'HashMap' which tries its best to remember insertion order of elements. data InsOrdHashMap k v = InsOrdHashMap { _getIndex :: !Int , getInsOrdHashMap :: !(HashMap k (P v)) }- deriving (Functor, Typeable, Data)+ deriving (Functor, Data) +-- | @since 0.2.5+instance (NFData k, NFData v) => NFData (InsOrdHashMap k v) where+ rnf (InsOrdHashMap _ hm) = rnf hm++-- | @since 0.2.5+instance NFData k => NF.NFData1 (InsOrdHashMap k) where+ liftRnf rnf2 = NF.liftRnf2 rnf rnf2++-- | @since 0.2.5+instance NF.NFData2 InsOrdHashMap where+ liftRnf2 rnf1 rnf2 (InsOrdHashMap _ m) = NF.liftRnf2 rnf1 (NF.liftRnf rnf2) m+ instance (Eq k, Eq v) => Eq (InsOrdHashMap k v) where- InsOrdHashMap _ a == InsOrdHashMap _ b = a == b+ a == b = toList a == toList b instance (Show k, Show v) => Show (InsOrdHashMap k v) where showsPrec d m = showParen (d > 10) $@@ -174,7 +202,6 @@ instance (Eq k, Hashable k) => Monoid (InsOrdHashMap k v) where mempty = empty- mappend = union -- We cannot derive this, as we want to ordered folding and traversing instance Foldable (InsOrdHashMap k) where@@ -182,11 +209,9 @@ -- length = length . getInsOrdHashMap foldMap f = foldMap (f . snd) . toList -#if MIN_VERSION_base(4,8,0) null = null toList = elems length = size-#endif instance Traversable (InsOrdHashMap k) where traverse f m = traverseWithKey (\_ -> f) m@@ -204,39 +229,61 @@ hashWithSalt salt (InsOrdHashMap _ m) = hashWithSalt salt m -#if MIN_VERSION_base(4,7,0) instance (Eq k, Hashable k) => Exts.IsList (InsOrdHashMap k v) where type Item (InsOrdHashMap k v) = (k, v) fromList = fromList toList = toList-#endif ------------------------------------------------------------------------------- -- Aeson ------------------------------------------------------------------------------- -instance (ToJSONKey k) => ToJSON1 (InsOrdHashMap k) where- liftToJSON t _ = case toJSONKey :: ToJSONKeyFunction k of- ToJSONKeyText f _ -> object . fmap (\(k, v) -> (f k, t v)) . toList- ToJSONKeyValue f _ -> toJSON . fmap (\(k,v) -> toJSON (f k, t v)) . toList+instance A.ToJSON2 InsOrdHashMap where+ liftToJSON2 omitKey encodeKey encodeKeyList omitVal encodeVal encodeValList =+ A.liftToJSON omitNothing encodeKVPair encodeKVPairList . toList+ where+ omitNothing _ = False+ encodeKVPair = A.liftToJSON2 omitKey encodeKey encodeKeyList omitVal encodeVal encodeValList+ encodeKVPairList = A.listValue encodeKVPair+ liftToEncoding2 omitKey encodeKey encodeKeyList omitVal encodeVal encodeValList =+ A.liftToEncoding omitNothing encodeKVPair encodeKVPairList . toList+ where+ omitNothing _ = False+ encodeKVPair = A.liftToEncoding2 omitKey encodeKey encodeKeyList omitVal encodeVal encodeValList+ encodeKVPairList = A.listEncoding encodeKVPair - liftToEncoding t _ = case toJSONKey :: ToJSONKeyFunction k of- ToJSONKeyText _ f -> E.dict f t foldrWithKey- ToJSONKeyValue _ f -> E.list (liftToEncoding2 f (E.list f) t (E.list t)) . toList+instance (A.ToJSON k) => A.ToJSON1 (InsOrdHashMap k) where+ liftToJSON = A.liftToJSON2 A.omitField A.toJSON A.toJSONList+ liftToEncoding = A.liftToEncoding2 A.omitField A.toEncoding A.toEncodingList -instance (ToJSONKey k, ToJSON v) => ToJSON (InsOrdHashMap k v) where- toJSON = toJSON1- toEncoding = toEncoding1+instance (A.ToJSON k, A.ToJSON v) => A.ToJSON (InsOrdHashMap k v) where+ toJSON = A.toJSON1+ toEncoding = A.toEncoding1 ------------------------------------------------------------------------------- -instance (Eq k, Hashable k, FromJSONKey k) => FromJSON1 (InsOrdHashMap k) where- liftParseJSON p pl v = fromList . HashMap.toList <$> liftParseJSON p pl v+instance (Eq k, Hashable k, A.FromJSON k) => A.FromJSON1 (InsOrdHashMap k) where+ liftParseJSON o p pl v = fromList <$> A.liftParseJSON Nothing pkv plkv v+ where+ pkv = A.liftParseJSON2 A.omittedField A.parseJSON A.parseJSONList o p pl+ plkv = A.listParser pkv -instance (Eq k, Hashable k, FromJSONKey k, FromJSON v) => FromJSON (InsOrdHashMap k v) where- parseJSON = parseJSON1+instance (Eq k, Hashable k, A.FromJSON k, A.FromJSON v) => A.FromJSON (InsOrdHashMap k v) where+ parseJSON = A.parseJSON1 -------------------------------------------------------------------------------+-- indexed-traversals+-------------------------------------------------------------------------------++instance (Eq k, Hashable k) => FunctorWithIndex k (InsOrdHashMap k) where+ imap = mapWithKey+instance (Eq k, Hashable k) => FoldableWithIndex k (InsOrdHashMap k) where+ ifoldMap = foldMapWithKey+ ifoldr = foldrWithKey+instance (Eq k, Hashable k) => TraversableWithIndex k (InsOrdHashMap k) where+ itraverse = traverseWithKey++------------------------------------------------------------------------------- -- Lens ------------------------------------------------------------------------------- @@ -244,11 +291,21 @@ type instance IxValue (InsOrdHashMap k v) = v instance (Eq k, Hashable k) => Ixed (InsOrdHashMap k v) where- ix k f m = case lookup k m of- Just v -> f v <&> \v' -> insert k v' m- Nothing -> pure m+ ix k f m = ixImpl k pure f m {-# INLINABLE ix #-} +ixImpl+ :: (Eq k, Hashable k, Functor f)+ => k+ -> (InsOrdHashMap k v -> f (InsOrdHashMap k v))+ -> (v -> f v)+ -> InsOrdHashMap k v+ -> f (InsOrdHashMap k v)+ixImpl k point f m = case lookup k m of+ Just v -> f v <&> \v' -> insert k v' m+ Nothing -> point m+{-# INLINE ixImpl #-}+ instance (Eq k, Hashable k) => At (InsOrdHashMap k a) where at k f m = f mv <&> \r -> case r of Nothing -> maybe m (const (delete k m)) mv@@ -256,13 +313,6 @@ where mv = lookup k m {-# INLINABLE at #-} -instance (Eq k, Hashable k) => FunctorWithIndex k (InsOrdHashMap k) where- imap = mapWithKey-instance (Eq k, Hashable k) => FoldableWithIndex k (InsOrdHashMap k) where- ifoldMap = foldMapWithKey-instance (Eq k, Hashable k) => TraversableWithIndex k (InsOrdHashMap k) where- itraverse = traverseWithKey- -- | This is a slight lie, as roundtrip doesn't preserve ordering. hashMap :: Iso (InsOrdHashMap k a) (InsOrdHashMap k b) (HashMap k a) (HashMap k b) hashMap = iso toHashMap fromHashMap@@ -271,6 +321,21 @@ unorderedTraversal = hashMap . traverse -------------------------------------------------------------------------------+-- Optics+-------------------------------------------------------------------------------++type instance Optics.Index (InsOrdHashMap k v) = k+type instance Optics.IxValue (InsOrdHashMap k v) = v++instance (Eq k, Hashable k) => Optics.Ixed (InsOrdHashMap k v) where+ ix k = Optics.atraversalVL $ \point f m -> ixImpl k point f m+ {-# INLINE ix #-}++instance (Eq k, Hashable k) => Optics.At (InsOrdHashMap k a) where+ at k = Optics.lensVL $ \f m -> Lens.at k f m+ {-# INLINE at #-}++------------------------------------------------------------------------------- -- Construction ------------------------------------------------------------------------------- @@ -419,37 +484,6 @@ traverseWithKey :: Applicative f => (k -> a -> f b) -> InsOrdHashMap k a -> f (InsOrdHashMap k b) traverseWithKey f (InsOrdHashMap n m) = InsOrdHashMap n <$> retractSortedAp (HashMap.traverseWithKey (\k (P i v) -> liftSortedAp i (P i <$> f k v)) m)---- Sort using insertion sort--- Hopefully it's fast enough for where we need it--- otherwise: https://gist.github.com/treeowl/9621f58d55fe0c4f9162be0e074b1b29--- http://elvishjerricco.github.io/2017/03/23/applicative-sorting.html also related---- Free applicative which re-orders effects--- Mostly from Edward Kmett's `free` package.-data SortedAp f a where- Pure :: a -> SortedAp f a- SortedAp :: !Int -> f a -> SortedAp f (a -> b) -> SortedAp f b--instance Functor (SortedAp f) where- fmap f (Pure a) = Pure (f a)- fmap f (SortedAp i x y) = SortedAp i x ((f .) <$> y)--instance Applicative (SortedAp f) where- pure = Pure- Pure f <*> y = fmap f y- -- This is different from real Ap- f <*> Pure y = fmap ($ y) f- f@(SortedAp i x y) <*> z@(SortedAp j u v)- | i < j = SortedAp i x (flip <$> y <*> z)- | otherwise = SortedAp j u ((.) <$> f <*> v)--liftSortedAp :: Int -> f a -> SortedAp f a-liftSortedAp i x = SortedAp i x (Pure id)--retractSortedAp :: Applicative f => SortedAp f a -> f a-retractSortedAp (Pure x) = pure x-retractSortedAp (SortedAp _ f x) = f <**> retractSortedAp x ------------------------------------------------------------------------------- -- Unordered
+ src/Data/HashSet/InsOrd.hs view
@@ -0,0 +1,335 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TypeFamilies #-}+-- | 'InsOrdHashSet' is like 'HashSet', but it folds in insertion order.+--+-- This module interface mimics "Data.HashSet", with some additions.+module Data.HashSet.InsOrd (+ InsOrdHashSet,+ -- * Construction+ empty,+ singleton,+ -- * Basic interface+ null,+ size,+ member,+ insert,+ delete,+ -- * Combine+ union,+ -- * Transformations+ map,+ -- ** Unordered+ -- * Difference and intersection+ difference,+ intersection,+ -- * Folds+ -- ** Unordered+ -- * Filter+ filter,+ -- * Conversions+ toList,+ fromList,+ toHashSet,+ fromHashSet,+ -- * Lenses+ hashSet,+ -- * Debugging+ valid,+ )where++import Prelude+ (Bool, Eq ((==)), Int, Maybe (..), const, flip, fmap, fst,+ maybe, otherwise, return, snd, ($), (&&), (+), (.), (<$), (<$>), (<),+ (>), (>=), (||))++import Control.Arrow (first)+import Control.DeepSeq (NFData (..))+import Data.Data (Data)+import Data.Foldable (Foldable (foldMap), all)+import Data.Hashable (Hashable (..))+import Data.List (nub, sortBy)+import Data.Monoid (Monoid (..))+import Data.Ord (comparing)+import Data.Semigroup (Semigroup (..))+import Data.Traversable (Traversable (traverse))+import Text.ParserCombinators.ReadPrec (prec)+import Text.Read+ (Lexeme (..), Read (..), lexP, parens, readListPrecDefault)+import Text.Show (Show (..), showParen, showString)++import Control.Lens+ (At (..), Contains (..), Index, Iso', IxValue, Ixed (..), iso, (<&>))+import Control.Monad.Trans.State.Strict (State, runState, state)++import qualified Data.Aeson as A+import qualified Control.Lens as Lens+import qualified Optics.At as Optics+import qualified Optics.Core as Optics++import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap+import Data.HashSet (HashSet)+import qualified Data.HashSet as HashSet++import qualified Data.Foldable+import qualified GHC.Exts as Exts++import qualified Control.DeepSeq as NF++import Data.HashMap.InsOrd.Internal++-------------------------------------------------------------------------------+-- InsOrdHashSet+-------------------------------------------------------------------------------++-- | 'HashSet' which tries its best to remember insertion order of elements.++data InsOrdHashSet k = InsOrdHashSet+ { _getIndex :: !Int+ , getInsOrdHashSet :: !(HashMap k Int)+ }+ deriving (Data)++-- | @since 0.2.5+instance NFData k => NFData (InsOrdHashSet k) where+ rnf (InsOrdHashSet _ hs) = rnf hs++-- | @since 0.2.5+instance NF.NFData1 InsOrdHashSet where+ liftRnf rnf1 (InsOrdHashSet _ m) = NF.liftRnf2 rnf1 rnf m++instance Eq k => Eq (InsOrdHashSet k) where+ InsOrdHashSet _ a == InsOrdHashSet _ b = a == b++instance Show k => Show (InsOrdHashSet k) where+ showsPrec d m = showParen (d > 10) $+ showString "fromList " . showsPrec 11 (toList m)++instance (Eq k, Hashable k, Read k) => Read (InsOrdHashSet k) where+ readPrec = parens $ prec 10 $ do+ Ident "fromList" <- lexP+ xs <- readPrec+ return (fromList xs)++ readListPrec = readListPrecDefault++instance (Eq k, Hashable k) => Semigroup (InsOrdHashSet k) where+ (<>) = union++instance (Eq k, Hashable k) => Monoid (InsOrdHashSet k) where+ mempty = empty++instance Foldable InsOrdHashSet where+ -- in newer base only+ -- length = length . getInsOrdHashSet+ foldMap f = foldMap f . toList++ null = null+ toList = toList+ length = size++-- | @'hashWithSalt' salt . 'toHashSet' = 'hashWithSalt' salt@.+instance Hashable k => Hashable (InsOrdHashSet k) where+ hashWithSalt salt (InsOrdHashSet _ m) =+ hashWithSalt salt m++instance (Eq k, Hashable k) => Exts.IsList (InsOrdHashSet k) where+ type Item (InsOrdHashSet k) = k+ fromList = fromList+ toList = toList++-------------------------------------------------------------------------------+-- Aeson+-------------------------------------------------------------------------------++instance A.ToJSON a => A.ToJSON (InsOrdHashSet a) where+ toJSON = A.toJSON . toList+ toEncoding = A.toEncoding . toList++instance (Eq a, Hashable a, A.FromJSON a) => A.FromJSON (InsOrdHashSet a) where+ parseJSON v = fromList <$> A.parseJSON v++-------------------------------------------------------------------------------+-- Lens+-------------------------------------------------------------------------------++type instance Index (InsOrdHashSet a) = a+type instance IxValue (InsOrdHashSet a) = ()++instance (Eq k, Hashable k) => Ixed (InsOrdHashSet k) where+ ix k f (InsOrdHashSet i m) = InsOrdHashSet i <$> ix k (\j -> j <$ f ()) m+ {-# INLINE ix #-}++instance (Eq k, Hashable k) => At (InsOrdHashSet k) where+ at k f m = f mv <&> \r -> case r of+ Nothing -> maybe m (const (delete k m)) mv+ Just () -> insert k m+ where mv = if member k m then Just () else Nothing+ {-# INLINE at #-}++instance (Eq a, Hashable a) => Contains (InsOrdHashSet a) where+ contains k f s = f (member k s) <&> \b ->+ if b then insert k s else delete k s+ {-# INLINE contains #-}++-- | This is a slight lie, as roundtrip doesn't preserve ordering.+hashSet :: Iso' (InsOrdHashSet a) (HashSet a)+hashSet = iso toHashSet fromHashSet++-------------------------------------------------------------------------------+-- Optics+-------------------------------------------------------------------------------++type instance Optics.Index (InsOrdHashSet a) = a+type instance Optics.IxValue (InsOrdHashSet a) = ()++instance (Eq k, Hashable k) => Optics.Ixed (InsOrdHashSet k) where+ ix k = Optics.atraversalVL $ \point f (InsOrdHashSet i m) ->+ InsOrdHashSet i <$>+ Optics.atraverseOf+ (Optics.ix k) point (\j -> j <$ f ()) m+ {-# INLINE ix #-}++instance (Eq k, Hashable k) => Optics.At (InsOrdHashSet k) where+ at k = Optics.lensVL $ \f m -> Lens.at k f m+ {-# INLINE at #-}++instance (Eq a, Hashable a) => Optics.Contains (InsOrdHashSet a) where+ contains k = Optics.lensVL $ \f s -> Lens.contains k f s+ {-# INLINE contains #-}++-------------------------------------------------------------------------------+-- Construction+-------------------------------------------------------------------------------++empty :: InsOrdHashSet k+empty = InsOrdHashSet 0 HashMap.empty+{-# INLINABLE empty #-}++singleton :: Hashable k => k -> InsOrdHashSet k+singleton k = InsOrdHashSet 1 (HashMap.singleton k 0)+{-# INLINABLE singleton #-}++-------------------------------------------------------------------------------+-- Basic interface+-------------------------------------------------------------------------------++null :: InsOrdHashSet k -> Bool+null = HashMap.null . getInsOrdHashSet+{-# INLINABLE null #-}++size :: InsOrdHashSet k -> Int+size = HashMap.size . getInsOrdHashSet+{-# INLINABLE size #-}++member :: (Eq k, Hashable k) => k -> InsOrdHashSet k -> Bool+member k = HashMap.member k . getInsOrdHashSet+{-# INLINABLE member #-}++insert :: (Eq k, Hashable k) => k -> InsOrdHashSet k -> InsOrdHashSet k+insert k (InsOrdHashSet i m) = InsOrdHashSet (i + 1) (HashMap.insert k i m)++delete :: (Eq k, Hashable k) => k -> InsOrdHashSet k -> InsOrdHashSet k+delete k (InsOrdHashSet i m) = InsOrdHashSet i (HashMap.delete k m)++-------------------------------------------------------------------------------+-- Combine+-------------------------------------------------------------------------------++union+ :: (Eq k, Hashable k)+ => InsOrdHashSet k -> InsOrdHashSet k -> InsOrdHashSet k+union (InsOrdHashSet i a) (InsOrdHashSet j b) =+ mk $ HashMap.union a b'+ where+ mk | i >= 0xfffff || j >= 0xfffff = fromHashMapInt+ | otherwise = InsOrdHashSet (i + j)++ b' = fmap (\k -> k + i + 1) b++-------------------------------------------------------------------------------+-- Transformations+-------------------------------------------------------------------------------++map :: (Hashable b, Eq b) => (a -> b) -> InsOrdHashSet a -> InsOrdHashSet b+map f (InsOrdHashSet i m) = InsOrdHashSet i+ $ HashMap.fromList . fmap (first f) . HashMap.toList+ $ m++-------------------------------------------------------------------------------+-- Difference and intersection+-------------------------------------------------------------------------------++difference :: (Eq a, Hashable a) => InsOrdHashSet a -> InsOrdHashSet a -> InsOrdHashSet a+difference (InsOrdHashSet i a) (InsOrdHashSet _ b) =+ InsOrdHashSet i $ HashMap.difference a b++intersection :: (Eq a, Hashable a) => InsOrdHashSet a -> InsOrdHashSet a -> InsOrdHashSet a+intersection (InsOrdHashSet i a) (InsOrdHashSet _ b) =+ InsOrdHashSet i $ HashMap.intersection a b++-------------------------------------------------------------------------------+-- Filter+-------------------------------------------------------------------------------++filter :: (a -> Bool) -> InsOrdHashSet a -> InsOrdHashSet a+filter p (InsOrdHashSet i m) = InsOrdHashSet i $+ HashMap.filterWithKey (\k _ -> p k) m++-------------------------------------------------------------------------------+-- Conversions+-------------------------------------------------------------------------------++fromList :: (Eq k, Hashable k) => [k] -> InsOrdHashSet k+fromList = mk . flip runState 0 . traverse newInt where+ mk (m, i) = InsOrdHashSet i (HashMap.fromList m)++toList :: InsOrdHashSet k -> [k]+toList+ = fmap fst+ . sortBy (comparing snd)+ . HashMap.toList+ . getInsOrdHashSet++fromHashSet :: HashSet k -> InsOrdHashSet k+fromHashSet = mk . flip runState 0 . traverse (const newInt') . HashSet.toMap where+ mk (m, i) = InsOrdHashSet i m++toHashSet :: InsOrdHashSet k -> HashSet k+toHashSet (InsOrdHashSet _ m) =+ HashMap.keysSet m++-------------------------------------------------------------------------------+-- Internal+-------------------------------------------------------------------------------++fromHashMapInt :: HashMap k Int -> InsOrdHashSet k+fromHashMapInt = mk . flip runState 0 . retractSortedAp . traverse f+ where+ mk (m, i) = InsOrdHashSet i m+ f i = liftSortedAp i newInt'++newInt :: a -> State Int (a, Int)+newInt a = state $ \s -> ((a, s), s + 1)++newInt' :: State Int Int+newInt' = state $ \s -> (s, s + 1)++-------------------------------------------------------------------------------+-- Valid+-------------------------------------------------------------------------------++-- | Test if the internal map structure is valid.+valid :: InsOrdHashSet a -> Bool+valid (InsOrdHashSet i m) = indexesDistinct && indexesSmaller+ where+ indexes :: [Int]+ indexes = HashMap.elems m++ indexesDistinct = indexes == nub indexes+ indexesSmaller = all (< i) indexes
test/Tests.hs view
@@ -7,7 +7,6 @@ import Data.Function (on) import Data.Hashable (Hashable (..)) import Data.List (nubBy)-import Data.Semigroup ((<>)) import Data.Traversable (foldMapDefault) import Data.Word (Word8) import Text.Read (readMaybe)@@ -30,6 +29,7 @@ , testProperty "Hashable agree" $ hashableProperty , testProperty "aeson roundtrip" $ aesonRoundtrip , testProperty "show . read = id" showReadRoundtrip+ , testProperty "Eq respects ordering" eqRespectsOrdering ] , testGroup "Regressions" [ testProperty "issue 10: union overflow" $ issue10@@ -149,6 +149,12 @@ iom = evalOpInsOrd op rhs = Just iom lhs = readMaybe $ show iom++eqRespectsOrdering :: Operation Int Int -> Property+eqRespectsOrdering op = iom == iomRev ==> InsOrd.toList iom === InsOrd.toList iomRev+ where+ iom = evalOpInsOrd op+ iomRev = InsOrd.fromList . reverse . InsOrd.toList $ iom ------------------------------------------------------------------------------- -- Regressions