insert-ordered-containers 0.3.0 → 0.3.0.1

raw patch · 6 files changed

+49/−44 lines, 6 filesdep +containersPVP ok

version bump matches the API change (PVP)

Dependencies added: containers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +3/−0
• insert-ordered-containers.cabal +2/−1
• src/Data/HashMap/InsOrd/Internal.hs +27/−32
• src/Data/HashMap/Strict/InsOrd.hs +3/−8
• src/Data/HashSet/InsOrd.hs +2/−3
• test/Tests.hs +12/−0

@@ -1,3 +1,6 @@+- 0.3.0.1+    - Fix quadratic behavior in traverseWithKey/for+ - 0.3.0     - Fix ordering when decoding from JSON (with tests)       https://github.com/erikd/insert-ordered-containers/issues/7

@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               insert-ordered-containers-version:            0.3.0+version:            0.3.0.1 synopsis:   Associative containers retaining insertion order for traversals. @@ -45,6 +45,7 @@   build-depends:     , aeson                 >=2.2.3.0  && <2.3     , base                  >=4.12.0.0 && <4.23+    , containers            >=0.6.0.1     , deepseq               >=1.4.4.0  && <1.6     , hashable              >=1.4.7.0  && <1.6     , indexed-traversable   >=0.1.4    && <0.2

@@ -1,41 +1,36 @@-{-# LANGUAGE GADTs #-} module Data.HashMap.InsOrd.Internal where  import Prelude hiding (filter, foldr, lookup, map, null) -import Control.Applicative ((<**>))+import Data.List (sortBy)+import Data.Ord  (comparing) +import           Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap+import qualified Data.IntMap.Strict  as IntMap+ ---------------------------------------------------------------------------------- SortedAp+-- Ordered traversal ------------------------------------------------------------------------------- --- 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)+-- | Traverse a 'HashMap', sequencing effects in ascending order of the given+-- index rather than in the map's internal order. The result has the same+-- keys as the input. The index must be distinct for every entry.+--+-- O(n log n): sort the entries by index and traverse that list, then look+-- each result up by its index. (This replaces an insertion-sorting free+-- applicative, which was O(n^2).)+traverseWithKeyOrderedBy+    :: Applicative f+    => (a -> Int) -> (k -> a -> f b) -> HashMap k a -> f (HashMap k b)+traverseWithKeyOrderedBy ix f m =+    refill <$> traverse g (sortBy (comparing fst) [(ix a, (k, a)) | (k, a) <- HashMap.toList m])+  where+    g (i, (k, a)) = (,) i <$> f k a -retractSortedAp :: Applicative f => SortedAp f a -> f a-retractSortedAp (Pure x) = pure x-retractSortedAp (SortedAp _ f x) = f <**> retractSortedAp x+    -- Results come back in ascending index order. We reuse m's structure rather+    -- than rebuilding with 'fromList', since that would need 'Hashable k', which+    -- the 'Traversable' instance can't require.+    refill rs =+        let im = IntMap.fromDistinctAscList rs+        in HashMap.map (\a -> im IntMap.! ix a) m

@@ -482,8 +482,8 @@ foldMapWithKey f = foldMap (uncurry f) . toList  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)+traverseWithKey f (InsOrdHashMap n m) = InsOrdHashMap n <$>+    traverseWithKeyOrderedBy getPK (\k (P i v) -> P i <$> f k v) m  ------------------------------------------------------------------------------- -- Unordered@@ -636,15 +636,10 @@ -- 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+fromHashMapP = mk . flip runState 0 . traverseWithKeyOrderedBy getPK (\_ (P _ v) -> newP v)   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

@@ -43,7 +43,7 @@     )where  import Prelude-       (Bool, Eq ((==)), Int, Maybe (..), const, flip, fmap, fst,+       (Bool, Eq ((==)), Int, Maybe (..), const, flip, fmap, fst, id,        maybe, otherwise, return, snd, ($), (&&), (+), (.), (<$), (<$>), (<),        (>), (>=), (||)) @@ -309,10 +309,9 @@ -------------------------------------------------------------------------------  fromHashMapInt :: HashMap k Int -> InsOrdHashSet k-fromHashMapInt = mk . flip runState 0 . retractSortedAp . traverse f+fromHashMapInt = mk . flip runState 0 . traverseWithKeyOrderedBy id (\_ _ -> newInt')   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)

@@ -30,6 +30,7 @@         , testProperty "aeson roundtrip" $ aesonRoundtrip         , testProperty "show . read = id" showReadRoundtrip         , testProperty "Eq respects ordering" eqRespectsOrdering+        , testProperty "traverseWithKey effects in insertion order" traverseWithKeyOrder         ]     , testGroup "Regressions"         [ testProperty "issue 10: union overflow" $ issue10@@ -150,11 +151,22 @@     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++traverseWithKeyOrder :: Operation Word8 Int -> Property+traverseWithKeyOrder op =+    -- effects (which just accumulate key/value pairs here) ran in order:+    effects === InsOrd.toList iom+    .&&. InsOrd.toList iom' === [ (k, v + 1) | (k, v) <- InsOrd.toList iom ]+    .&&. property (InsOrd.valid iom')+  where+    iom = evalOpInsOrd op+    (effects, iom') = InsOrd.traverseWithKey (\k v -> ([(k, v)], v + 1)) iom  ------------------------------------------------------------------------------- -- Regressions