packages feed

insert-ordered-containers 0.2.7 → 0.3.0.1

raw patch · 6 files changed

Files

CHANGELOG.md view
@@ -1,4 +1,13 @@-- 0.2.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+      This is a breaking change.+    - GHC-9.14.1 support++- 0.2.7     - Support GHC-8.6.5...9.12.1     - Haskell code modernisation
insert-ordered-containers.cabal view
@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               insert-ordered-containers-version:            0.2.7+version:            0.3.0.1 synopsis:   Associative containers retaining insertion order for traversals. @@ -26,8 +26,9 @@    || ==9.4.8    || ==9.6.7    || ==9.8.4-   || ==9.10.1-   || ==9.12.1+   || ==9.10.3+   || ==9.12.2+   || ==9.14.1  extra-source-files:   CHANGELOG.md@@ -40,10 +41,11 @@ library   default-language: Haskell2010   hs-source-dirs:   src-  ghc-options:      -Wall+  ghc-options:      -Wall -Wunused-packages   build-depends:     , aeson                 >=2.2.3.0  && <2.3-    , base                  >=4.12.0.0 && <4.22+    , 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@@ -51,7 +53,6 @@     , optics-core           >=0.4.1.1  && <0.5     , optics-extra          >=0.4.2.1  && <0.5     , semigroupoids         >=6.0.1    && <6.1-    , text                  >=1.2.3.0  && <1.3  || >=2.0     && <2.2     , transformers          >=0.5.6.2  && <0.7     , unordered-containers  >=0.2.20   && <0.3 @@ -76,9 +77,7 @@     , hashable     , insert-ordered-containers     , lens-    , QuickCheck                 >=2.13.2   && <2.16-    , semigroupoids+    , QuickCheck                 >=2.13.2   && <2.19     , tasty                      >=0.10.1.2 && <1.6     , tasty-quickcheck           >=0.8.3.2  && <0.12-    , text     , unordered-containers
src/Data/HashMap/InsOrd/Internal.hs view
@@ -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
src/Data/HashMap/Strict/InsOrd.hs view
@@ -109,7 +109,7 @@  import qualified Control.Lens        as Lens import qualified Data.Aeson          as A-import qualified Data.Aeson.Encoding as E+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@@ -183,7 +183,7 @@     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) $@@ -238,25 +238,37 @@ -- Aeson ------------------------------------------------------------------------------- -instance (A.ToJSONKey k) => A.ToJSON1 (InsOrdHashMap k) where-    liftToJSON _ t _ = case A.toJSONKey :: A.ToJSONKeyFunction k of-      A.ToJSONKeyText f _ -> A.object . fmap (\(k, v) -> (f k, t v)) . toList-      A.ToJSONKeyValue f _ -> A.toJSON . fmap (\(k,v) -> A.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 o t _ = case A.toJSONKey :: A.ToJSONKeyFunction k of-      A.ToJSONKeyText _ f ->  E.dict f t foldrWithKey-      A.ToJSONKeyValue _ f -> E.list (A.liftToEncoding2 (const False) f (E.list f) o 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 (A.ToJSONKey k, A.ToJSON v) => A.ToJSON (InsOrdHashMap k v) where+instance (A.ToJSON k, A.ToJSON v) => A.ToJSON (InsOrdHashMap k v) where     toJSON = A.toJSON1     toEncoding = A.toEncoding1  ------------------------------------------------------------------------------- -instance (Eq k, Hashable k, A.FromJSONKey k) => A.FromJSON1 (InsOrdHashMap k) where-    liftParseJSON o p pl v = fromList . HashMap.toList <$> A.liftParseJSON o 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, A.FromJSONKey k, A.FromJSON v) => A.FromJSON (InsOrdHashMap k v) where+instance (Eq k, Hashable k, A.FromJSON k, A.FromJSON v) => A.FromJSON (InsOrdHashMap k v) where     parseJSON = A.parseJSON1  -------------------------------------------------------------------------------@@ -470,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@@ -624,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
src/Data/HashSet/InsOrd.hs view
@@ -43,13 +43,13 @@     )where  import Prelude-       (Bool, Eq ((==)), Int, Maybe (..), const, flip, fmap, fst,+       (Bool, Eq ((==)), Int, Maybe (..), const, flip, fmap, fst, id,        maybe, otherwise, return, snd, ($), (&&), (+), (.), (<$), (<$>), (<),        (>), (>=), (||))  import Control.Arrow                   (first) import Control.DeepSeq                 (NFData (..))-import Data.Data                       (Data, Typeable)+import Data.Data                       (Data) import Data.Foldable                   (Foldable (foldMap), all) import Data.Hashable                   (Hashable (..)) import Data.List                       (nub, sortBy)@@ -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)
test/Tests.hs view
@@ -29,6 +29,8 @@         , testProperty "Hashable agree" $ hashableProperty         , 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@@ -148,6 +150,23 @@     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++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