stm-containers 1.1.0.2 → 1.1.0.3

raw patch · 5 files changed

+63/−20 lines, 5 filesdep ~list-tPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: list-t

API changes (from Hackage documentation)

Files

• library/StmContainers/Bimap.hs +9/−12
• library/StmContainers/Multimap.hs +6/−6
• stm-containers.cabal +4/−2
• test/Main.hs +1/−0
• test/Main/BimapTests.hs +43/−0

@@ -74,18 +74,19 @@ -- or update it and return the new value. {-# INLINE focusLeft #-} focusLeft :: (Eq leftKey, Hashable leftKey, Eq rightKey, Hashable rightKey) => B.Focus rightKey STM result -> leftKey -> Bimap leftKey rightKey -> STM result-focusLeft valueFocus1 leftKey (Bimap leftMap rightMap) =+focusLeft rightFocus leftKey (Bimap leftMap rightMap) =   do -    ((output, change), maybeRightKey) <- A.focus (B.extractingInput (B.extractingChange valueFocus1)) leftKey leftMap+    ((output, change), maybeRightKey) <- A.focus (B.extractingInput (B.extractingChange rightFocus)) leftKey leftMap     case change of       B.Leave ->          return ()       B.Remove -> -        forM_ maybeRightKey $ \ rightKey -> A.delete rightKey rightMap-      B.Set newKey2 ->+        forM_ maybeRightKey $ \ oldRightKey -> A.delete oldRightKey rightMap+      B.Set newRightKey ->         do           forM_ maybeRightKey $ \ rightKey -> A.delete rightKey rightMap-          A.insert leftKey newKey2 rightMap+          maybeReplacedLeftKey <- A.focus (B.lookup <* B.insert leftKey) newRightKey rightMap+          forM_ maybeReplacedLeftKey $ \ replacedLeftKey -> A.delete replacedLeftKey leftMap     return output  -- |@@ -118,19 +119,15 @@ -- Insert the association by the left value. {-# INLINE insertLeft #-} insertLeft :: (Eq leftKey, Hashable leftKey, Eq rightKey, Hashable rightKey) => rightKey -> leftKey -> Bimap leftKey rightKey -> STM ()-insertLeft rightKey leftKey (Bimap leftMap rightMap) = -  do-    A.insert rightKey leftKey leftMap-    A.insert leftKey rightKey rightMap+insertLeft rightKey =+  focusLeft (B.insert rightKey)  -- | -- Insert the association by the right value. {-# INLINE insertRight #-} insertRight :: (Eq leftKey, Hashable leftKey, Eq rightKey, Hashable rightKey) => leftKey -> rightKey -> Bimap leftKey rightKey -> STM () insertRight leftKey rightKey (Bimap leftMap rightMap) = -  do-    A.insert leftKey rightKey rightMap-    A.insert rightKey leftKey leftMap+  insertLeft leftKey rightKey (Bimap rightMap leftMap)  -- | -- Delete the association by the left value.

@@ -12,8 +12,8 @@   deleteByKey,   reset,   unfoldlM,-  unfoldMKeys,-  unfoldMByKey,+  unfoldlMKeys,+  unfoldlMByKey,   listT,   listTKeys,   listTByKey,@@ -149,14 +149,14 @@  -- | -- Stream keys actively.-unfoldMKeys :: Multimap key value -> UnfoldlM STM key-unfoldMKeys (Multimap m) =+unfoldlMKeys :: Multimap key value -> UnfoldlM STM key+unfoldlMKeys (Multimap m) =   fmap fst (A.unfoldlM m)  -- | -- Stream values by a key actively.-unfoldMByKey :: (Eq key, Hashable key) => key -> Multimap key value -> UnfoldlM STM value-unfoldMByKey key (Multimap m) =+unfoldlMByKey :: (Eq key, Hashable key) => key -> Multimap key value -> UnfoldlM STM value+unfoldlMByKey key (Multimap m) =   lift (A.lookup key m) >>= maybe mempty B.unfoldlM  -- |

@@ -1,5 +1,5 @@ name: stm-containers-version: 1.1.0.2+version: 1.1.0.3 synopsis: Containers for STM description:   This library is based on an STM-specialized implementation of@@ -41,7 +41,7 @@   build-depends:     base >=4.9 && <5,     deferred-folds >=0.9 && <0.10,-    focus >=1 && <1.1,+    focus >=1.0.1.3 && <1.1,     hashable <2,     list-t >=1.0.1 && <1.1,     stm-hamt >=1.2 && <1.3,@@ -54,6 +54,7 @@   default-language: Haskell2010   main-is: Main.hs   other-modules:+    Main.BimapTests     Main.MapTests     Main.MapTests.Update   build-depends:@@ -61,6 +62,7 @@     focus,     foldl >=1.4 && <2,     free >=4.6 && <6,+    list-t,     HTF ==0.13.*,     QuickCheck >=2.7 && <3,     quickcheck-text >=0.1.2.1 && <0.2,

@@ -4,6 +4,7 @@ import Prelude  import {-@ HTF_TESTS @-} Main.MapTests+import {-@ HTF_TESTS @-} Main.BimapTests   main = htfMain $ htf_thisModulesTests : htf_importedTests

@@ -0,0 +1,43 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+module Main.BimapTests where++import Prelude+import Test.Framework+import StmContainers.Bimap+import qualified Focus+import qualified ListT++test_construction = do+  m <- newIO :: IO (Bimap Int Int)+  atomically $ insertRight 3 1 m+  atomically $ insertRight 4 2 m+  assertEqual [(3, 1), (4, 2)] =<< atomically (ListT.toList (listT m))++test_deleteLeft = do+  m <- newIO :: IO (Bimap Int Int)+  atomically $ insertRight 3 1 m+  atomically $ insertRight 4 2 m+  atomically $ deleteLeft 4 m+  assertEqual [(3, 1)] =<< atomically (ListT.toList (listT m))++test_deleteRight = do+  m <- newIO :: IO (Bimap Int Int)+  atomically $ insertRight 3 1 m+  atomically $ insertRight 4 2 m+  atomically $ deleteRight 2 m+  assertEqual [(3, 1)] =<< atomically (ListT.toList (listT m))++test_replactingConstruction = do+  m <- newIO :: IO (Bimap Int Int)+  atomically $ insertRight 3 1 m+  atomically $ insertRight 4 2 m+  atomically $ insertRight 3 2 m+  assertEqual [(3, 2)] =<< atomically (ListT.toList (listT m))++test_insertOverwrites = do+  m <- newIO :: IO (Bimap Int Int)+  atomically $ insertRight 3 1 m+  atomically $ insertRight 3 2 m+  assertEqual Nothing =<< atomically (lookupRight 1 m)+  assertEqual (Just 3) =<< atomically (lookupRight 2 m)+  assertEqual (Just 2) =<< atomically (lookupLeft 3 m)