TCache 0.9.0.4 → 0.10.0.0
raw patch · 9 files changed
+1036/−622 lines, 9 filesdep +RefSerializedep +mtldep −transformersdep ~stm
Dependencies added: RefSerialize, mtl
Dependencies removed: transformers
Dependency ranges changed: stm
Files
- Data/Persistent/Collection.hs +240/−0
- Data/TCache.hs +435/−368
- Data/TCache/DefaultPersistence.hs +9/−151
- Data/TCache/Defs.hs +160/−4
- Data/TCache/IResource.hs +17/−17
- Data/TCache/IndexQuery.hs +11/−11
- Data/TCache/IndexText.hs +7/−7
- Data/TCache/Memoization.hs +118/−0
- TCache.cabal +39/−64
+ Data/Persistent/Collection.hs view
@@ -0,0 +1,240 @@+{-# OPTIONS -XDeriveDataTypeable+ -XTypeSynonymInstances+ -XMultiParamTypeClasses+ -XExistentialQuantification+ -XOverloadedStrings+ -XFlexibleInstances+ -XUndecidableInstances+ -XFunctionalDependencies+++ -IControl/Workflow++ #-}++{- |+This module implements a persistent, transactional collection with Queue interface as well as+ indexed access by key.++ The Queue uses default persistence. See "Data.TCache.DefaultPersistence"++-}++module Data.Persistent.Collection (+RefQueue(..), getQRef,+pop,popSTM,pick, flush, flushSTM,+pickAll, pickAllSTM, push,pushSTM,+pickElem, pickElemSTM, readAll, readAllSTM,+deleteElem, deleteElemSTM,+unreadSTM,isEmpty,isEmptySTM+) where+import Data.Typeable+import Control.Concurrent.STM(STM,atomically, retry)+import Control.Monad+import Data.TCache.DefaultPersistence++import Data.TCache+import System.IO.Unsafe+import Data.RefSerialize+import Data.ByteString.Lazy.Char8+import Data.RefSerialize++import Debug.Trace++a !> b= trace b a+++++instance Indexable (Queue a) where+ key (Queue k _ _)= queuePrefix ++ k+++++data Queue a= Queue {name :: String, imp :: [a], out :: [a]} deriving (Typeable)++++instance Serialize a => Serialize (Queue a) where+ showp (Queue n i o)= showp n >> showp i >> showp o+ readp = return Queue `ap` readp `ap` readp `ap` readp+-- do+-- n <- readp+-- i <- readp+-- o <- readp+-- return $ Queue n i o+++++queuePrefix= "Queue#"+lenQPrefix= Prelude.length queuePrefix++++instance Serialize a => Serializable (Queue a ) where+ serialize = runW . showp+ deserialize = runR readp++-- | a queue reference+type RefQueue a= DBRef (Queue a)++unreadSTM :: (Typeable a, Serialize a) => RefQueue a -> a -> STM ()+unreadSTM queue x= do+ r <- readQRef queue+ writeDBRef queue $ doit r+ where+ doit (Queue n imp out) = Queue n imp ( x : out)+++-- | check if the queue is empty+isEmpty :: (Typeable a, Serialize a) => RefQueue a -> IO Bool+isEmpty = atomically . isEmptySTM++isEmptySTM :: (Typeable a, Serialize a) => RefQueue a -> STM Bool+isEmptySTM queue= do+ r <- readDBRef queue+ return $ case r of+ Nothing -> True+ Just (Queue _ [] []) -> True+ _ -> False++++-- | get the reference to new or existing queue trough its name+getQRef :: (Typeable a, Serialize a) => String -> RefQueue a+getQRef n = getDBRef . key $ Queue n undefined undefined+++-- | empty the queue (factually, it is deleted)+flush :: (Typeable a, Serialize a) => RefQueue a -> IO ()+flush = atomically . flushSTM++-- | version in the STM monad+flushSTM :: (Typeable a, Serialize a) => RefQueue a -> STM ()+flushSTM tv= delDBRef tv++-- | read the first element in the queue and delete it (pop)+pop+ :: (Typeable a, Serialize a) => RefQueue a -- ^ Queue name+ -> IO a -- ^ the returned elems+pop tv = atomically $ popSTM tv+++readQRef :: (Typeable a, Serialize a) => RefQueue a -> STM(Queue a)+readQRef tv= do+ mdx <- readDBRef tv+ case mdx of+ Nothing -> do+ let q= Queue ( Prelude.drop lenQPrefix $ keyObjDBRef tv) [] []+ writeDBRef tv q+ return q+ Just dx ->+ return dx++-- | version in the STM monad+popSTM :: (Typeable a, Serialize a) => RefQueue a+ -> STM a+popSTM tv=do+ dx <- readQRef tv+ doit dx++ where++ doit (Queue n [x] [])= do+ writeDBRef tv $ (Queue n [] [])+ return x+ doit (Queue _ [] []) = retry+ doit (Queue n imp []) = doit (Queue n [] $ Prelude.reverse imp)+ doit (Queue n imp list ) = do+ writeDBRef tv (Queue n imp (Prelude.tail list ))+ return $ Prelude.head list++-- | read the first element in the queue but it does not delete it+pick+ :: (Typeable a, Serialize a) => RefQueue a -- ^ Queue name+ -> IO a -- ^ the returned elems+pick tv = atomically $ do+ dx <- readQRef tv+ doit dx+ where+ doit (Queue _ [x] [])= return x+ doit (Queue _ [] []) = retry+ doit (Queue n imp []) = doit (Queue n [] $ Prelude.reverse imp)+ doit (Queue n imp list ) = return $ Prelude.head list++-- | push an element in the queue+push :: (Typeable a, Serialize a) => RefQueue a -> a -> IO ()+push tv v = atomically $ pushSTM tv v++-- | version in the STM monad+pushSTM :: (Typeable a, Serialize a) => RefQueue a -> a -> STM ()+pushSTM tv v=+ readQRef tv >>= \ ((Queue n imp out)) -> writeDBRef tv $ Queue n (v : imp) out++-- | return the list of all elements in the queue. The queue remains unchanged+pickAll :: (Typeable a, Serialize a) => RefQueue a -> IO [a]+pickAll= atomically . pickAllSTM++-- | version in the STM monad+pickAllSTM :: (Typeable a, Serialize a) => RefQueue a -> STM [a]+pickAllSTM tv= do+ (Queue name imp out) <- readQRef tv+ return $ out ++ Prelude.reverse imp++-- | return the first element in the queue that has the given key+pickElem ::(Indexable a,Typeable a, Serialize a) => RefQueue a -> String -> IO(Maybe a)+pickElem tv key= atomically $ pickElemSTM tv key++-- | version in the STM monad+pickElemSTM :: (Indexable a,Typeable a, Serialize a)+ => RefQueue a -> String -> STM(Maybe a)+pickElemSTM tv key1= do+ Queue name imp out <- readQRef tv+ let xs= out ++ Prelude.reverse imp+ when (not $ Prelude.null imp) $ writeDBRef tv $ Queue name [] xs+ case Prelude.filter (\x-> key x == key1) xs of+ [] -> return $ Nothing+ (x:_) -> return $ Just x++-- | update the first element of the queue with a new element with the same key+updateElem :: (Indexable a,Typeable a, Serialize a)+ => RefQueue a -> a -> IO()+updateElem tv x = atomically $ updateElemSTM tv x++-- | version in the STM monad+updateElemSTM :: (Indexable a,Typeable a, Serialize a)+ => RefQueue a -> a -> STM()+updateElemSTM tv v= do+ Queue name imp out <- readQRef tv+ let xs= out ++ Prelude.reverse imp+ let xs'= Prelude.map (\x -> if key x == n then v else x) xs+ writeDBRef tv $ Queue name [] xs'+ where+ n= key v++-- | return the list of all elements in the queue and empty it+readAll :: (Typeable a, Serialize a) => RefQueue a -> IO [a]+readAll= atomically . readAllSTM++-- | a version in the STM monad+readAllSTM :: (Typeable a, Serialize a) => RefQueue a -> STM [a]+readAllSTM tv= do+ Queue name imp out <- readQRef tv+ writeDBRef tv $ Queue name [] []+ return $ out ++ Prelude.reverse imp++-- | delete all the elements of the queue that has the key of the parameter passed+deleteElem :: (Indexable a,Typeable a, Serialize a) => RefQueue a-> a -> IO ()+deleteElem tv x= atomically $ deleteElemSTM tv x++-- | verison in the STM monad+deleteElemSTM :: (Typeable a, Serialize a,Indexable a) => RefQueue a-> a -> STM ()+deleteElemSTM tv x= do+ Queue name imp out <- readQRef tv+ let xs= out ++ Prelude.reverse imp+ writeDBRef tv $ Queue name [] $ Prelude.filter (\x-> key x /= k) xs+ where+ k=key x+
Data/TCache.hs view
@@ -2,58 +2,62 @@ , FlexibleInstances, UndecidableInstances #-} {- | TCache is a transactional cache with configurable persitence that permits-STM transactions with objects thar syncronize sincromous or asyncronously with-their user defined storages. Default persistence in files is provided for testing purposes+STM transactions with objects that syncronize sincromous or asyncronously with+their user defined storages. Default persistence in files is provided by default - TCache implements ''DBRef' 's . They are persistent STM references with a traditional 'readDBRef', 'writeDBRef' Haskell interface.+ TCache implements ''DBRef' 's . They are persistent STM references with a typical Haskell interface. simitar to TVars ('newDBRef', 'readDBRef', 'writeDBRef' etc) but with added. persistence-. DBRefs are serializable, so they can be stored and retrieved. See some examples below+. DBRefs are serializable, so they can be stored and retrieved. Because they are references,they point to other serializable registers. This permits persistent mutable Inter-object relations For simple transactions of lists of objects of the same type TCache implements-inversion of control primitives 'withSTMResources' and variants, that call pure user defined code for registers update.-See examples below.+inversion of control primitives 'withSTMResources' and variants, that call pure user defined code for registers update. Examples below. -Triggers in "Data.TCache.Triggers" are user defined hooks that are called back on register updates. That can be used for:- +Triggers in "Data.TCache.Triggers" are user defined hooks that are called back on register updates.+.They are used internally for indexing. "Data.TCache.IndexQuery" implements an straighforwards pure haskell type safe query language based on register field relations. This module must be imported separately. -"Data.TCache.IndexText" add full text search and content search to the qhery language+"Data.TCache.IndexText" add full text search and content search to the query language -"Data.TCache.DefaultPersistence" define instances for key definition, serialization-and persistence, and default file persistence. The file persistence is now more reliable, and the embedded IO reads inside STM transactions are safe.+"Data.TCache.DefaultPersistence" has instances for key indexation , serialization+ and default file persistence. The file persistence is more reliable, and the embedded IO reads inside STM transactions are safe. +"Data.Persistent.Collection" implements a persistent, transactional collection with Queue interface as well as+ indexed access by key -} - - - -module Data.TCache ( --- * Inherited from 'Control.Concurrent.STM' +++module Data.TCache (+-- * Inherited from 'Control.Concurrent.STM' and variations+ atomically+ ,atomicallySync ,STM+ ,unsafeIOToSTM+ ,safeIOToSTM -- * Operations with cached database references-{-| DBRefs are persistent cached database references in the STM monad+{-| @DBRefs@ are persistent cached database references in the STM monad with read/write primitives, so the traditional syntax of Haskell STM references can be used for interfacing with databases. As expected, the DBRefs are transactional, because they operate in the STM monad. -DBRefs are references to cached database objects. A DBRef is associated with its referred object and its key-Since DBRefs are serializable, they can be elements of mutable objects. They could point to other mutable objects-and so on, so DBRefs can act as "hardwired" relations from mutable objects+A @DBRef@ is associated with its referred object trough its key.+Since DBRefs are serializable, they can be elements of mutable cached objects themselves. They could point to other mutable objects+and so on, so DBRefs can act as \"hardwired\" relations from mutable objects to other mutable objects in the database/cache. their referred objects are loaded, saved and flused to and from the cache automatically depending on the cache handling policies and the access needs -DBRefs are univocally identified by its pointed object keys, so they can be compared, ordered and so on.-The creation of a DBRef, trough 'getDBRef' is pure. This permits an efficient lazy marshalling-of registers with references, such are indexes when are queried for some fields but not others.+@DBRefs@ are univocally identified by its pointed object keys, so they can be compared, ordered checked for equality so on.+The creation of a DBRef, trough 'getDBRef' is pure. This permits an efficient lazy access to the+ registers trouth their DBRefs by lazy marshalling of the register content on demand. Example: Car registers have references to Person regiters @@ -116,10 +120,9 @@ DBRefs, once the pointed cached object is looked up in the cache and found at creation, they does not perform any further cache lookup afterwards, so reads and writes from/to DBRefs are faster-than *Resource(s) calls, which perform lookups everytime-in the cache+than *Resource(s) calls, which perform cache lookups everytime the object is accessed -DBRef's and *Resource(s) primitives are completely interoperable. The latter operate implicitly with DBRef's+DBRef's and @*Resource(s)@ primitives are completely interoperable. The latter operate implicitly with DBRef's -} @@ -133,15 +136,16 @@ ,writeDBRef ,delDBRef --- * IResource class+-- * @IResource@ class {- | cached objects must be instances of IResource. Such instances can be implicitly derived trough auxiliary clasess for file persistence -} ,IResource(..) -- * Operations with cached objects-{- | Operations with DBRef's can be performed implicitly with the \"traditional\" TCache operations-available in older versions.+{- | implement inversion of control primitives where the user defines the objects to retrive. The primitives+then call a the defined function that, determines how to transform the objects retrieved,wich are sent+back to the storage and a result is returned. In this example \"buy\" is a transaction where the user buy an item. The spent amount is increased and the stock of the product is decreased:@@ -166,14 +170,14 @@ buyIt _ = error \"either the user or the item (or both) does not exist\" @ -}-,resources -- empty resources +,Resources(..) -- data definition used to communicate object Inserts and Deletes to the cache+,resources -- empty resources ,withSTMResources-,Resources(..) -- data definition used to communicate object Inserts and Deletes to the cache -,withResources -,withResource -,getResources -,getResource -,deleteResources +,withResources+,withResource+,getResources+,getResource+,deleteResources ,deleteResource -- * Trigger operations@@ -186,12 +190,12 @@ Example: -every time a car is added, or deleted, the owner's list is updated-this is done by the user defined trigger addCar+Every time a car is added, or deleted, the owner's list is updated.+This is done by the user defined trigger addCar @ addCar pcar (Just(Car powner _ )) = addToOwner powner pcar- addCar pcar Nothing = readDBRef pcar >>= \(Just car)-> deleteOwner (owner car) pcar+ addCar pcar Nothing = readDBRef pcar >>= \\(Just car)-> deleteOwner (owner car) pcar addToOwner powner pcar=do Just owner <- readDBRef powner@@ -205,17 +209,15 @@ 'addTrigger' addCar putStrLn \"create bruce's register with no cars\" bruce \<- 'atomically' 'newDBRef' $ Person \"Bruce\" []- putStrLn "add two car register with \"bruce\" as owner using the reference to the bruces register"+ putStrLn \"add two car register with \\"bruce\\" as owner using the reference to the bruces register\" let newcars= [Car bruce \"Bat Mobile\" , Car bruce \"Porsche\"] insert newcars Just bruceData \<- atomically $ 'readDBRef' bruce- putStrLn "the trigger automatically updated the car references of the Bruce register"+ putStrLn \"the trigger automatically updated the car references of the Bruce register\" print . length $ cars bruceData print bruceData @ -produces:- gives: > main@@ -225,43 +227,46 @@ -} ,addTrigger- + -- * Cache control ,flushDBRef-,flushAll -,Cache -,setCache -,newCache -,refcache +,flushAll+,Cache+,setCache+,newCache+--,refcache ,syncCache ,setConditions-,clearSyncCache -,numElems -,clearSyncCacheProc +,clearSyncCache+,numElems+,syncWrite+,SyncMode(..)+,clearSyncCacheProc ,defaultCheck- -) -where - - -import GHC.Conc -import Control.Monad(when) -import Data.HashTable as H -import Data.IORef -import System.IO.Unsafe -import System.IO(hPutStr, stderr) -import Data.Maybe(catMaybes,mapMaybe, fromMaybe, fromJust) +-- * Other+,onNothing+)+where -import Data.TCache.Defs ++import GHC.Conc+import Control.Monad(when)+import Data.HashTable as H+import Data.IORef+import System.IO.Unsafe+import System.IO(hPutStr, stderr)+import Data.Maybe+import Data.Char(isSpace)+import Data.TCache.Defs import Data.TCache.IResource-import Data.TCache.Triggers +import Data.TCache.Triggers import Control.Exception(handle,assert, bracket, SomeException)-import Data.Typeable +import Data.Typeable import System.Time import System.Mem import System.Mem.Weak -import Control.Concurrent.MVar +import Control.Concurrent.MVar import Control.Exception(catch, throw,evaluate) --import Debug.Trace@@ -272,53 +277,59 @@ -- calls which does not reference dbrefs explicitly -- 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- --- contains the hastable, last sync time -type Cache = IORef (Ht , Integer) -data CheckTPVarFlags= AddToHash | NoAddToHash - --- | set the cache. this is useful for hot loaded modules that will update an existing cache. Experimental -setCache :: Cache -> IO() -setCache ref = readIORef ref >>= \ch -> writeIORef refcache ch - --- the cache holder. stablished by default -refcache :: Cache -refcache =unsafePerformIO $ newCache >>= newIORef - --- | newCache creates a new cache. Experimental -newCache :: IO (Ht , Integer) -newCache =do - c <- H.new (==) hashString ++-- contains the hastable, last sync time+type Cache = IORef (Ht , Integer)+data CheckTPVarFlags= AddToHash | NoAddToHash++-- | Set the cache. this is useful for hot loaded modules that will update an existing cache. Experimental+setCache :: Cache -> IO()+setCache ref = readIORef ref >>= \ch -> writeIORef refcache ch++-- | The cache holder. stablished by default+refcache :: Cache+refcache =unsafePerformIO $ newCache >>= newIORef++-- | Creates a new cache. Experimental+newCache :: IO (Ht , Integer)+newCache =do+ c <- H.new (==) hashString return (c,0) --- | return the total number of DBRefs in the cache. For debug purposes+-- | Return the total number of DBRefs in the cache. For debug purposes. -- This does not count the number of objects in the cache since many of the DBRef--- may not have the pointed object loaded. Itś O(n).+-- may not have the pointed object loaded. It's O(n). numElems :: IO Int numElems= do (cache, _) <- readIORef refcache- elems <- toList cache + elems <- toList cache return $ length elems deRefWeakSTM = unsafeIOToSTM . deRefWeak -deleteFromCache :: (IResource a, Typeable a) => DBRef a -> IO ()-deleteFromCache (DBRef k tv)= do- (cache, _) <- readIORef refcache- H.delete cache k -- !> ("delete " ++ k)+--deleteFromCache :: (IResource a, Typeable a) => DBRef a -> IO ()+--deleteFromCache (DBRef k tv)= do+-- (cache, _) <- readIORef refcache+-- H.delete cache k -- !> ("delete " ++ k) +fixToCache :: (IResource a, Typeable a) => DBRef a -> IO ()+fixToCache dbref@(DBRef k tv)= do+ (cache, _) <- readIORef refcache+ w <- mkWeakPtr dbref $ Just $ fixToCache dbref+ H.update cache k (CacheElem (Just dbref) w)+ return() --- | return the reference value. If it is not in the cache, it is fetched+-- | Return the reference value. If it is not in the cache, it is fetched -- from the database. readDBRef :: (IResource a, Typeable a) => DBRef a -> STM (Maybe a) readDBRef dbref@(DBRef key tv)= do r <- readTVar tv case r of Exist (Elem x _ mt) -> do- t <- unsafeIOToSTM timeInteger + t <- unsafeIOToSTM timeInteger writeTVar tv . Exist $ Elem x t mt return $ Just x DoNotExist -> return $ Nothing@@ -331,7 +342,7 @@ writeTVar tv $ Exist $ Elem x t t return $ Just x --- | write in the reference a value+-- | Write in the reference a value -- The new key must be the same than the old key of the previous object stored -- otherwise, an error "law of key conservation broken" will be raised --@@ -350,16 +361,17 @@ return() -- instance Show (DBRef a) where- show (DBRef key _)= "DBRef \""++ key ++ "\""+ show (DBRef key _)= "getDBRef \""++ key ++ "\"" instance (IResource a, Typeable a) => Read (DBRef a) where- readsPrec n ('D':'B':'R':'e':'f':' ':'\"':str)=- let (key,nstr) = break (== '\"') str- in [( getDBRef key :: DBRef a, tail nstr)]- readsPrec _ _ = []+ readsPrec n str1= readit str+ where+ str = dropWhile isSpace str1+ readit ('g':'e':'t':'D':'B':'R':'e':'f':' ':'\"':str1)=+ let (key,nstr) = break (== '\"') str1+ in [( getDBRef key :: DBRef a, tail nstr)]+ readit _ = [] instance Eq (DBRef a) where DBRef k _ == DBRef k' _ = k==k'@@ -367,69 +379,74 @@ instance Ord (DBRef a) where compare (DBRef k _) (DBRef k' _) = compare k k' --- | return the key of the object pointed to by the DBRef+-- | Return the key of the object pointed to by the DBRef keyObjDBRef :: DBRef a -> String keyObjDBRef (DBRef k _)= k - --- | get the reference to the object in the cache. if it does not exist, the reference is created empty.++-- | Get the reference to the object in the cache. if it does not exist, the reference is created empty. -- Every execution of 'getDBRef' returns the same unique reference to this key, -- so it can be safely considered pure. This is a property useful because deserialization--- of objects with unused embedded DBRef's do not need to marshall them eagerly+-- of objects with unused embedded DBRef's do not need to marshall them eagerly. -- Tbis also avoid unnecesary cache lookups of the pointed objects. {-# NOINLINE getDBRef #-} getDBRef :: (Typeable a, IResource a) => String -> DBRef a getDBRef key= unsafePerformIO $! getDBRef1 $! key where getDBRef1 :: (Typeable a, IResource a) => String -> IO (DBRef a)- getDBRef1 key= do- (cache,_) <- readIORef refcache -- !> ("getDBRef "++ key)+ getDBRef1 key = do+ (cache,_) <- readIORef refcache -- !> ("getDBRef "++ key) r <- H.lookup cache key case r of- Just (CacheElem _ w) -> do+ Just (CacheElem mdb w) -> do mr <- deRefWeak w case mr of- Just dbref@(DBRef _ tv) -> return $! castErr dbref- Nothing -> finalize w >> getDBRef1 key -- the weak pointer has not executed his finalizer+ Just dbref@(DBRef _ tv) ->+ 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+ return $! castErr dbref+ Nothing -> finalize w >> getDBRef1 key -- !> "finalize" -- the weak pointer has not executed his finalizer - Nothing -> do - tv<- newTVarIO NotRead+ Nothing -> do+ tv<- newTVarIO NotRead -- !> "Nothing" dbref <- evaluate $ DBRef key tv- w <- mkWeakPtr dbref . Just $ deleteFromCache dbref - H.update cache key (CacheElem Nothing w) + w <- mkWeakPtr dbref . Just $ fixToCache dbref+ H.update cache key (CacheElem Nothing w) return dbref- + {- | Create the object passed as parameter (if it does not exist) and -- return its reference in the IO monad. -- If an object with the same key already exists, it is returned as is -- If not, the reference is created with the new value.--- If you like to update in any case, use 'getDBRef' and 'writeDBRef' combined -newDBRefIO :: (IResource a,Typeable a) => a -> IO (DBRef a) +-- If you like to update in any case, use 'getDBRef' and 'writeDBRef' combined+newDBRefIO :: (IResource a,Typeable a) => a -> IO (DBRef a) newDBRefIO x= do- let key = keyResource x + let key = keyResource x mdbref <- mDBRefIO key case mdbref of Right dbref -> return dbref - Left cache -> do + Left cache -> do tv<- newTVarIO DoNotExist let dbref= DBRef key tv- w <- mkWeakPtr dbref . Just $ deleteFromCache dbref + w <- mkWeakPtr dbref . Just $ fixToCache dbref H.update cache key (CacheElem Nothing w) t <- timeInteger atomically $ do applyTriggers [dbref] [Just x] --`debug` ("before "++key) writeTVar tv . Exist $ Elem x t t- return dbref - --} - - ----- get a single DBRef if exist ---mDBRefIO --- :: (IResource a, Typeable a) --- => String -- ^ the list of partial object definitions for which keyResource can be extracted + return dbref++-}+++---- get a single DBRef if exist+--mDBRefIO+-- :: (IResource a, Typeable a)+-- => String -- ^ the list of partial object definitions for which keyResource can be extracted -- -> IO (Either Ht (DBRef a)) -- ^ ThTCache.hse TVars that contain such objects---mDBRefIO k= do +--mDBRefIO k= do -- (cache,_) <- readIORef refcache -- r <- H.lookup cache k -- case r of@@ -438,18 +455,18 @@ -- case mr of -- Just dbref -> return . Right $! castErr dbref -- Nothing -> finalize w >> mDBRefIO k--- Nothing -> return $ Left cache - +-- Nothing -> return $ Left cache - ++ -- | Create the object passed as parameter (if it does not exist) and -- return its reference in the STM monad. -- If an object with the same key already exists, it is returned as is -- If not, the reference is created with the new value. -- If you like to update in any case, use 'getDBRef' and 'writeDBRef' combined -- if you need to create the reference and the reference content, use 'newDBRef'--newDBRef :: (IResource a, Typeable a) => a -> STM (DBRef a) +{-# NOINLINE newDBRef #-}+newDBRef :: (IResource a, Typeable a) => a -> STM (DBRef a) newDBRef x = do let ref= getDBRef $! keyResource x @@ -457,26 +474,26 @@ case mr of Nothing -> writeDBRef ref x >> return ref -- !> " write" Just r -> return ref -- !> " non write"- ---newDBRef :: (IResource a, Typeable a) => a -> STM (DBRef a) ++--newDBRef :: (IResource a, Typeable a) => a -> STM (DBRef a) --newDBRef x = do--- let key= keyResource x --- mdbref <- unsafeIOToSTM $ mDBRefIO key --- case mdbref of +-- let key= keyResource x+-- mdbref <- unsafeIOToSTM $ mDBRefIO key+-- case mdbref of -- Right dbref -> return dbref--- Left cache -> do --- t <- unsafeIOToSTM timeInteger +-- Left cache -> do+-- t <- unsafeIOToSTM timeInteger -- tv <- newTVar DoNotExist -- let dbref= DBRef key tv -- (cache,_) <- unsafeIOToSTM $ readIORef refcache -- applyTriggers [dbref] [Just x]--- writeTVar tv . Exist $ Elem x t t +-- writeTVar tv . Exist $ Elem x t t -- unsafeIOToSTM $ do--- w <- mkWeakPtr dbref . Just $ deleteFromCache dbref --- H.update cache key ( CacheElem Nothing w) --- return dbref +-- w <- mkWeakPtr dbref . Just $ fixToCache dbref+-- H.update cache key ( CacheElem Nothing w)+-- return dbref --- | delete the content of the DBRef form the cache and from permanent storage+-- | Delete the content of the DBRef form the cache and from permanent storage delDBRef :: (IResource a, Typeable a) => DBRef a -> STM() delDBRef dbref@(DBRef k tv)= do mr <- readDBRef dbref@@ -485,20 +502,28 @@ applyTriggers [dbref] [Nothing] writeTVar tv DoNotExist - safeIOToSTM $ bracket- (takeMVar saving)- (putMVar saving)- $ const $ delResource x+ safeIOToSTM . criticalSection saving $ delResource x Nothing -> return () - +-- | Handles Nothing cases in a simpler way than runMaybeT.+-- it is used in infix notation. for example:+--+-- @result <- readDBRef ref \`onNothing\` error (\"Not found \"++ keyObjDBRef ref)@+--+-- or+--+-- @result <- readDBRef ref \`onNothing\` return someDefaultValue@+onNothing io onerr= do+ my <- io+ case my of+ Just y -> return y+ Nothing -> onerr - --- | deletes the pointed object from the cache, not the database (see 'delDBRef')--- useful for cache invalidation when the database is modified by other process +-- | Deletes the pointed object from the cache, not the database (see 'delDBRef')+-- useful for cache invalidation when the database is modified by other process flushDBRef :: (IResource a, Typeable a) =>DBRef a -> STM() flushDBRef (DBRef _ tv)= writeTVar tv NotRead @@ -514,146 +539,141 @@ mr <- unsafeIOToSTM $ deRefWeak w case mr of Just (DBRef _ tv) -> writeTVar tv DoNotExist- Nothing -> unsafeIOToSTM (finalize w) + Nothing -> unsafeIOToSTM (finalize w) - - --- | This is the main function for the *Resource(s) calls. All the rest derive from it. The results are kept in the STM monad --- so it can be part of a larger STM transaction involving other DBRefs --- The 'Resources' register returned by the user-defined function is interpreted as such: --- --- * 'toAdd': the content of this field will be added/updated to the cache --- --- * 'toDelete': the content of this field will be removed from the cache and from permanent storage --- --- * 'toReturn': the content of this field will be returned by 'withSTMResources' +++-- | This is the main function for the *Resource(s) calls. All the rest derive from it. The results are kept in the STM monad+-- so it can be part of a larger STM transaction involving other DBRefs.+-- The 'Resources' register returned by the user-defined function is interpreted as such: --+-- * 'toAdd': the content of this field will be added/updated to the cache+--+-- * 'toDelete': the content of this field will be removed from the cache and from permanent storage+--+-- * 'toReturn': the content of this field will be returned by 'withSTMResources'+-- -- WARNING: To catch evaluations errors at the right place, the values to be written must be fully evaluated.--- .Errors in delayed evaluations at serialization time can cause inconsistencies in the database.+-- Errors in delayed evaluations at serialization time can cause inconsistencies in the database. -withSTMResources :: (IResource a, Typeable a)=> [a] -- ^ the list of resources to be retrieved - -> ([Maybe a]-> Resources a x) -- ^ The function that process the resources found and return a Resources structure - -> STM x -- ^ The return value in the STM monad. +withSTMResources :: (IResource a, Typeable a)=> [a] -- ^ the list of resources to be retrieved+ -> ([Maybe a]-> Resources a x) -- ^ The function that process the resources found and return a Resources structure+ -> STM x -- ^ The return value in the STM monad. -withSTMResources rs f= do - (cache,_) <- unsafeIOToSTM $ readIORef refcache - mtrs <- takeDBRefs rs cache AddToHash - - mrs <- mapM mreadDBRef mtrs - case f mrs of - Retry -> retry +withSTMResources rs f= do+ (cache,_) <- unsafeIOToSTM $ readIORef refcache+ mtrs <- takeDBRefs rs cache AddToHash++ mrs <- mapM mreadDBRef mtrs+ case f mrs of+ Retry -> retry Resources as ds r -> do applyTriggers (map (getDBRef . keyResource) ds) (repeat (Nothing `asTypeOf` (Just(head ds)))) delListFromHash cache ds releaseTPVars as cache - safeIOToSTM $ bracket- (takeMVar saving)- (putMVar saving)- $ const $ mapM_ delResource ds - return r - + safeIOToSTM . criticalSection saving $ mapM_ delResource ds+ return r+ where- mreadDBRef :: (IResource a, Typeable a) => Maybe (DBRef a) -> STM (Maybe a) - mreadDBRef (Just dbref)= readDBRef dbref - mreadDBRef Nothing = return Nothing - - --- | update of a single object in the cache --- --- @withResource r f= 'withResources' [r] (\[mr]-> [f mr])@ -withResource:: (IResource a, Typeable a) - => a -- ^ prototypes of the object to be retrieved for which keyResource can be derived - -> (Maybe a-> a) -- ^ update function that return another full object - -> IO () -withResource r f= withResources [r] (\[mr]-> [f mr]) - - --- | to atomically add/modify many objects in the cache- --- @ withResources rs f= atomically $ 'withSTMResources' rs f1 >> return() where f1 mrs= let as= f mrs in Resources as [] ()@ -withResources:: (IResource a,Typeable a)=> [a]-> ([Maybe a]-> [a])-> IO () -withResources rs f= atomically $ withSTMResources rs f1 >> return() where - f1 mrs= let as= f mrs in Resources as [] () - --- | to read a resource from the cache.- --- @getResource r= do{mr<- 'getResources' [r];return $! head mr}@ -getResource:: (IResource a, Typeable a)=>a-> IO (Maybe a) -getResource r= do{mr<- getResources [r];return $! head mr} - ---- | to read a list of resources from the cache if they exist- --- | @getResources rs= atomically $ 'withSTMResources' rs f1 where f1 mrs= Resources [] [] mrs@ -getResources:: (IResource a, Typeable a)=>[a]-> IO [Maybe a] -getResources rs= atomically $ withSTMResources rs f1 where - f1 mrs= Resources [] [] mrs - - --- | delete the resource from cache and from persistent storage. --- @ deleteResource r= 'deleteResources' [r] @ -deleteResource :: (IResource a, Typeable a) => a -> IO () -deleteResource r= deleteResources [r] - --- | delete the list of resources from cache and from persistent storage.- --- @ deleteResources rs= atomically $ 'withSTMResources' rs f1 where f1 mrs = Resources [] (catMaybes mrs) ()@ -deleteResources :: (IResource a, Typeable a) => [a] -> IO () -deleteResources rs= atomically $ withSTMResources rs f1 where - f1 mrs = resources {toDelete=catMaybes mrs} - - -takeDBRefs :: (IResource a, Typeable a) => [a] -> Ht -> CheckTPVarFlags -> STM [Maybe (DBRef a)] -takeDBRefs rs cache addToHash= mapM (takeDBRef cache addToHash) rs + mreadDBRef :: (IResource a, Typeable a) => Maybe (DBRef a) -> STM (Maybe a)+ mreadDBRef (Just dbref)= readDBRef dbref+ mreadDBRef Nothing = return Nothing -{-# NOINLINE takeDBRef #-} -takeDBRef :: (IResource a, Typeable a) => Ht -> CheckTPVarFlags -> a -> STM(Maybe (DBRef a)) +-- | Update of a single object in the cache+--+-- @withResource r f= 'withResources' [r] (\[mr]-> [f mr])@+withResource:: (IResource a, Typeable a) => a -> (Maybe a-> a) -> IO ()+withResource r f= withResources [r] (\[mr]-> [f mr])+++-- | To atomically add/modify many objects in the cache+--+-- @ withResources rs f= atomically $ 'withSTMResources' rs f1 >> return() where f1 mrs= let as= f mrs in Resources as [] ()@+withResources:: (IResource a,Typeable a)=> [a]-> ([Maybe a]-> [a])-> IO ()+withResources rs f= atomically $ withSTMResources rs f1 >> return() where+ f1 mrs= let as= f mrs in Resources as [] ()++-- | To read a resource from the cache.+--+-- @getResource r= do{mr<- 'getResources' [r];return $! head mr}@+getResource:: (IResource a, Typeable a)=>a-> IO (Maybe a)+getResource r= do{mr<- getResources [r];return $! head mr}++-- | To read a list of resources from the cache if they exist+--+-- | @getResources rs= atomically $ 'withSTMResources' rs f1 where f1 mrs= Resources [] [] mrs@+getResources:: (IResource a, Typeable a)=>[a]-> IO [Maybe a]+getResources rs= atomically $ withSTMResources rs f1 where+ f1 mrs= Resources [] [] mrs+ ++-- | Delete the resource from cache and from persistent storage.+--+-- @ deleteResource r= 'deleteResources' [r] @+deleteResource :: (IResource a, Typeable a) => a -> IO ()+deleteResource r= deleteResources [r]++-- | Delete the list of resources from cache and from persistent storage.+--+-- @ deleteResources rs= atomically $ 'withSTMResources' rs f1 where f1 mrs = Resources [] (catMaybes mrs) ()@+deleteResources :: (IResource a, Typeable a) => [a] -> IO ()+deleteResources rs= atomically $ withSTMResources rs f1 where+ f1 mrs = resources {toDelete=catMaybes mrs}+++takeDBRefs :: (IResource a, Typeable a) => [a] -> Ht -> CheckTPVarFlags -> STM [Maybe (DBRef a)]+takeDBRefs rs cache addToHash= mapM (takeDBRef cache addToHash) rs+++{-# NOINLINE takeDBRef #-}+takeDBRef :: (IResource a, Typeable a) => Ht -> CheckTPVarFlags -> a -> STM(Maybe (DBRef a)) takeDBRef cache flags x =do- - let keyr= keyResource x - c <- unsafeIOToSTM $ H.lookup cache keyr - case c of ++ let keyr= keyResource x+ c <- unsafeIOToSTM $ H.lookup cache keyr+ case c of Just (CacheElem _ w) -> do mr <- unsafeIOToSTM $ deRefWeak w case mr of Just dbref -> return . Just $! castErr dbref- Nothing -> unsafeIOToSTM (finalize w) >> takeDBRef cache flags x - Nothing -> do - safeIOToSTM $ readToCache flags cache keyr -- unsafeIOToSTM $ readResourceByKey keyr - + Nothing -> unsafeIOToSTM (finalize w) >> takeDBRef cache flags x+ Nothing -> do+ safeIOToSTM $ readToCache flags cache keyr -- unsafeIOToSTM $ readResourceByKey keyr+ where readToCache flags cache key= do- mr <- readResourceByKey key- case mr of - Nothing -> return Nothing - Just r2 -> do - ti <- timeInteger - tvr <- newTVarIO . Exist $ Elem r2 ti ti - case flags of - NoAddToHash -> return . Just $ DBRef key tvr + mr <- readResource x+ case mr of+ Nothing -> return Nothing+ Just r2 -> do+ ti <- timeInteger+ tvr <- newTVarIO . Exist $ Elem r2 ti ti+ case flags of+ NoAddToHash -> return . Just $ DBRef key tvr AddToHash -> do dbref <- evaluate $ DBRef key tvr- w <- mkWeakPtr dbref . Just $ deleteFromCache dbref - H.update cache key (CacheElem (Just dbref) w) + w <- mkWeakPtr dbref . Just $ fixToCache dbref+ H.update cache key (CacheElem (Just dbref) w) return $ Just dbref -- !> ("readToCache "++ key)- - - -timeInteger= do TOD t _ <- getClockTime - return t - - - - - -releaseTPVars :: (IResource a,Typeable a)=> [a] -> Ht -> STM () -releaseTPVars rs cache = mapM_ (releaseTPVar cache) rs - -releaseTPVar :: (IResource a,Typeable a)=> Ht -> a -> STM () -releaseTPVar cache r =do - c <- unsafeIOToSTM $ H.lookup cache keyr ++++timeInteger= do TOD t _ <- getClockTime+ return t++++ ++releaseTPVars :: (IResource a,Typeable a)=> [a] -> Ht -> STM ()+releaseTPVars rs cache = mapM_ (releaseTPVar cache) rs++releaseTPVar :: (IResource a,Typeable a)=> Ht -> a -> STM ()+releaseTPVar cache r =do+ c <- unsafeIOToSTM $ H.lookup cache keyr case c of Just (CacheElem _ w) -> do mr <- unsafeIOToSTM $ deRefWeak w@@ -661,27 +681,27 @@ Nothing -> unsafeIOToSTM (finalize w) >> releaseTPVar cache r Just dbref@(DBRef key tv) -> do applyTriggers [dbref] [Just (castErr r)]- t <- unsafeIOToSTM timeInteger - writeTVar tv . Exist $ Elem (castErr r) t t + t <- unsafeIOToSTM timeInteger+ writeTVar tv . Exist $ Elem (castErr r) t t - - Nothing -> do - ti <- unsafeIOToSTM timeInteger ++ Nothing -> do+ ti <- unsafeIOToSTM timeInteger tvr <- newTVar NotRead dbref <- unsafeIOToSTM . evaluate $ DBRef keyr tvr applyTriggers [dbref] [Just r] writeTVar tvr . Exist $ Elem r ti ti- w <- unsafeIOToSTM . mkWeakPtr dbref $ Just $ deleteFromCache dbref - unsafeIOToSTM $ H.update cache keyr (CacheElem (Just dbref) w)-- accesed and modified XXX - return () - - - where keyr= keyResource r - - - - -delListFromHash :: IResource a => Ht -> [a] -> STM () + w <- unsafeIOToSTM . mkWeakPtr dbref $ Just $ fixToCache dbref+ unsafeIOToSTM $ H.update cache keyr (CacheElem (Just dbref) w)-- accesed and modified XXX+ return () + + + where keyr= keyResource r+++ ++delListFromHash :: IResource a => Ht -> [a] -> STM () delListFromHash cache xs= mapM_ del xs where del :: IResource a => a -> STM ()@@ -698,79 +718,122 @@ Nothing -> do unsafeIOToSTM (finalize w) >> del x - +++updateListToHash hash kv= mapM (update1 hash) kv where+ update1 h (k,v)= update h k v++++-- | Start the thread that periodically call `clearSyncCache` to clean and writes on the persistent storage.+-- Otherwise, 'syncCache' or `clearSyncCache` or `atomicallySync` must be invoked explicitly or no persistence will exist.+-- Cache writes allways save a coherent state+clearSyncCacheProc ::+ Int -- ^ number of seconds betwen checks. objects not written to disk are written+ -> (Integer -> Integer-> Integer-> Bool) -- ^ The user-defined check-for-cleanup-from-cache for each object. 'defaultCheck' is an example+ -> Int -- ^ The max number of objects in the cache, if more, the cleanup starts+ -> IO ThreadId -- ^ Identifier of the thread created+clearSyncCacheProc time check sizeObjects= forkIO clear+ where+ clear =handle ( \ (e :: SomeException)-> hPutStr stderr (show e) >> clear ) $ do+ threadDelay (fromIntegral$ time * 1000000)+ clearSyncCache check sizeObjects --`debug` "CLEAR"+ clear++criticalSection mv f= bracket + (takeMVar mv) + (putMVar mv) + $ const $ f++-- | Force the atomic write of all cached objects modified since the last save into permanent storage.+-- Cache writes allways save a coherent state. As allways, only the modified objects are written.+syncCache :: IO ()+syncCache = criticalSection saving $ do+ (cache,lastSync) <- readIORef refcache --`debug` "syncCache"+ t2<- timeInteger+ elems <- toList cache+ (tosave,_,_) <- atomically $ extract elems lastSync+ save tosave+ writeIORef refcache (cache, t2)+ -updateListToHash hash kv= mapM (update1 hash) kv where - update1 h (k,v)= update h k v +data SyncMode= Synchronous -- ^ sync state to permanent storage when `atomicallySync` is invoked + | Asyncronous + {frecuency :: Int -- ^ number of seconds between saves when asyncronous + ,check :: (Integer-> Integer-> Integer-> Bool) -- ^ The user-defined check-for-cleanup-from-cache for each object. 'defaultCheck' is an example + ,cacheSize :: Int -- ^ size of the cache when async + } + | SyncManual -- ^ use `syncCache` to write the state --- | Start the thread that periodically call 'clearSyncCache' to clean and writes on the persistent storage. --- Otherwise, 'syncCache' must be invoked explicitly or no persistence will exist.--- Cache writes allways save a coherent state -clearSyncCacheProc :: - Int -- ^ number of seconds betwen checks. objects not written to disk are written - -> (Integer -> Integer-> Integer-> Bool) -- ^ The user-defined check-for-cleanup-from-cache for each object. 'defaultCheck' is an example - -> Int -- ^ The max number of objects in the cache, if more, the cleanup starts - -> IO ThreadId -- ^ Identifier of the thread created -clearSyncCacheProc time check sizeObjects= forkIO clear - where - clear =handle ( \ (e :: SomeException)-> hPutStr stderr (show e) >> clear ) $ do - threadDelay (fromIntegral$ time * 1000000) - clearSyncCache check sizeObjects --`debug` "CLEAR" - clear - - --- | Force the atomic write of all cached objects modified since the last save into permanent storage --- Cache writes allways save a coherent state -syncCache :: IO () -syncCache = bracket- (takeMVar saving)- (putMVar saving)- $ const $ do- (cache,lastSync) <- readIORef refcache --`debug` "syncCache"- t2<- timeInteger- elems <- toList cache - (tosave,_,_) <- atomically $ extract elems lastSync - save tosave - writeIORef refcache (cache, t2)- - +tvSyncWrite= unsafePerformIO $ newIORef (Synchronous, Nothing) ++-- | Specify the cache synchronization policy with permanent storage. See `SyncMode` for details +-- +syncWrite:: SyncMode -> IO() +syncWrite mode= do + (_,thread) <- readIORef tvSyncWrite + when (isJust thread ) $ killThread . fromJust $ thread + case mode of + Synchronous -> modeWrite + SyncManual -> modeWrite + Asyncronous time check maxsize -> do + th <- clearSyncCacheProc time check maxsize >> return() + writeIORef tvSyncWrite (mode,Just th) + where + modeWrite= writeIORef tvSyncWrite (mode, Nothing) --- |Saves the unsaved elems of the cache--- Cache writes allways save a coherent state --- delete some elems of the cache when the number of elems > sizeObjects. --- The deletion depends on the check criteria. 'defaultCheck' is the one implemented -clearSyncCache :: (Integer -> Integer-> Integer-> Bool)-> Int -> IO () -clearSyncCache check sizeObjects= bracket- (takeMVar saving)- (putMVar saving)- $ const $ do++-- | Perform a synchronization of the cache with permanent storage once executed the STM transaction+-- when 'syncWrite' policy is `Synchronous`+atomicallySync :: STM a -> IO a +atomicallySync proc= atomically $ do + r <- proc + t <- transact + if t then return r else retry + where+ transact= do+ (savetype,_) <- unsafeIOToSTM $ readIORef tvSyncWrite + case savetype of + Synchronous -> do + safeIOToSTM syncCache + return True + _ -> return True+++-- |Saves the unsaved elems of the cache.+-- Cache writes allways save a coherent state.+-- Unlike `syncChace` this call deletes some elems of the cache when the number of elems > @sizeObjects@.+-- The deletion depends on the check criteria, expressed by the first parameter.+-- 'defaultCheck' is the one implemented to be passed by default. Look at it to understand the clearing criteria.+clearSyncCache :: (Integer -> Integer-> Integer-> Bool)-> Int -> IO ()+clearSyncCache check sizeObjects= criticalSection saving $ do (cache,lastSync) <- readIORef refcache t <- timeInteger elems <- toList cache- (tosave, elems, size) <- atomically $ extract elems lastSync - save tosave + (tosave, elems, size) <- atomically $ extract elems lastSync+ save tosave when (size > sizeObjects) $ forkIO (filtercache t cache lastSync elems) >> performGC writeIORef refcache (cache, t) - + where- - -- delete elems from the cache according with the checking criteria ++ -- delete elems from the cache according with the checking criteria filtercache t cache lastSync elems= mapM_ filter elems- where + where filter (CacheElem Nothing w)= return() --alive because the dbref is being referenced elsewere filter (CacheElem (Just (DBRef key _)) w) = do mr <- deRefWeak w case mr of Nothing -> finalize w- Just (DBRef _ tv) -> atomically $ do + Just (DBRef _ tv) -> atomically $ do r <- readTVar tv case r of- Exist (Elem x lastAccess _ ) -> + Exist (Elem x lastAccess _ ) -> if check t lastAccess lastSync then do unsafeIOToSTM . H.update cache key $ CacheElem Nothing w@@ -778,38 +841,38 @@ else return () _ -> return() - - --- | ths is a default cache clearance check. It forces to drop from the cache all the--- elems not accesed since half the time between now and the last sync --- if it returns True, the object will be discarded from the cache +++-- | This is a default cache clearance check. It forces to drop from the cache all the+-- elems not accesed since half the time between now and the last sync+-- if it returns True, the object will be discarded from the cache -- it is invoked when the cache size exceeds the number of objects configured--- in 'clearSyncCacheProc' or 'clearSyncCache' -defaultCheck - :: Integer -- ^ current time in seconds - -> Integer -- ^ last access time for a given object - -> Integer -- ^ last cache syncronization (with the persisten storage) - -> Bool -- ^ return true for all the elems not accesed since half the time between now and the last sync -defaultCheck now lastAccess lastSync - | lastAccess > halftime = False - | otherwise = True - - where - halftime= now- (now-lastSync) `div` 2 +-- in 'clearSyncCacheProc' or 'clearSyncCache'+defaultCheck+ :: Integer -- ^ current time in seconds+ -> Integer -- ^ last access time for a given object+ -> Integer -- ^ last cache syncronization (with the persisten storage)+ -> Bool -- ^ return true for all the elems not accesed since half the time between now and the last sync+defaultCheck now lastAccess lastSync+ | lastAccess > halftime = False+ | otherwise = True -refConditions= unsafePerformIO $ newIORef (return(), return()) + where+ halftime= now- (now-lastSync) `div` 2 +refConditions= unsafePerformIO $ newIORef (return(), return())+ setConditions :: IO() -> IO() -> IO() -- ^ stablishes the procedures to call before and after saving with 'syncCache', 'clearSyncCache' or 'clearSyncCacheProc'. The postcondition of -- database persistence should be a commit. setConditions pre post= writeIORef refConditions (pre, post) saving= unsafePerformIO $ newMVar False- -save tosave = do - (pre, post) <- readIORef refConditions ++save tosave = do+ (pre, post) <- readIORef refConditions pre -- !> (concatMap (\(Filtered x) -> keyResource x)tosave)- mapM (\(Filtered x) -> writeResource x) tosave + mapM (\(Filtered x) -> writeResource x) tosave post @@ -827,18 +890,23 @@ let tofilter = case mybe of Just _ -> ch:val Nothing -> val- in do + in do r <- readTVar tvr case r of- Exist (Elem r _ modTime) -> + Exist (Elem r _ modTime) -> if (modTime >= lastSave) then filter1 (Filtered r:sav) tofilter (n+1) rest- else filter1 sav tofilter (n+1) rest -- !> ("rejected->" ++ keyResource r) + else filter1 sav tofilter (n+1) rest -- !> ("rejected->" ++ keyResource r) - _ -> filter1 sav tofilter (n+1) rest + _ -> filter1 sav tofilter (n+1) rest - +-- | Assures that the IO computation finalizes no matter if the STM transaction+-- is aborted or retried. The IO computation run in a different thread.+-- The STM transaction wait until the completion of the IO procedure (or retry as usual)+-- it can be retried if the embedding STM computation is retried+-- so the IO computation must be idempotent.+-- Exceptions are bubbled up to the STM transaction safeIOToSTM :: IO a -> STM a safeIOToSTM req= unsafeIOToSTM $ do tv <- newEmptyMVar@@ -849,7 +917,6 @@ case r of Right x -> return x Left e -> throw e-
Data/TCache/DefaultPersistence.hs view
@@ -8,30 +8,18 @@ -} {-# LANGUAGE FlexibleInstances, UndecidableInstances , MultiParamTypeClasses, FunctionalDependencies+ , ExistentialQuantification , ScopedTypeVariables+ #-} module Data.TCache.DefaultPersistence(Indexable(..),Serializable(..),defaultPersist,Persist(..)) where- -import Data.TCache.IResource-import Data.Typeable import System.IO.Unsafe-import Data.IORef-import System.Directory-import Control.Monad(when,replicateM)-import System.IO-import System.IO.Error-import Control.Exception as Exception-import Control.Concurrent-import Data.List(elemIndices,isInfixOf)-import Data.Maybe(fromJust)-import Data.TCache.Defs(castErr)-import qualified Data.ByteString.Lazy.Char8 as B----import Debug.Trace------a !> b = trace b a+import Data.Typeable+import Data.Maybe(fromJust) +import Data.TCache.Defs+import Data.TCache @@ -51,143 +39,13 @@ instance Indexable Car where key Car{cname= n} = \"Car \" ++ n @ -}-class Indexable a where- key:: a -> String- defPath :: a -> String -- ^ additional extension for default file paths.- -- The default value is "data/". - -- IMPORTANT: defPath must depend on the datatype, not the value (must be constant). Default is "TCacheData/" - defPath = const "TCacheData/" ---instance IResource a => Indexable a where--- key x= keyResource x--{- | Serialize is an abstract serialization ionterface in order to define implicit instances of IResource.-The deserialization must be as lazy as possible if deserialized objects contain DBRefs,-lazy deserialization avoid unnecesary DBRef instantiations when they are not accessed,-since DBRefs instantiations involve extra cache lookups-For this reason serialization/deserialization is to/from ordinary Strings-serialization/deserialization are not performance critical in TCache--Read, Show, instances are implicit instances of Serializable--> serialize = show-> deserialize= read--Since write and read to disk of to/from the cache must not be very often-The performance of serialization is not critical.--}-class Serializable a {-serialFormat-} | a -> {-serialFormat-} where- serialize :: a -> B.ByteString --serialFormat- deserialize :: {-serialFormat-} B.ByteString -> a- setPersist :: a -> Persist- setPersist _= defaultPersist----instance (Show a, Read a)=> Serializable a where--- serialize= show--- deserialize= read----- | a persist mechanism has to implement these three primitives--- 'defaultpersist' is the default file persistence-data Persist = Persist{- readByKey :: (String -> IO(Maybe B.ByteString)) -- ^ read by key- , write :: (String -> B.ByteString -> IO()) -- ^ write- , delete :: (String -> IO())} -- ^ delete--defaultPersist= Persist- {readByKey= defaultReadByKey- ,write= defaultWrite- ,delete= defaultDelete}--getPersist x= return (setPersist x)- `Exception.catch` (\(e:: SomeException) -> error "setPersist must not depend on the type, not the value of the parameter: " )- instance (Typeable a, Indexable a, Serializable a ) => IResource a where keyResource = key- writeResource s=do- Persist _ f _ <- getPersist s- f (defPath s ++ key s) $ castErr $ serialize s-- readResourceByKey k= iox where- iox= do- Persist f _ _ <- getPersist x- f file >>= return . fmap deserialize . castErr- where- file= defPath x ++ k- x= undefined `asTypeOf` (fromJust $ unsafePerformIO iox)-- delResource s= do- Persist _ _ f <- getPersist s- f $ defPath s ++ key s-----defaultReadByKey :: String-> IO (Maybe B.ByteString) -defaultReadByKey k= iox -- !> "defaultReadByKey"- where- iox = handle handler $ do - s <- readFileStrict k - return $ Just s -- `debug` ("read "++ filename) -- - handler :: IOError -> IO (Maybe B.ByteString) - handler e - | isAlreadyInUseError e = defaultReadByKey k - | isDoesNotExistError e = return Nothing- | otherwise= if ("invalid" `isInfixOf` ioeGetErrorString e)- then- error $ "readResource: " ++ show e ++ " defPath and/or keyResource are not suitable for a file path"- - else defaultReadByKey k---defaultWrite :: String-> B.ByteString -> IO()-defaultWrite filename x= safeWrite filename x-safeWrite filename str= handle handler $ B.writeFile filename str -- !> ("write "++filename)- where - handler e-- (e :: IOError) - | isDoesNotExistError e=do - createDirectoryIfMissing True $ take (1+(last $ elemIndices '/' filename)) filename --maybe the path does not exist - safeWrite filename str --- | otherwise= if ("invalid" `isInfixOf` ioeGetErrorString e)- then- error $ "writeResource: " ++ show e ++ " defPath and/or keyResource are not suitable for a file path" - else do- hPutStrLn stderr $ "defaultWriteResource: " ++ show e ++ " in file: " ++ filename ++ " retrying"- safeWrite filename str- -defaultDelete :: String -> IO()-defaultDelete filename =do- removeFile filename- --print ("delete "++filename) - where- - handler :: String -> IOException -> IO () - handler file e - | isDoesNotExistError e= return () --`debug` "isDoesNotExistError"- | isAlreadyInUseError e= do- hPutStrLn stderr $ "defaultDelResource: busy" ++ " in file: " ++ filename ++ " retrying"--- threadDelay 100000 --`debug`"isAlreadyInUseError"- defaultDelete filename - | otherwise = do- hPutStrLn stderr $ "defaultDelResource: " ++ show e ++ " in file: " ++ filename ++ " retrying" --- threadDelay 100000 --`debug` ("otherwise " ++ show e)- defaultDelete filename- + writeResource =defWriteResource+ readResourceByKey = defReadResourceByKey+ delResource = defDelResource - - --- | Strict read from file, needed for default file persistence -readFileStrict f = openFile f ReadMode >>= \ h -> readIt h `finally` hClose h- where- readIt h= do - s <- hFileSize h - let n= fromIntegral s - str <- B.hGet h n -- replicateM n (B.hGetChar h) - return str
Data/TCache/Defs.hs view
@@ -1,11 +1,30 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-} -module Data.TCache.Defs where+{- | some internal definitions. To use default persistence, use+'Data.TCache.DefaultPersistence' instead -}++module Data.TCache.Defs where import Data.Typeable import Control.Concurrent.STM(TVar)- - +import Data.TCache.IResource++import System.IO.Unsafe+import Data.IORef+import System.Directory+import Control.Monad(when,replicateM)+import System.IO+import System.IO.Error+import Control.Exception as Exception+import Control.Concurrent+import Data.List(elemIndices,isInfixOf)+import Data.Maybe(fromJust)++import qualified Data.ByteString.Lazy.Char8 as B++--import Debug.Trace+--(!>) = flip trace+ type AccessTime = Integer type ModifTime = Integer @@ -25,4 +44,141 @@ Nothing -> error $ "Type error: " ++ (show $ typeOf a) ++ " does not match "++ (show $ typeOf r) ++ "\nThis means that objects of these two types have the same key \nor the retrieved object type is not the stored one for the same key\n" Just x -> x+++class Indexable a where+ key:: a -> String+ defPath :: a -> String -- ^ additional extension for default file paths.+ -- The default value is "data/".++ -- IMPORTANT: defPath must depend on the datatype, not the value (must be constant). Default is "TCacheData/" + defPath = const "TCacheData/"++--instance IResource a => Indexable a where+-- key x= keyResource x++{- | Serialize is an abstract serialization ionterface in order to define implicit instances of IResource.+The deserialization must be as lazy as possible if deserialized objects contain DBRefs,+lazy deserialization avoid unnecesary DBRef instantiations when they are not accessed,+since DBRefs instantiations involve extra cache lookups+For this reason serialization/deserialization is to/from ordinary Strings+serialization/deserialization are not performance critical in TCache++Read, Show, instances are implicit instances of Serializable++> serialize = show+> deserialize= read++Since write and read to disk of to/from the cache must not be very often+The performance of serialization is not critical.+-}+class Serializable a where+ serialize :: a -> B.ByteString+ deserialize :: B.ByteString -> a+ setPersist :: a -> Persist+ setPersist _= defaultPersist++--instance (Show a, Read a)=> Serializable a where+-- serialize= show+-- deserialize= read+++-- | a persist mechanism has to implement these three primitives+-- 'defaultpersist' is the default file persistence+data Persist = Persist{+ readByKey :: (String -> IO(Maybe B.ByteString)) -- ^ read by key+ , write :: (String -> B.ByteString -> IO()) -- ^ write+ , delete :: (String -> IO())} -- ^ delete++defaultPersist= Persist+ {readByKey= defaultReadByKey+ ,write= defaultWrite+ ,delete= defaultDelete}++getPersist x= return (setPersist x)+ `Exception.catch` (\(e:: SomeException) -> error "setPersist must not depend on the type, not the value of the parameter: " )+++++defaultReadByKey :: String-> IO (Maybe B.ByteString) +defaultReadByKey k= iox -- !> "defaultReadByKey"+ where+ iox = handle handler $ do + s <- readFileStrict k + return $ Just s -- `debug` ("read "++ filename) ++ + handler :: IOError -> IO (Maybe B.ByteString) + handler e + | isAlreadyInUseError e = defaultReadByKey k + | isDoesNotExistError e = return Nothing+ | otherwise= if ("invalid" `isInfixOf` ioeGetErrorString e)+ then+ error $ "defaultReadByKey: " ++ show e ++ " defPath and/or keyResource are not suitable for a file path:\n"++ k++"\""+ + else defaultReadByKey k+++defaultWrite :: String-> B.ByteString -> IO()+defaultWrite filename x= safeWrite filename x+safeWrite filename str= handle handler $ B.writeFile filename str -- !> ("write "++filename)+ where + handler e-- (e :: IOError) + | isDoesNotExistError e=do + createDirectoryIfMissing True $ take (1+(last $ elemIndices '/' filename)) filename --maybe the path does not exist + safeWrite filename str +++ | otherwise= if ("invalid" `isInfixOf` ioeGetErrorString e)+ then+ error $ "defaultWriteResource: " ++ show e ++ " defPath and/or keyResource are not suitable for a file path: "++ filename + else do+ hPutStrLn stderr $ "defaultWriteResource: " ++ show e ++ " in file: " ++ filename ++ " retrying"+ safeWrite filename str+ +defaultDelete :: String -> IO()+defaultDelete filename =do+ handle (handler filename) $ removeFile filename+ --print ("delete "++filename) + where+ + handler :: String -> IOException -> IO () + handler file e + | isDoesNotExistError e= return () --`debug` "isDoesNotExistError"+ | isAlreadyInUseError e= do+ hPutStrLn stderr $ "defaultDelResource: busy" ++ " in file: " ++ filename ++ " retrying"+-- threadDelay 100000 --`debug`"isAlreadyInUseError"+ defaultDelete filename + | otherwise = do+ hPutStrLn stderr $ "defaultDelResource: " ++ show e ++ " in file: " ++ filename ++ " retrying" +-- threadDelay 100000 --`debug` ("otherwise " ++ show e)+ defaultDelete filename+ ++defReadResourceByKey k= iox where+ iox= do+ let Persist f _ _ = setPersist x+ f file >>= return . fmap deserialize . castErr+ where+ file= defPath x ++ k+ x= undefined `asTypeOf` (fromJust $ unsafePerformIO iox)++defWriteResource s= do+ let Persist _ f _ = setPersist s+ f (defPath s ++ key s) $ castErr $ serialize s++defDelResource s= do+ let Persist _ _ f = setPersist s+ f $ defPath s ++ key s+ + +-- | Strict read from file, needed for default file persistence +readFileStrict f = openFile f ReadMode >>= \ h -> readIt h `finally` hClose h+ where+ readIt h= do + s <- hFileSize h + let n= fromIntegral s + str <- B.hGet h n -- replicateM n (B.hGetChar h) + return str
Data/TCache/IResource.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables+ {-# LANGUAGE ScopedTypeVariables , UndecidableInstances, FlexibleInstances #-} module Data.TCache.IResource where @@ -13,16 +13,9 @@ import Data.List(elemIndices) import Control.Monad(when,replicateM) import Data.List(isInfixOf)----instance (Typeable a, Typeable b) => Typeable (HashTable a b) where--- typeOf _=mkTyConApp (mkTyCon "Data.HashTable.HashTable") [Data.Typeable.typeOf (undefined ::a), Data.Typeable.typeOf (undefined ::b)] ---import Debug.Trace----debug a b= trace b a -{- | An IResource instance that must be defined for every object being cached. -there are a set of implicit IResource instance trough utiliy classes (See below)+{- | must be defined for every object to be cached. -} class IResource a where {- The `keyResource string must be a unique since this is used to index it in the hash table. @@ -47,19 +40,26 @@ {- | 'readResourceByKey' implements the database access and marshalling or of the object. while the database access must be strict, the marshaling must be lazy if, as is often the case, some parts of the object are not really accesed.- Moreover, if the object contains DBRefs, this avoids unnecesary cache lookups- this method is called inside 'atomically' blocks and thus may be interrupted without calling+ Moreover, if the object contains DBRefs, this avoids unnecesary cache lookups.+ This method is called inside 'atomically' blocks and thus may be interrupted without calling Since STM transactions retry, readResourceByKey may be called twice in strange situations. So it must be idempotent, not only in the result but also in the effect in the database -} readResourceByKey :: String -> IO(Maybe a)- -- | the write operation in persistent storage. It must be strict. - -- Since STM transactions may retry, writeResource must be idempotent, not only in the result but also in the effect in the database- -- all the new obbects are writeen to the database on synchromization- -- so writeResource must not autocommit.- -- Commit code must be located in the postcondition. (see 'setConditions')++ -- To permit accesses not by key. (it defaults as readResourceByKey)+ readResource :: a -> IO (Maybe a)+ readResource x = readResourceByKey $ keyResource x++ -- | The write operation in persistent storage. It must be strict. + -- Since STM transactions may retry, @writeResource@ must be idempotent, not only in the result but also in the effect in the database.+ -- All the new obbects are writeen to the database on synchromization+ -- so writeResource when using a database for persistence must not autocommit.+ -- Commit code must be located in the postcondition. (see `setConditions`)+ -- Since there is no provision for rollback from failure in writing fromIDyn+ -- persistent storage, 'writeResource' must retry until success. writeResource:: a-> IO() - -- | is called syncronously. It must autocommit + -- | Delete the resource. It is called syncronously. It must autocommit delResource:: a-> IO()
Data/TCache/IndexQuery.hs view
@@ -24,7 +24,7 @@ @ import "Data.TCache" import "Data.TCache.IndexQuery"-import "Data.TCache.FilePersistence"+import "Data.TCache.DefaultPersistence" import "Data.Typeable" data Person= Person {pname :: String} deriving (Show, Read, Eq, Typeable)@@ -65,7 +65,7 @@ then a query for @name '.==.' "Bruce"@ is indistinguishable from @surname '.==.' "Bruce"@ -Will return all the registers with surname "Bruce" as well. So if two or more+Will return indexOf the registers with surname "Bruce" as well. So if two or more fields in a registers are to be indexed, they must have different types. -}@@ -73,7 +73,7 @@ {-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses , FunctionalDependencies, FlexibleInstances, UndecidableInstances , TypeSynonymInstances, IncoherentInstances #-}-module Data.TCache.IndexQuery(index, RelationOps(..), recordsWith, (.&&.), (.||.), Select(..)) where+module Data.TCache.IndexQuery(index, RelationOps(..), indexOf, recordsWith, (.&&.), (.||.), Select(..)) where import Data.TCache import Data.TCache.DefaultPersistence@@ -95,7 +95,7 @@ => Read (Index reg a) where readsPrec n ('I':'n':'d':'e':'x':' ':str) = map (\(r,s) -> (Index r, s)) rs where rs= readsPrec n str-+ readsPrec _ s= error $ "indexQuery: can not read index: \""++s++"\"" class (Read reg, Read a, Show reg, Show a, IResource reg,Typeable reg, Typeable a,Ord a) => Queriable reg a instance (Read reg, Read a, Show reg, Show a, IResource reg,Typeable reg, Typeable a,Ord a) => Queriable reg a@@ -237,8 +237,8 @@ join:: (Queriable rec v, Queriable rec' v) =>(v->v-> Bool) -> (rec -> v) -> (rec' -> v) -> STM[([DBRef rec], [DBRef rec'])] join op field1 field2 =do- idxs <- retrieveIndexes field1- idxs' <- retrieveIndexes field2+ idxs <- indexOf field1+ idxs' <- indexOf field2 return $ mix idxs idxs' where opv (v, _ )(v', _)= v `op` v'@@ -302,10 +302,10 @@ return [(zs, union xs ys) | (zs,xs) <- xss] --retrieveIndexes :: (Queriable reg a )+-- | return all the (indexed) registers which has this field+indexOf :: (Queriable reg a ) => (reg -> a) -> STM [(a,[DBRef reg])]-retrieveIndexes selector= do+indexOf selector= do let [one, two]= typeRepArgs $! typeOf selector let rindex= getDBRef $! keyIndex one two mindex <- readDBRef rindex@@ -313,11 +313,11 @@ retrieve :: Queriable reg a => (reg -> a) -> a -> (a -> a -> Bool) -> STM[DBRef reg] retrieve field value op= do- index <- retrieveIndexes field+ index <- indexOf field let higuer = map (\(v, vals) -> if op v value then vals else []) index return $ concat higuer -+-- from a Query result, return the records, rather than the references recordsWith :: (IResource a, Typeable a) => STM [DBRef a] -> STM [ a]
Data/TCache/IndexText.hs view
@@ -24,17 +24,17 @@ deserialize= read . unpack main= do- indexText body T.pack- let doc= Doc{title= "title", body= "hola que tal estamos"}+ 'indexText' body T.pack+ let doc= Doc{title= "title", body= \"hola que tal estamos\"} rdoc <- atomically $ newDBRef doc- r1 <- atomically $ select title $ body `contains` "hola que tal"+ r1 <- atomically $ select title $ body \`'contains'\` \"hola que tal\" print r1 - atomically $ writeDBRef rdoc doc{ body= "que tal"}- r <- atomically $ select title $ body `contains` "hola que tal"+ atomically $ 'writeDBRef' rdoc doc{ body= "que tal"}+ r <- atomically $ 'select' title $ body \`'contains'\` \"hola que tal\" print r- if r1 == [title doc] then print "OK" else print "FAIL"- if r== [] then print "OK" else print "FAIL"+ if r1 == [title doc] then print \"OK\" else print \"FAIL\"+ if r== [] then print \"OK\" else print \"FAIL\" @ -}
+ Data/TCache/Memoization.hs view
@@ -0,0 +1,118 @@+-----------------------------------------------------------------------------+--+-- Module : Memoization+-- Copyright : Alberto GOmez Corona+-- License : BSD3+--+-- Maintainer : agocorona@gmail.com+-- Stability : Experimental+-- Portability : Non portable (uses stablenames)+--+-- |+--+-----------------------------------------------------------------------------+{-# LANGUAGE DeriveDataTypeable+ , ExistentialQuantification+ , FlexibleInstances+ , TypeSynonymInstances #-}+module Data.TCache.Memoization (cachedByKey,cachedp,addrStr,addrHash,Executable(..))++where+import Data.Typeable+import Data.TCache+import Data.TCache.Defs(Indexable(..))+import System.Mem.StableName+import System.IO.Unsafe+import System.Time+import Data.Maybe(fromJust)+import Control.Monad.Trans+import Control.Monad.Identity++import Debug.Trace+(!>)= flip trace++data Cached a b= forall m.Executable m => Cached a (a -> m b) b Integer deriving Typeable+++++-- | return a string identifier for any object+addrStr :: a -> IO String+addrStr x = addrHash x >>= return . show++-- | return a hash of an object+--addrHash :: a -> Int+{-# NOINLINE addrHash #-}+addrHash x= liftIO $ do+ st <- makeStableName $! x+ return $ hashStableName st++++class Executable m where+ execute:: m a -> a++instance Executable IO where+ execute= unsafePerformIO++instance Executable Identity where+ execute (Identity x)= x++instance MonadIO Identity where+ liftIO= Identity . unsafePerformIO++instance (Indexable a, Typeable a) => IResource (Cached a b) where+ keyResource ch@(Cached a f _ _)= "cached"++key a -- ++ unsafePerformIO (addrStr f ) --`debug` ("k="++ show k)++ writeResource _= return ()+ delResource _= return ()+ readResourceByKey= error "access By Indexable is undefined for chached objects"++ readResource (Cached a f _ _)=do+ TOD tnow _ <- getClockTime+ let b = execute $ f a+ return . Just $ Cached a f b tnow++instance Indexable String where+ key= id++-- | memoize the result of a computation for a certain time. This is useful for caching costly data+-- such web pages composed on the fly.+--+-- time == 0 means infinite+cached :: (Indexable a, Typeable a, Typeable b, Executable m,MonadIO m) => Int -> (a -> m b) -> a -> m b+cached time f a= do+ cho@(Cached _ _ b t) <- liftIO $ getResource ( (Cached a f undefined undefined )) >>= return . fromJust+ case time of+ 0 -> return b+ _ -> do+ TOD tnow _ <- liftIO $ getClockTime+ if time /=0 && tnow - t > fromIntegral time+ then do+ liftIO $ deleteResource cho+ cached time f a+ else return b++-- | memoize the result of a computation for a certain time. Instead of a paramter,+-- like in the case of 'cached', a string 'key' is used to index the result+--+-- time == 0 means infinite+cachedByKey :: (Typeable a, Executable m,MonadIO m) => String -> Int -> m a -> m a+cachedByKey key time f = cached time (\_ -> f) key+++-- | a pure version of cached+cachedp :: (Indexable a,Typeable a,Typeable b) => (a ->b) -> a -> b+cachedp f k = execute $ cached 0 (\x -> Identity $ f x) k++--testmemo= do+-- let f x = "hi"++x !> "exec1"+-- let f1 x= "h0"++x !> "exec2"+-- let beacon=1+-- let beacon2=2+-- print $ cachedp f (addrStr "sfs")+-- print $ cachedp f (addrStr "sds")+-- print $ cachedp f1 (addrStr "ssdfddd")+-- print $ cachedp f1 (addrStr "sss")++
TCache.cabal view
@@ -1,70 +1,45 @@-name: TCache-version: 0.9.0.4-synopsis: A Transactional cache with user-defined persistence-description:- TCache is a transactional cache with configurable persitence. It allows conventional- STM transactions for objects that syncronize with- their user defined storages. Default persistence in files is provided for testing purposes- State in memory and into permanent storage is transactionally coherent.+name: TCache+version: 0.10.0.0+cabal-version: >= 1.6+build-type: Simple+license: BSD3+license-file: LICENSE+maintainer: agocorona@gmail.com+synopsis: A Transactional cache with user-defined persistence+description: TCache is a transactional cache with configurable persitence. It allows conventional+ STM transactions for objects that syncronize with+ their user defined storages. Default persistence in files is provided for testing purposes+ State in memory and into permanent storage is transactionally coherent.+ .+ See "Data.TCache" for details - 0.9.0.4 : solved a bug in the management of weak pointers that "evaporated" registers from the cache- 0.9.0.3 : Solved a "lost registers" bug.- 0.9.0.1 : Solves a bug when object keys generate invalid filenames.- changes in defaultPersistence to further separate serialization from input-output- .- 0.9: This version now has full text search. Serialization is now trough byteStrings+category: Data, Database+author: Alberto Gómez Corona+tested-with: GHC ==7.0.3+data-dir: ""+extra-source-files: demos/DBRef.hs demos/DynamicSample.hs+ demos/IndexQuery.hs demos/basicSample.hs demos/caching.hs+ demos/triggerRelational.lhs - .- This version support the backward compatible stuff, that permits transparent- retrievals of objects and transcactions between objects without directly using STM references- ('with*Resource(s)' calls), Now it goes in the oposite direction by providing explicit STM persistent- references (called 'DBRefś') that leverage the nice and traditional haskell reference syntax- for performing database transactions.- .- 'DBRef's are in essence, persistent TVars indexed in the cache, with a traditional 'readDBRef',- 'writeDBRef' Haskell interface in the STM monad.- Additionally, because DBRefs are serializable, they can be embeded in serializable registers.- Because they are references,they point to other serializable registers.- This permits persistent mutable and efficient Inter-object relations.- .- Triggers are also included in this release. They are user defined hooks that are called back on register updates. That can be used for- easing the actualization of inter-object relations and also permit more higuer level- and customizable accesses. The internal indexes used for the query language uses triggers. - .- It also implements an straighforwards non-intrusive pure-haskell type safe query language based- on register field relations. This module must be imported separately. See- "Data.TCache.IndexQuery" for further information- .- Now the file persistence is more reliable.The IO reads are safe inside STM transactions.- .- To ease the implementation of other user-defined persistence, "Data.TCache.DefaultPersistence" needed- to be imported explcitly for deriving file persistence instances.- .- The 0.9 version adds full text indexation and search, incorporated in the experimental query language- .- It also changes the default Persistence mechanism. Now ByteStrings are used for serialization and deserialization- . a Serializable class and a Persist structure decouple serialization to/from bytestring- and write-read to file. Both can be redefined separately, so default persistence can be changed with `setPersist`- to write to blobs in databases, for example. Default persistence has'nt to be in files.+source-repository head+ type: git+ location: https://github.com/agocorona/TCache -category: Data, Database, Concurrency-license: BSD3-license-file: LICENSE-author: Alberto Gómez Corona-maintainer: agocorona@gmail.com-Tested-With: GHC == 7.0.3-Build-Type: Simple-build-Depends: base >=4 && <5,directory >= 1.0, old-time >=1.0,stm>=2, containers >= 0.1.0.1,transformers >=0.2 && <0.3, text, bytestring+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,+ RefSerialize -any -exposed-modules: Data.TCache, Data.TCache.DefaultPersistence- , Data.TCache.IndexQuery,Data.TCache.IndexText, Data.TCache.Triggers- , Data.TCache.IResource, Data.TCache.Defs+ exposed-modules: Data.TCache Data.TCache.DefaultPersistence,+ Data.TCache.Defs Data.TCache.IResource Data.TCache.IndexQuery+ Data.TCache.IndexText Data.TCache.Memoization Data.TCache.Triggers+ Data.Persistent.Collection+ exposed: True+ buildable: True+ extensions: OverlappingInstances UndecidableInstances+ ScopedTypeVariables DeriveDataTypeable+ hs-source-dirs: .+ other-modules: -extra-source-files: demos/basicSample.hs- demos/caching.hs- demos/DBRef.hs- demos/DynamicSample.hs- demos/IndexQuery.hs- demos/triggerRelational.lhs-ghc-options: