concurrent-resource-map 0.1.0.0 → 0.2.0.0

raw patch · 5 files changed

+153/−33 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +13/−0
• README.md +1/−1
• concurrent-resource-map.cabal +2/−2
• src/Data/ConcurrentResourceMap.hs +108/−19
• test/Spec.hs +29/−11

@@ -1,3 +1,16 @@ # Changelog for concurrent-resource-map  ## Unreleased changes++## 0.2.0.0++* Add `withInitialisedResource` function for querying possibly-missing+  resources.++* Abstract away the underlying map type. You're no longer forced to+  use `Data.Map`. The downside is that you're forced to choose now via+  an instance. This hapens to keep dependencies even more minimal.++## 0.1.0.0++* Initial release.

@@ -1,4 +1,4 @@-# concurrent-resource-map+# concurrent-resource-map [![Build Status](https://travis-ci.com/Fuuzetsu/concurrent-resource-map.svg?branch=master)](https://travis-ci.com/Fuuzetsu/concurrent-resource-map)  User-counted resource map with automatic resource collection, aimed to be used in concurrent setting.

@@ -7,7 +7,7 @@ -- hash: 88961aac04b5bb12c97a5cb17d6ffa38769426d569c941425645c1799284d0f3  name:           concurrent-resource-map-version:        0.1.0.0+version:        0.2.0.0 synopsis:       Concurrent resource map description:    Please see the README on GitHub at <https://github.com/Fuuzetsu/concurrent-resource-map#readme> category:       Data@@ -38,7 +38,6 @@   ghc-options: -O2   build-depends:       base-    , containers   default-language: Haskell2010  test-suite concurrent-resource-map-test@@ -52,6 +51,7 @@   build-depends:       base >=4.8 && <5     , concurrent-resource-map+    , containers     , random     , stm   default-language: Haskell2010

@@ -1,14 +1,16 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-} module Data.ConcurrentResourceMap   ( ConcurrentResourceMap+  , ResourceMap(..)   , newResourceMap+  , withInitialisedResource   , withSharedResource   ) where  import Control.Exception import qualified Control.Concurrent.MVar as MVar import Control.Concurrent.MVar (MVar)-import qualified Data.Map.Strict as Map-import Data.Map.Strict (Map)  data Resource r = Uninitialised | Initialised !r @@ -20,13 +22,24 @@   , resource :: !(Resource r)   } +-- | Resource maps should implement this small set of operations that+-- we expect maps to have.+--+-- This allows you to use whatever fast underlying map type you'd+-- like, depending on your resources.+class ResourceMap m where+  type Key m :: *+  empty :: m v+  delete :: Key m -> m v -> m v+  insert :: Key m -> v -> m v -> m v+  lookup :: Key m -> m v -> Maybe v+ -- | A map of shared resources @r@ keyed by @k@.-newtype ConcurrentResourceMap k r = C-  (MVar (Map k (MVar (CountedResource r))))+newtype ConcurrentResourceMap m v = C (MVar (m (MVar (CountedResource v))))  -- | Create an empty resource map.-newResourceMap :: Ord k => IO (ConcurrentResourceMap k r)-newResourceMap = fmap C $ MVar.newMVar Map.empty+newResourceMap :: ResourceMap m => IO (ConcurrentResourceMap m r)+newResourceMap = fmap C $ MVar.newMVar Data.ConcurrentResourceMap.empty  -- | Use a resource that can be accessed concurrently via multiple -- threads but is only initialised and destroyed on as-needed basis.@@ -38,10 +51,10 @@ -- 'withSharedResource' in a nested matter on same resource key should -- have no real adverse effects either. withSharedResource-  :: Ord k-  => ConcurrentResourceMap k r+  :: ResourceMap m+  => ConcurrentResourceMap m r   -- ^ Resource map. Create with 'newResourceMap'.-  -> k+  -> Key m    -- ^ Key for the resource. This allows you to have many of the same    -- type of resource but separated: for example, one group of    -- threads could be holding onto a logging handle to syslog while@@ -67,7 +80,7 @@   -- blocking other threads from running initialisation again until   -- you've cleaned up the resource yourself.   -> (r -> IO a)-  -- ^ Run an actionwith the initialised resource. Note that the+  -- ^ Run an action with the initialised resource. Note that the   -- availability of this resource only ensures that the user-given   -- initialisers/destructors have been ran appropriate number of   -- times: it of course makes no guarantees as to what the resource@@ -94,34 +107,109 @@           return (cr, r)       act r ++-- | This is like 'withSharedResource' but will only execute the user+-- action if the resource already exists. This is useful if you create+-- your resources in one place but would like to use them+-- conditionally in another place if they are still alive.+--+-- Action is given Nothing if the resource does not exist or is not+-- initialised.+withInitialisedResource+  :: ResourceMap m+  => ConcurrentResourceMap m r+  -- ^ Resource map. Create with 'newResourceMap'.+  -> Key m+   -- ^ Key for the resource. This allows you to have many of the same+   -- type of resource but separated: for example, one group of+   -- threads could be holding onto a logging handle to syslog while+   -- another could be holding a handle to a file.+  -> (r -> IO ())+  -- ^ Destroy the resource if it was initialised. Ran by last alive+  -- user when it's exiting. Unlike initialisation, this _is_ ran in+  -- masked context. If this action fails (by throwing an exception+  -- itself), the resource will be assumed to be uninitialised and the+  -- exception will be re-thrown.+  --+  -- Therefore, if your cleanup can fail in a way that you have to+  -- know about/recover from, you should catch exceptions coming out+  -- out 'withSharedResource'. As you get reference to the resource+  -- in the @act@, you're able to store it/monitor it yourself and+  -- decide to take any appropriate actions in the future such as+  -- blocking other threads from running initialisation again until+  -- you've cleaned up the resource yourself.+  -> (Maybe r -> IO a)+  -- ^ Run an action with the resource. Note that the availability of+  -- this resource only ensures that the user-given+  -- initialisers/destructors have been ran appropriate number of+  -- times: it of course makes no guarantees as to what the resource+  -- represents. For example, if it's a 'System.Process.ProcessHandle'+  -- or a database connection, there's no guarantee that the process+  -- is alive or that the database connection is still available. For+  -- resources that can dynamically fail, you should implement some+  -- sort of monitoring yourself.+  -> IO a+withInitialisedResource vm k destroyResource act = bracket+  (addUserIfPresent vm k)+  removeUserIfPresent+  actWithResource+  where+    removeUserIfPresent Nothing = pure ()+    removeUserIfPresent (Just rvar) = removeUser vm k destroyResource rvar++    actWithResource Nothing = act Nothing+    actWithResource (Just rvar) = MVar.readMVar rvar >>= \cr -> case cr of+        CountedResource { resource = Initialised r } -> act (Just r)+        _ -> act Nothing+ -- | Adds a user at given key. If it's the first user, creates the -- underlying map. -- -- Should be used as initialising action in 'bracket' along with -- 'removeUser'. addUser-    :: Ord k-    => ConcurrentResourceMap k r -> k -> IO (MVar (CountedResource r))-addUser (C vm) k = MVar.modifyMVar vm $ \m -> case Map.lookup k m of+    :: ResourceMap m+    => ConcurrentResourceMap m r -> Key m -> IO (MVar (CountedResource r))+addUser (C vm) k = MVar.modifyMVar vm $ \m -> case Data.ConcurrentResourceMap.lookup k m of   -- We're the first user of this resource, make the counted   -- resource.   Nothing -> do     v <- MVar.newMVar CountedResource { users = 1, resource = Uninitialised }-    return (Map.insert k v m, v)+    return (Data.ConcurrentResourceMap.insert k v m, v)   -- Other users already exist, increase the count only.   Just vc -> do     MVar.modifyMVar_ vc $ \cr ->       return cr { users = users cr + 1 }     return (m, vc) ++-- | Adds a user at given key but only if the given key already exists..+--+-- Should be used as initialising action in 'bracket' along with+-- 'removeUser'.+addUserIfPresent+    :: ResourceMap m+    => ConcurrentResourceMap m r+    -> Key m+    -> IO (Maybe (MVar (CountedResource r)))+addUserIfPresent (C vm) k = MVar.modifyMVar vm $ \m -> case Data.ConcurrentResourceMap.lookup k m of+  -- We're the first user of this resource, make the counted+  -- resource.+  Nothing -> return (m, Nothing)+  -- Other users already exist, increase the count only.+  Just vc -> do+    MVar.modifyMVar_ vc $ \cr ->+      return cr { users = users cr + 1 }+    return (m, Just vc)+ -- | Remove user for the given key. If it's the last user, removes the -- counted resource from the map completely. -- -- Should be used as cleanup action in 'bracket' along with 'addUser'. removeUser-  :: Ord k-  => ConcurrentResourceMap k r-  -> k+  :: ResourceMap m+  => ConcurrentResourceMap m r+  -> Key m   -- ^ The resource from inside the map.   -> (r -> IO ())   -- ^ Destroy resource.@@ -150,7 +238,7 @@     -- around, simply replace the content with updated user counter.     _ -> MVar.putMVar vc cr'   where-    cleanFromResourceMap = MVar.modifyMVar_ vm $ \m -> case Map.lookup k m of+    cleanFromResourceMap = MVar.modifyMVar_ vm $ \m -> case Data.ConcurrentResourceMap.lookup k m of       -- The resource is not even in the map anymore. This could       -- happen if since we decreased the count, a new user came in,       -- increased the count, finished and cleaned up before we did.@@ -165,7 +253,8 @@           -- only user holding a useful reference to the MVar as it           -- can only be created and passed from addUser and it's           -- internal API. Remove it from the map.-          Just CountedResource { users = 0 } -> return (Map.delete k m)+          Just CountedResource { users = 0 } ->+            return (Data.ConcurrentResourceMap.delete k m)           -- We were able to take the MVar but there are some other           -- users around again: we want to keep the original map. Put           -- the value back and keep original the original mapping.

