persistent-map 0.1.1 → 0.2.2
raw patch · 5 files changed
+60/−39 lines, 5 files
Files
- Data/TMap.hs +32/−27
- Data/TMap/Backend/Binary.hs +11/−3
- Data/TStorage.hs +1/−1
- Sample.hs +8/−5
- persistent-map.cabal +8/−3
Data/TMap.hs view
@@ -24,7 +24,7 @@ member, adjust, -- * Handling the size of the TMap - purgeTMap, +-- purgeTMap, purgeTMapIO, getMaximumSize, setMaximumSize, @@ -42,8 +42,8 @@ import Control.Monad( liftM, when ) import Control.Monad.Trans( MonadIO, liftIO ) -import qualified Control.Exception as Exc-import Data.Maybe( isJust )+import qualified Control.Exception as E+import Data.Maybe( isJust, isNothing ) import Prelude hiding (lookup,catch) import qualified Data.TMap.Backend as B@@ -59,12 +59,15 @@ data Entry a = Entry a -- ^ Cache hit | NotInTMap -- ^ Cache miss | NotInBackend -- ^ Element exists neither in backend nor in cache- deriving (Show,Eq)+ | Exc E.SomeException -- ^ An exception occurred in the retry IO action+ deriving (Show) + instance Functor Entry where fmap _ NotInBackend = NotInBackend fmap _ NotInTMap = NotInTMap fmap f (Entry a) = Entry (f a)+ fmap _ (Exc e) = Exc e data TMap map k a b c = TMap @@ -131,8 +134,9 @@ -- onCommit $ print ("NewAccess List: ",C.toList $ C.hit k accSeq) return $ Just v NotInBackend -> return Nothing- NotInTMap -> retryWith $ do --- print $ "Lookup: Didn't find " ++ show k ++ ", retrying lookup..."+ Exc e -> E.throw e+ NotInTMap -> retryWith $ E.handle onExc $ do +-- print $ "Lookup: Didn't find key retrying lookup..." result <- B.lookup (backend tmap) k case result of Nothing -> do @@ -147,7 +151,15 @@ writeTVar (tmapTVar tmap) ( M.insert k (Entry v) themap' , C.hit k accSeq') -- onCommit $ print ("Access List: ",C.toList $ C.hit k accSeq')+ where+ -- Sends backend exceptions back to the STM monad:+ onExc (e::E.SomeException) = do+ -- print "BACKEND EXCEPTION!"+ atomically $ do+ (themap',accSeq') <- readTVar (tmapTVar tmap)+ writeTVar (tmapTVar tmap) (M.insert k (Exc e) themap', accSeq') + -- | Checks whether the given key is in the map. member :: (M.FiniteMapX map k, MonadAdvSTM m, Ord k, B.Backend k a b,C.CacheStructure c k) => k -> TMap map k a b c -> m Bool@@ -160,13 +172,10 @@ => k -> a -> TMap map k a b c -> m () insert k a tmap = do res <- lookup k tmap - case res of- Just _ -> Exc.throw $ DuplicateEntry -- (show (k,v))- Nothing -> do- (themap,accSeq) <- readTVar (tmapTVar tmap)- writeTVar (tmapTVar tmap) ( M.insert k (Entry a) themap- , C.hit k accSeq)- onCommit $ B.insert (backend tmap) k a+ when (isJust res) $ E.throw $ DuplicateEntry -- (show (k,v))+ (themap,accSeq) <- readTVar (tmapTVar tmap)+ writeTVar (tmapTVar tmap) (M.insert k (Entry a) themap, C.hit k accSeq)+ onCommit $ B.insert (backend tmap) k a -- | Applies a function to the element identified by the key. Can throw an 'EntryNotFound' exception.@@ -174,12 +183,10 @@ => (a -> a) -> k -> TMap map k a b c -> m () adjust f k tmap = do res <- lookup k tmap - case res of- Nothing -> Exc.throw EntryNotFound - Just _ -> do- (themap,accSeq) <- readTVar (tmapTVar tmap)- writeTVar (tmapTVar tmap) (M.adjust (fmap f) k themap, C.hit k accSeq)- onCommit $ B.adjust (backend tmap) f k + when (isNothing res) $ E.throw EntryNotFound + (themap,accSeq) <- readTVar (tmapTVar tmap)+ writeTVar (tmapTVar tmap) (M.adjust (fmap f) k themap, C.hit k accSeq)+ onCommit $ B.adjust (backend tmap) f k -- | Removes a key from the map. Can throw an 'EntryNotFound' exception.@@ -187,12 +194,10 @@ => k -> TMap map k a b c -> m () delete k tmap = do res <- lookup k tmap - case res of- Nothing -> Exc.throw EntryNotFound - Just _ -> do- (themap,accSeq) <- readTVar (tmapTVar tmap)- writeTVar (tmapTVar tmap) (M.insert k NotInBackend themap, accSeq)- onCommit $ B.delete (backend tmap) k + when (isNothing res) $ E.throw EntryNotFound + (themap,accSeq) <- readTVar (tmapTVar tmap)+ writeTVar (tmapTVar tmap) (M.insert k NotInBackend themap, accSeq)+ onCommit $ B.delete (backend tmap) k -------------------------------------------------------------------------------- @@ -207,7 +212,7 @@ -- | Reduces the map to the appropriate size if the maximum size was exceeded. -- Calls /Data.TMap.Backend.flush/ if the map is purged. -- Runs in /O(1)/ if the map size is within bounds, otherwise /O(n)/. --- /Warning:/ This function should always be called at the end of a transaction to+-- /Warning:/ This function should only be called at the end of a transaction to -- prevent nonterminating retry-loops! purgeTMap :: (M.FiniteMapX map k, MonadAdvSTM m, Ord k, B.Backend k a b, C.CacheStructure c k) => TMap map k a b c -> m () @@ -231,7 +236,7 @@ setMaximumSize :: (M.FiniteMapX map k, MonadAdvSTM m, Ord k, B.Backend k a b, C.CacheStructure c k) => TMap map k a b c -> Int -> m () setMaximumSize tmap maxSize- | maxSize <= 0 = Exc.throw $ TMapDefaultExc "setMaximumSize: Invalid size specified."+ | maxSize <= 0 = E.throw $ TMapDefaultExc "setMaximumSize: Invalid size specified." | otherwise = writeTVar (sizeTVar tmap) $ Just maxSize -- | Gets the maximum size of the map. /O(1)/.
Data/TMap/Backend/Binary.hs view
@@ -8,7 +8,7 @@ -- Stability : experimental -- Portability : non-portable (requires STM) ----- Proivides a (simplistic) backend using the binary package.+-- Proivides a (very simplistic) backend using the binary package. -- Every entry of the map is written to a separate file where the filename -- is the key. --@@ -67,6 +67,8 @@ insert b k a = do let fp = workingDir b </> (show k)+ exDir <- doesDirectoryExist (workingDir b)+ when (not exDir) $ throw (BackendException "insert: Directory doesn't exist!") ex <- doesFileExist fp when ex $ throw $ BackendException "insert: Entry already exists!" l <- newTMVarIO ()@@ -78,8 +80,10 @@ lookup b k = do let fp = workingDir b </> (show k)- ex <- doesFileExist fp- if not ex+ exDir <- doesDirectoryExist (workingDir b)+ when (not exDir) $ throw (BackendException "lookup: Directory doesn't exist!")+ exFile <- doesFileExist fp+ if not exFile then return Nothing else do res <- withLockOnEntry b k $ decodeFile fp@@ -91,9 +95,13 @@ adjust b f k = do let fp = workingDir b </> (show k) let tmp = tempDir b </> (show k)+ exDir <- doesDirectoryExist (workingDir b)+ when (not exDir) $ throw (BackendException "adjust: Directory doesn't exist!") ex <- doesFileExist fp when (not ex) $ throw (BackendException "adjust: Did not find entry in backend.") withLockOnEntry b k $ do a <- (decodeFile fp :: IO a) encodeFile tmp (f a) renameFile tmp fp++
Data/TStorage.hs view
@@ -26,7 +26,7 @@ remove, removeByKey, apply,- purgeTMap,+-- purgeTMap, purgeTMapIO, )
Sample.hs view
@@ -13,6 +13,7 @@ import Data.Typeable import Data.Binary import Prelude hiding( lookup )+import System.Directory data Sometype = Sometype { theid :: Int, name :: String } deriving (Show,Eq,Ord,Data,Typeable)@@ -30,7 +31,8 @@ sample = Exc.handle (\(e::Exc.SomeException) -> print e) $ do -- Let's create a TMap that uses the binary-serialization backend:- backend <- mkBinaryBackend "/home/thaldyron/var/test" + backend <- mkBinaryBackend "test" +-- removeDirectory "/home/thaldyron/var/test" tmap <- newTMapIO backend (Just 4) :: IO (TMap (M.FM Int) Int Sometype BinaryBackend C.LRU) @@ -46,9 +48,10 @@ delete 2 tmap lookup 2 tmap) -- Catch duplicate-inserts exceptions:- `catchSTM` (\(e::TMapException) -> if e==DuplicateEntry then return Nothing- else throw e)- atomically $ purgeTMap tmap+ `catchSTM` (\(e::TMapException) -> + if e==DuplicateEntry then return Nothing+ else throw (AssertionFailed (show e)))+ purgeTMapIO tmap print ("Result1: ",res) -- Let's try the high-level TStorage interface:@@ -62,7 +65,7 @@ test :: IO () test = do- backend <- mkBinaryBackend "/home/thaldyron/var/test2" + backend <- mkBinaryBackend "test2" tmap <- newTMapIO backend (Just 4) :: IO (TMap (M.FM Int) Int String BinaryBackend C.LRU) atomically $ do
persistent-map.cabal view
@@ -2,6 +2,11 @@ Synopsis: A thread-safe interface for finite map types with optional persistency support. Description: + /Changes in 0.2.*:/+ .+ * Improved error handling. Backend lookup-exceptions are now rethrown in the+ AdvSTM monad.+ . /Changes in 0.1.*:/ . * Added the binary serialization backend.@@ -42,7 +47,7 @@ to the list of retry-IO actions. (This is done using the 'retryWith' IO hook of the stm-io-package.) .- If the value does not exist yet, function 'insert' adds the key-value mapping to the+ If the value does not yet exist, function 'insert' adds the key-value mapping to the TMap and sends an insert-request to the backend using the 'onCommit' hook of the stm-io-package. Note that 'onCommit' guarantees that the backend IO action is only executed iff the transaction commits. Any @@ -58,11 +63,11 @@ /Warning:/ This package is very experimental and the interface will probably change. -Author: Peter Robinson+Author: Peter Robinson 2009 Maintainer: Peter Robinson <thaldyron@gmail.com> License: LGPL License-file: LICENSE-Version: 0.1.1+Version: 0.2.2 Category: Middleware, Concurrency Stability: experimental Homepage: http://darcs.monoid.at/persistent-map