diff --git a/Data/Persistent/IDynamic.hs b/Data/Persistent/IDynamic.hs --- a/Data/Persistent/IDynamic.hs +++ b/Data/Persistent/IDynamic.hs @@ -34,7 +34,6 @@ import Data.IORef import Data.Map as M(empty) import Data.RefSerialize -import Data.HashTable as HT --import Debug.Trace --(!>)= flip trace diff --git a/Data/TCache.hs b/Data/TCache.hs --- a/Data/TCache.hs +++ b/Data/TCache.hs @@ -296,7 +296,7 @@ import GHC.Conc import Control.Monad(when) -import Data.HashTable as H +import qualified Data.HashTable.IO as H import Data.IORef import System.IO.Unsafe import System.IO(hPutStr, stderr) @@ -323,7 +323,7 @@ -- The weak reference keeps the dbref alive until is it not referenced elsewere data CacheElem= forall a.(IResource a,Typeable a) => CacheElem (Maybe (DBRef a)) (Weak(DBRef a)) -type Ht = HashTable String CacheElem +type Ht = H.BasicHashTable String CacheElem -- contains the hastable, last sync time type Cache = IORef (Ht , Integer) @@ -340,7 +340,7 @@ -- | Creates a new cache. Experimental newCache :: IO (Ht , Integer) newCache =do - c <- H.new (==) hashString + c <- H.new -- (==) H.hashString return (c,0) -- | Return the total number of DBRefs in the cache. For debug purposes. @@ -349,7 +349,7 @@ numElems :: IO Int numElems= do (cache, _) <- readIORef refcache - elems <- toList cache + elems <- H.toList cache return $ length elems @@ -364,7 +364,7 @@ fixToCache dbref@(DBRef k tv)= do (cache, _) <- readIORef refcache w <- mkWeakPtr dbref $ Just $ fixToCache dbref - H.update cache k (CacheElem (Just dbref) w) + H.insert cache k (CacheElem (Just dbref) w) return() -- | Return the reference value. If it is not in the cache, it is fetched @@ -450,7 +450,7 @@ case mdb of Nothing -> return $! castErr dbref -- !> "just" Just _ -> do - H.update cache key (CacheElem Nothing w) --to notify when the DBREf leave its reference + H.insert cache key (CacheElem Nothing w) --to notify when the DBREf leave its reference return $! castErr dbref Nothing -> finalize w >> getDBRef1 key -- !> "finalize" -- the weak pointer has not executed his finalizer @@ -458,7 +458,7 @@ tv<- newTVarIO NotRead -- !> "Nothing" dbref <- evaluate $ DBRef key tv w <- mkWeakPtr dbref . Just $ fixToCache dbref - H.update cache key (CacheElem Nothing w) + H.insert cache key (CacheElem Nothing w) return dbref {- | Create the object passed as parameter (if it does not exist) and @@ -477,7 +477,7 @@ tv<- newTVarIO DoNotExist let dbref= DBRef key tv w <- mkWeakPtr dbref . Just $ fixToCache dbref - H.update cache key (CacheElem Nothing w) + H.insert cache key (CacheElem Nothing w) t <- timeInteger atomically $ do applyTriggers [dbref] [Just x] --`debug` ("before "++key) @@ -536,7 +536,7 @@ -- writeTVar tv . Exist $ Elem x t t -- unsafeIOToSTM $ do -- w <- mkWeakPtr dbref . Just $ fixToCache dbref --- H.update cache key ( CacheElem Nothing w) +-- H.insert cache key ( CacheElem Nothing w) -- return dbref -- | Delete the content of the DBRef form the cache and from permanent storage @@ -602,7 +602,7 @@ flushAll :: STM () flushAll = do (cache,time) <- unsafeIOToSTM $ readIORef refcache - elms <- unsafeIOToSTM $ toList cache + elms <- unsafeIOToSTM $ H.toList cache mapM_ (del cache) elms where del cache ( _ , CacheElem _ w)= do @@ -730,7 +730,7 @@ AddToHash -> do dbref <- evaluate $ DBRef key tvr w <- mkWeakPtr dbref . Just $ fixToCache dbref - H.update cache key (CacheElem (Just dbref) w) + H.insert cache key (CacheElem (Just dbref) w) return $ Just dbref -- !> ("readToCache "++ key) @@ -767,7 +767,7 @@ applyTriggers [dbref] [Just r] writeTVar tvr . Exist $ Elem r ti ti w <- unsafeIOToSTM . mkWeakPtr dbref $ Just $ fixToCache dbref - unsafeIOToSTM $ H.update cache keyr (CacheElem (Just dbref) w)-- accesed and modified XXX + unsafeIOToSTM $ H.insert cache keyr (CacheElem (Just dbref) w)-- accesed and modified XXX return () @@ -796,7 +796,7 @@ updateListToHash hash kv= mapM (update1 hash) kv where - update1 h (k,v)= update h k v + update1 h (k,v)= H.insert h k v @@ -828,7 +828,7 @@ syncCache = criticalSection saving $ do (cache,lastSync) <- readIORef refcache --`debug` "syncCache" t2<- timeInteger - elems <- toList cache + elems <- H.toList cache (tosave,_,_) <- atomically $ extract elems lastSync save tosave writeIORef refcache (cache, t2) @@ -888,7 +888,7 @@ clearSyncCache check sizeObjects= criticalSection saving $ do (cache,lastSync) <- readIORef refcache t <- timeInteger - elems <- toList cache + elems <- H.toList cache (tosave, elems, size) <- atomically $ extract elems lastSync save tosave when (size > sizeObjects) $ forkIO (filtercache t cache lastSync elems) >> performGC @@ -911,7 +911,7 @@ Exist (Elem x lastAccess _ ) -> if check t lastAccess lastSync then do - unsafeIOToSTM . H.update cache key $ CacheElem Nothing w + unsafeIOToSTM . H.insert cache key $ CacheElem Nothing w writeTVar tv NotRead else return () _ -> return() diff --git a/Data/TCache/Defs.hs b/Data/TCache/Defs.hs --- a/Data/TCache/Defs.hs +++ b/Data/TCache/Defs.hs @@ -133,8 +133,10 @@ getPersist x= unsafePerformIO $ case setPersist x of Nothing -> readIORef defaultPersistIORef - Just p -> return p - `Exception.catch` (\(e:: SomeException) -> error "setPersist must depend on the type, not the value of the parameter: " ) + Just p -> return p + `Exception.catch` (\(e:: SomeException) -> error $ "setPersist must depend on the type, not the value of the parameter for: " + ++ show (typeOf x) + ++ "error was:" ++ show e) defaultReadByKey :: String-> IO (Maybe B.ByteString) @@ -176,7 +178,7 @@ defaultDelete :: String -> IO() defaultDelete filename =do handle (handler filename) $ removeFile filename - --print ("delete "++filename) + where handler :: String -> IOException -> IO () @@ -187,9 +189,9 @@ -- threadDelay 100000 --`debug`"isAlreadyInUseError" defaultDelete filename | otherwise = do - hPutStrLn stderr $ "defaultDelResource: " ++ show e ++ " in file: " ++ filename ++ " retrying" + hPutStrLn stderr $ "defaultDelResource: " ++ show e ++ " in file: " ++ filename ++ " retrying" -- threadDelay 100000 --`debug` ("otherwise " ++ show e) - defaultDelete filename + defaultDelete filename diff --git a/TCache.cabal b/TCache.cabal --- a/TCache.cabal +++ b/TCache.cabal @@ -1,5 +1,5 @@ name: TCache -version: 0.10.2.2 +version: 0.10.2.3 cabal-version: >= 1.6 build-type: Simple license: BSD3 @@ -26,9 +26,7 @@ . In this release: . - This release: - Fix class Queriable in the IndexQuery module - + Dropped Data.Hashtable (deprecated). Now it uses the package hashtables category: Data, Database @@ -46,7 +44,7 @@ library build-depends: base >=4 && <5, bytestring -any, containers >=0.1.0.1, directory >=1.0, old-time >=1.0, - stm -any, text -any, mtl -any, + stm -any, text -any, mtl -any, hashtables, RefSerialize -any