@@ -1,3 +1,4 @@+{-# LANGUAGE TypeFamilies #-} module Main (main) where  import Control.Concurrent@@ -6,6 +7,7 @@ import Control.Monad import Data.ConcurrentResourceMap import Data.IORef+import qualified Data.IntMap.Strict as IntMap import Data.Typeable import System.Random @@ -40,24 +42,40 @@   deriving (Typeable, Show) instance Exception IntentionalFailure +newtype SirMap v = M (IntMap.IntMap v)++instance ResourceMap SirMap where+  type Key SirMap = Int+  empty = M IntMap.empty+  delete k (M m) = M (IntMap.delete k m)+  insert k v (M m) = M (IntMap.insert k v m)+  lookup k (M m) = IntMap.lookup k m+ main :: IO () main = do-  m <- newResourceMap+  m <- newResourceMap :: IO (ConcurrentResourceMap SirMap SingleInitResource)   leftThreads <- newTVarIO numThreads   sirs <- fmap (zip [0 :: Int .. ]) $ replicateM 10 newSIR    replicateM_ numThreads $ forkIO $ do     let act [] = return ()-        act ((k, sir):ss) = withSharedResource m k-          (fragileInit sir >> return sir)-          (\r -> smallDelay >> destroySIR r)-          -- Introduce small delay to allow for resource contention-          -- instead of most threads executing instantly creating a fairly-          -- sequenential test scenario.-          ---          -- Further, this tests that we can nest withSharedResource.-          (\r -> smallDelay >> checkInitialised r >> act ss)-        -- Always modify thread exit count when main action finishes.+        act ((k, sir):ss) = do+          -- Third of the time, use withInitialisedResource instead.+          withResource <- do+            useWithInitialised <- fmap (== 1) $ randomRIO (1, 3 :: Int)+            pure $ if useWithInitialised+              then \m k i d r -> withInitialisedResource m k d (mapM_ r)+              else withSharedResource+          withResource m k+            (fragileInit sir >> return sir)+            (\r -> smallDelay >> destroySIR r)+            -- Introduce small delay to allow for resource contention+            -- instead of most threads executing instantly creating a fairly+            -- sequenential test scenario.+            --+            -- Further, this tests that we can nest withSharedResource.+            (\r -> smallDelay >> checkInitialised r >> act ss)+            -- Always modify thread exit count when main action finishes.          actIncr = act sirs `finally` atomically (modifyTVar' leftThreads pred)         -- Silence intentional failures, no need to pollute test