insert-ordered-containers 0.2.0.0 → 0.2.1.0

raw patch · 4 files changed

+167/−34 lines, 4 filesdep ~QuickCheckdep ~aesondep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: QuickCheck, aeson, base, base-compat, lens, semigroupoids, tasty, tasty-quickcheck

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• insert-ordered-containers.cabal +14/−18
• src/Data/HashMap/Strict/InsOrd.hs +88/−8
• test/Tests.hs +56/−8

@@ -1,3 +1,12 @@+- 0.2.1.0+    - Fix `Traversable`, `TraversableWithIndex`, `FoldableWithIndex` to traverse+      in insertion order+      ([#12](https://github.com/phadej/insert-ordered-containers/issues/12))+    - Add `unorderedTraverse`, `unorderedTraverseWithKey`, `unoderedFoldMap`, and+      `unorderedFoldMapWithKey`.+    - `union` doesn't overflow the internal counter+      ([#10](https://github.com/phadej/insert-ordered-containers/issues/10))+ - 0.2.0.0     - Use `aeson-1`     - removed our `FromJSONKey` and `ToJSONKey` in favour of `aeson` variants

@@ -1,9 +1,5 @@--- This file has been generated from package.yaml by hpack version 0.14.0.------ see: https://github.com/sol/hpack- name:           insert-ordered-containers-version:        0.2.0.0+version:        0.2.1.0 synopsis:       Associative containers retating insertion order for traversals. description:    Associative containers retating insertion order for traversals. category:       Web@@ -31,10 +27,10 @@   ghc-options: -Wall   build-depends:       base                  >=4.6      && <4.10-    , aeson                 >=1.0.0.0  && <1.1+    , 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.15+    , lens                  >=4.7      && <4.16     , semigroupoids         >=4.3      && <5.2     , semigroups            >=0.16.2.2 && <0.19     , text                  >=1.2.0.6  && <1.3@@ -51,19 +47,19 @@       test   ghc-options: -Wall   build-depends:-      base                  >=4.6      && <4.10-    , aeson                 >=1.0.0.0  && <1.1-    , base-compat           >=0.6.0    && <0.10-    , hashable              >=1.2.3.3  && <1.4-    , lens                  >=4.7      && <4.15-    , 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+      base+    , aeson+    , base-compat+    , hashable+    , lens+    , semigroupoids+    , semigroups+    , text+    , transformers+    , 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.9+    , QuickCheck        >=2.7.6     && <2.10   default-language: Haskell2010

@@ -4,6 +4,7 @@ {-# LANGUAGE DeriveFunctor         #-} {-# LANGUAGE DeriveTraversable     #-} {-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE Trustworthy           #-}@@ -39,6 +40,9 @@     traverseKeys,     mapWithKey,     traverseWithKey,+    -- ** Unordered+    unorderedTraverse,+    unorderedTraverseWithKey,     -- * Difference and intersection     difference,     intersection,@@ -49,6 +53,10 @@     foldlWithKey',     foldr,     foldrWithKey,+    foldMapWithKey,+    -- ** Unordered+    unorderedFoldMap,+    unorderedFoldMapWithKey,     -- * Filter     filter,     filterWithKey,@@ -76,6 +84,7 @@ import Prelude        () import Prelude.Compat hiding (filter, foldr, lookup, map, null) +import           Control.Applicative             (Const (..), (<**>)) import           Control.Arrow                   (first, second) import           Data.Aeson import qualified Data.Aeson.Encoding             as E@@ -92,8 +101,8 @@ import           Text.Read                       (Lexeme (..), Read (..), lexP,                                                   parens, readListPrecDefault) -import Control.Lens                     (At (..), FoldableWithIndex,-                                         FunctorWithIndex, Index, Iso, IxValue,+import Control.Lens                     (At (..), FoldableWithIndex (..),+                                         FunctorWithIndex (..), Index, Iso, IxValue,                                          Ixed (..), TraversableWithIndex (..),                                          Traversal, iso, (<&>), _1, _2) import Control.Monad.Trans.State.Strict (State, runState, state)@@ -180,8 +189,7 @@ #endif  instance Traversable (InsOrdHashMap k) where-    traverse f (InsOrdHashMap i m) =-        InsOrdHashMap i <$> (traverse . traverse) f m+    traverse f m = traverseWithKey (\_ -> f) m  instance (Eq k, Hashable k) => Apply (InsOrdHashMap k) where     (<.>) = intersectionWith id@@ -248,8 +256,10 @@       where mv = lookup k m     {-# INLINABLE at #-} -instance (Eq k, Hashable k) => FunctorWithIndex k (InsOrdHashMap k)-instance (Eq k, Hashable k) => FoldableWithIndex k (InsOrdHashMap k)+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 @@ -351,8 +361,11 @@     => (v -> v -> v)     -> InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v unionWith f (InsOrdHashMap i a) (InsOrdHashMap j b) =-    InsOrdHashMap (i + j) $ HashMap.unionWith f' a b'+    mk $ HashMap.unionWith f' a b'   where+    -- the threshold is arbitrary, it meant to amortise need for packing of indices+    mk | i > 0xfffff || j >= 0xfffff = fromHashMapP+       | otherwise                   = InsOrdHashMap (i + j)     b' = fmap (incPK i) b     f' (P ii x) (P _ y) = P ii (f x y) @@ -400,8 +413,65 @@   where     f' k (P j x) = P j (f k x) +foldMapWithKey :: Monoid m => (k -> a -> m) -> InsOrdHashMap k a -> m+foldMapWithKey f = foldMap (uncurry f) . toList+ traverseWithKey :: Applicative f => (k -> a -> f b) -> InsOrdHashMap k a -> f (InsOrdHashMap k b)-traverseWithKey f (InsOrdHashMap i m) =+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+-------------------------------------------------------------------------------++-- | More efficient than 'foldMap', when folding in insertion order is not important.+unorderedFoldMap :: Monoid m => (a -> m) -> InsOrdHashMap k a -> m+unorderedFoldMap f (InsOrdHashMap _ m) = foldMap (f . getPV) m++-- | More efficient than 'foldMapWithKey', when folding in insertion order is not important.+unorderedFoldMapWithKey :: Monoid m => (k -> a -> m) -> InsOrdHashMap k a -> m+unorderedFoldMapWithKey f m =+    getConst (unorderedTraverseWithKey (\k a -> Const (f k a)) m)++-- | More efficient than 'traverse', when traversing in insertion order is not important.+unorderedTraverse :: Applicative f => (a -> f b) -> InsOrdHashMap k a -> f (InsOrdHashMap k b)+unorderedTraverse f (InsOrdHashMap i m) =+    InsOrdHashMap i <$> (traverse . traverse) f m++-- | More efficient than `traverseWithKey`, when traversing in insertion order is not important.+unorderedTraverseWithKey :: Applicative f => (k -> a -> f b) -> InsOrdHashMap k a -> f (InsOrdHashMap k b)+unorderedTraverseWithKey f (InsOrdHashMap i m) =     InsOrdHashMap i <$> HashMap.traverseWithKey f' m   where     f' k (P j x) = P j <$> f k x@@ -531,6 +601,16 @@ ------------------------------------------------------------------------------- -- Internal -------------------------------------------------------------------------------++-- TODO: more efficient way is to do two traversals+-- - collect the indexes+-- - pack the indexes (Map old new)+-- - traverse second time, changing the indexes+fromHashMapP :: HashMap k (P v) -> InsOrdHashMap k v+fromHashMapP = mk . flip runState 0 . retractSortedAp . traverse f+  where+    mk (m, i) = InsOrdHashMap i m+    f (P i v) = liftSortedAp i (newP v)  -- | Test if the internal map structure is valid. valid :: InsOrdHashMap k v -> Bool

@@ -3,10 +3,12 @@ import Prelude        () import Prelude.Compat +import Control.Lens   (folded, ifolded, (^..), (^@..)) 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) @@ -19,14 +21,23 @@ import Test.Tasty.QuickCheck  main :: IO ()-main = defaultMain $ testGroup "Properties" $-    [ testProperty "toList . fromList ~= id" $ toListFromList-    , testProperty "toList distributes over mappend" $ toListMappendDistribute-    , testProperty "behaves like HashMap" $ operationModel-    , testProperty "valid" $ validProperty-    , testProperty "Hashable agree" $ hashableProperty-    , testProperty "aeson roundtrip" $ aesonRoundtrip-    , testProperty "show . read = id" showReadRoundtrip+main = defaultMain $ testGroup "tests"+    [ testGroup "Properties" $+        [ testProperty "toList . fromList ~= id" $ toListFromList+        , testProperty "toList distributes over mappend" $ toListMappendDistribute+        , testProperty "behaves like HashMap" $ operationModel+        , testProperty "valid" $ validProperty+        , testProperty "Hashable agree" $ hashableProperty+        , testProperty "aeson roundtrip" $ aesonRoundtrip+        , testProperty "show . read = id" showReadRoundtrip+        ]+    , testGroup "Regressions"+        [ testProperty "issue 10: union overflow" $ issue10+        , testProperty "issue 12 Foldable" $ issue12a+        , testProperty "issue 12 Traversable" $ issue12b+        , testProperty "issue 12 FoldableWithIndex ^.." $ issue12c+        , testProperty "issue 12 FoldableWithIndex ^@.." $ issue12d+        ]     ]  toListFromList :: [(Int, Int)] -> Property@@ -138,3 +149,40 @@     iom = evalOpInsOrd op     rhs = Just iom     lhs = readMaybe $ show iom++-------------------------------------------------------------------------------+-- Regressions+-------------------------------------------------------------------------------++issue12a :: Property+issue12a = (m ^.. folded) === "wold"+  where+    m :: InsOrd.InsOrdHashMap Char Char+    m = InsOrd.fromList  (zip "hello" "world")++issue12b :: Property+issue12b = foldMapDefault (:[]) m === "wold"+  where+    m :: InsOrd.InsOrdHashMap Char Char+    m = InsOrd.fromList  (zip "hello" "world")++issue12c :: Property+issue12c = (m ^.. ifolded) === "wold"+  where+    m :: InsOrd.InsOrdHashMap Char Char+    m = InsOrd.fromList  (zip "hello" "world")++issue12d :: Property+issue12d = (m ^@.. ifolded) === (zip "helo" "wold")+  where+    m :: InsOrd.InsOrdHashMap Char Char+    m = InsOrd.fromList  (zip "hello" "world")+++issue10 :: Property+issue10 = (p ^.. folded) === "wold!" .&&. property (InsOrd.valid p)+  where+    m, n, p :: InsOrd.InsOrdHashMap Char Char+    m = InsOrd.fromList  (zip "hello" "world")+    n = iterate (\x -> InsOrd.union x x) m !! 64+    p = InsOrd.insert '!' '!' n