packages feed

tmapmvar 0.0.3 → 0.0.4

raw patch · 4 files changed

+114/−90 lines, 4 filesdep ~base

Dependency ranges changed: base

Files

src/Control/Concurrent/STM/TMapMVar.hs view
@@ -4,7 +4,7 @@ import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Control.Monad (void)-import Control.Concurrent.STM (STM, atomically)+import Control.Concurrent.STM (STM) import Control.Concurrent.STM.TVar (TVar, newTVar, modifyTVar', readTVar) import Control.Concurrent.STM.TMVar (TMVar, readTMVar, tryReadTMVar, newEmptyTMVar, takeTMVar, tryTakeTMVar, swapTMVar, putTMVar) @@ -36,41 +36,41 @@   -- | Blocks if it's full-insert :: (Ord k) => TMapMVar k a -> k -> a -> IO ()+insert :: (Ord k) => TMapMVar k a -> k -> a -> STM () insert t k a = do   x <- getTMVar t k-  atomically $ putTMVar x a+  putTMVar x a  -- | Doesn't Block-insertForce :: (Ord k) => TMapMVar k a -> k -> a -> IO ()+insertForce :: (Ord k) => TMapMVar k a -> k -> a -> STM () insertForce t k a = do   x <- getTMVar t k-  atomically $ putForceTMVar x a+  putForceTMVar x a   -- | Blocks, and deletes upon looking it up-lookup :: (Ord k) => TMapMVar k a -> k -> IO a+lookup :: (Ord k) => TMapMVar k a -> k -> STM a lookup t k = do   x <- getTMVar t k-  atomically $ takeTMVar x+  takeTMVar x -tryLookup :: (Ord k) => TMapMVar k a -> k -> IO (Maybe a)+tryLookup :: (Ord k) => TMapMVar k a -> k -> STM (Maybe a) tryLookup t k = do   x <- getTMVar t k-  atomically $ tryTakeTMVar x+  tryTakeTMVar x  -- | Blocks, but doesn't delete when looking it up-observe :: (Ord k) => TMapMVar k a -> k -> IO a+observe :: (Ord k) => TMapMVar k a -> k -> STM a observe t k = do   x <- getTMVar t k-  atomically $ readTMVar x+  readTMVar x -tryObserve :: (Ord k) => TMapMVar k a -> k -> IO (Maybe a)+tryObserve :: (Ord k) => TMapMVar k a -> k -> STM (Maybe a) tryObserve t k = do   x <- getTMVar t k-  atomically $ tryReadTMVar x+  tryReadTMVar x -delete :: (Ord k) => TMapMVar k a -> k -> IO ()+delete :: (Ord k) => TMapMVar k a -> k -> STM () delete t k =   void $ tryLookup t k @@ -78,8 +78,8 @@  -- * Utils -getTMVar :: (Ord k) => TMapMVar k a -> k -> IO (TMVar a)-getTMVar (TMapMVar m) k = atomically $ do+getTMVar :: (Ord k) => TMapMVar k a -> k -> STM (TMVar a)+getTMVar (TMapMVar m) k = do   m' <- readTVar m   case Map.lookup k m' of     Nothing -> do
src/Control/Concurrent/STM/TMapMVar/Hash.hs view
@@ -5,7 +5,7 @@ import Data.Hashable (Hashable) import qualified Data.HashMap.Strict as HashMap import Control.Monad (void)-import Control.Concurrent.STM (STM, atomically)+import Control.Concurrent.STM (STM) import Control.Concurrent.STM.TVar (TVar, newTVar, modifyTVar', readTVar) import Control.Concurrent.STM.TMVar (TMVar, readTMVar, tryReadTMVar, newEmptyTMVar, takeTMVar, tryTakeTMVar, swapTMVar, putTMVar) @@ -37,41 +37,41 @@   -- | Blocks if it's full-insert :: (Eq k, Hashable k) => TMapMVar k a -> k -> a -> IO ()+insert :: (Eq k, Hashable k) => TMapMVar k a -> k -> a -> STM () insert t k a = do   x <- getTMVar t k-  atomically $ putTMVar x a+  putTMVar x a  -- | Doesn't Block-insertForce :: (Eq k, Hashable k) => TMapMVar k a -> k -> a -> IO ()+insertForce :: (Eq k, Hashable k) => TMapMVar k a -> k -> a -> STM () insertForce t k a = do   x <- getTMVar t k-  atomically $ putForceTMVar x a+  putForceTMVar x a   -- | Blocks, and deletes upon looking it up-lookup :: (Eq k, Hashable k) => TMapMVar k a -> k -> IO a+lookup :: (Eq k, Hashable k) => TMapMVar k a -> k -> STM a lookup t k = do   x <- getTMVar t k-  atomically $ takeTMVar x+  takeTMVar x -tryLookup :: (Eq k, Hashable k) => TMapMVar k a -> k -> IO (Maybe a)+tryLookup :: (Eq k, Hashable k) => TMapMVar k a -> k -> STM (Maybe a) tryLookup t k = do   x <- getTMVar t k-  atomically $ tryTakeTMVar x+  tryTakeTMVar x  -- | Blocks, but doesn't delete when looking it up-observe :: (Eq k, Hashable k) => TMapMVar k a -> k -> IO a+observe :: (Eq k, Hashable k) => TMapMVar k a -> k -> STM a observe t k = do   x <- getTMVar t k-  atomically $ readTMVar x+  readTMVar x -tryObserve :: (Eq k, Hashable k) => TMapMVar k a -> k -> IO (Maybe a)+tryObserve :: (Eq k, Hashable k) => TMapMVar k a -> k -> STM (Maybe a) tryObserve t k = do   x <- getTMVar t k-  atomically $ tryReadTMVar x+  tryReadTMVar x -delete :: (Eq k, Hashable k) => TMapMVar k a -> k -> IO ()+delete :: (Eq k, Hashable k) => TMapMVar k a -> k -> STM () delete t k =   void $ tryLookup t k @@ -79,8 +79,8 @@  -- * Utils -getTMVar :: (Eq k, Hashable k) => TMapMVar k a -> k -> IO (TMVar a)-getTMVar (TMapMVar m) k = atomically $ do+getTMVar :: (Eq k, Hashable k) => TMapMVar k a -> k -> STM (TMVar a)+getTMVar (TMapMVar m) k = do   m' <- readTVar m   case HashMap.lookup k m' of     Nothing -> do
test/Spec.hs view
@@ -35,8 +35,9 @@ insertInEmpty :: Int -> Int -> Property insertInEmpty k v = ioProperty $ do   var <- atomically newTMapMVar-  TMapMVar.insert var k v-  v' <- TMapMVar.observe var k+  v' <- atomically $ do+    TMapMVar.insert var k v+    TMapMVar.observe var k   pure (v == v')  @@ -44,40 +45,45 @@ insertInFull k v = ioProperty $ do   var <- do     m <- atomically newTMapMVar-    TMapMVar.insert m k (v-1)+    atomically $ TMapMVar.insert m k (v-1)     pure m   async $ do     threadDelay 10-    TMapMVar.delete var k-  TMapMVar.insert var k v-  v' <- TMapMVar.lookup var k+    atomically $ TMapMVar.delete var k+  v' <- atomically $ do+    TMapMVar.insert var k v+    TMapMVar.lookup var k   pure (v == v')   insertForceDoesntBlock :: Int -> Int -> Int -> Property insertForceDoesntBlock k v1 v2 = ioProperty $ do   var <- atomically newTMapMVar-  TMapMVar.insert var k v1-  TMapMVar.insertForce var k v2-  v' <- TMapMVar.lookup var k+  v' <- atomically $ do+    TMapMVar.insert var k v1+    TMapMVar.insertForce var k v2+    TMapMVar.lookup var k   pure (v' == v2)   emptyAfterLookup :: Int -> Int -> Property emptyAfterLookup k v = ioProperty $ do   var <- atomically newTMapMVar-  TMapMVar.insert var k v-  _ <- TMapMVar.lookup var k-  mV' <- TMapMVar.tryObserve var k+  mV' <- atomically $ do+    TMapMVar.insert var k v+    TMapMVar.delete var k+    TMapMVar.tryObserve var k   pure (mV' == Nothing)   nonMutativeObserve :: Int -> Int -> Property nonMutativeObserve k v = ioProperty $ do   var <- atomically newTMapMVar-  TMapMVar.insert var k v-  v1 <- TMapMVar.observe var k-  v2 <- TMapMVar.observe var k+  (v1,v2) <- atomically $ do+    TMapMVar.insert var k v+    v1' <- TMapMVar.observe var k+    v2' <- TMapMVar.observe var k+    pure (v1',v2')   pure (v1 == v2 && v2 == v)  @@ -86,6 +92,6 @@   var <- atomically newTMapMVar   async $ do     threadDelay 10-    TMapMVar.insert var k v-  v' <- TMapMVar.lookup var k+    atomically $ TMapMVar.insert var k v+  v' <- atomically $ TMapMVar.lookup var k   pure (v' == v)
tmapmvar.cabal view
@@ -1,45 +1,63 @@-name:                tmapmvar-version:             0.0.3-synopsis:            A single-entity stateful Map in STM, similar to tmapchan--- description:-homepage:            https://github.com/athanclark/tmapmvar#readme-license:             BSD3-license-file:        LICENSE-author:              Athan Clark-maintainer:          athan.clark@gmail.com-copyright:           2017 Athan Clark-category:            Data-build-type:          Simple-extra-source-files:  README.md-cabal-version:       >=1.10+-- This file has been generated from package.yaml by hpack version 0.21.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 6dee76e4c802835ab45bbb37cd6c71a032a7d1fc5569bd5c505b4465dd840551 -library-  hs-source-dirs:      src-  exposed-modules:     Control.Concurrent.STM.TMapMVar-                       Control.Concurrent.STM.TMapMVar.Hash-  build-depends:       base >= 4.8 && < 5-                     , containers-                     , hashable-                     , stm-                     , unordered-containers-  default-language:    Haskell2010+name:           tmapmvar+version:        0.0.4+synopsis:       A single-entity stateful Map in STM, similar to tmapchan+description:    Please see the README on Github at <https://git.localcooking.com/tooling/tmapmvar#readme>+author:         Athan Clark+maintainer:     athan.clark@localcooking.com+copyright:      2018 Local Cooking Inc.+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10 -test-suite tmapmvar-test-  type:                exitcode-stdio-1.0-  hs-source-dirs:      test-  main-is:             Spec.hs-  build-depends:       base-                     , tmapmvar-                     , async-                     , containers-                     , QuickCheck-                     , quickcheck-instances-                     , stm-                     , tasty-                     , tasty-quickcheck-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N-  default-language:    Haskell2010+extra-source-files:+    README.md  source-repository head-  type:     git-  location: https://github.com/athanclark/tmapmvar+  type: git+  location: git://git.localcooking.com/tooling/tmapmvar.git++library+  exposed-modules:+      Control.Concurrent.STM.TMapMVar+      Control.Concurrent.STM.TMapMVar.Hash+  other-modules:+      Paths_tmapmvar+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      base >=4.7 && <5+    , containers+    , hashable+    , stm+    , unordered-containers+  default-language: Haskell2010++test-suite tmapmvar-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_tmapmvar+  hs-source-dirs:+      test+  ghc-options: -Wall -threaded -rtsopts -Wall -with-rtsopts=-N+  build-depends:+      QuickCheck+    , async+    , base >=4.7 && <5+    , containers+    , hashable+    , quickcheck-instances+    , stm+    , tasty+    , tasty-quickcheck+    , tmapmvar+    , unordered-containers+  default-language: Haskell2010