TCache 0.5.4 → 0.5.5

raw patch · 6 files changed

+664/−82 lines, 6 filesdep +stmPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: stm

API changes (from Hackage documentation)

Files

• Data/TCache.hs +84/−70
• Data/TCache/Dynamic.hs +221/−0
• Data/TCache/Dynamic2.hs +198/−0
• DynamicSample.hs +56/−0
• Sample2.hs +91/−0
• TCache.cabal +14/−12

@@ -27,7 +27,9 @@ 
 ,Operation (Insert,Delete) -- data definition used to communicate object Inserts and Deletes to the cache
 
-,Cache            -- :: IORef (Ht a,Int, Integer)     --The cache definition 
+,Cache            -- :: IORef (Ht a,Int, Integer)     --The cache definition ++ ,setCache        -- :: Cache a -> IO()   -- set the cache. this is useful for hot loaded modules that will use an existing cache
 
 ,getTVars        -- :: (IResource a)=> [a]           -- the list of resources to be retrieved                   --    -> IO [Maybe (TVar a)]        -- The Transactional variables (See Data.TVar documentation)@@ -68,7 +70,8 @@                      --   -> >IO ThreadId                --Identifier of the thread created
 
 -- the default check procedure
-,defaultCheck    -- :: Integer                          --last access time for a given object
+,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
@@ -82,7 +85,8 @@ 
 import GHC.Conc
 import Control.Exception as Exception
-import Control.Concurrent
+import Control.Concurrent+import Control.Monad(when)
 import Data.HashTable as H
 import Data.IORef
 import System.IO
@@ -92,7 +96,7 @@ import Data.Maybe(catMaybes,mapMaybe)
 import Debug.Trace
 import System.Directory-+import Data.List(elemIndices) 
 
 debug1 a b= trace b a
@@ -128,7 +132,7 @@              handle :: a -> IOError -> IO (Maybe a)              handle x e               |isAlreadyInUseError e = readResource x    -- maybe is being written. try again. -                                                         -- Not really needed since no write is done while read+                                                                        | isDoesNotExistError e = return Nothing               | isPermissionError e = error $ "no permissions for opening file: "++filename               | otherwise= error $ "unspecified error: " ++ show e
@@ -140,12 +144,14 @@              handle :: a -> IOError -> IO ()              handle x e                | isDoesNotExistError e=do-                          createDirectory $ defPath x --maybe the path does not exist+                          createDirectoryIfMissing True $ take (1+(last $ elemIndices '/' filename)) filename   --maybe the path does not exist                           writeResource x                                | isAlreadyInUseError e= writeResource x -- maybe is being read. try again                                                            -- Not really needed since no write is done while read                | isPermissionError e = error $ "no permissions for writing file: "++ filename
-+
+               | otherwise= error $ show e
+                	delResource:: a->IO()
 	delResource x= handleJust Exception.ioErrors (handle x) $ removeFile $ defPath x ++ keyResource x              where@@ -164,23 +170,33 @@ type Block a=  (TVar a,AccessTime,ModifTime)
 type Ht a= HashTable String (Block a)
 -- contains the hastable, number of items, last sync time
-type Cache a= IORef (Ht a,Int, Integer)
+type Cache a= IORef (Ht a, Integer)
 data CheckBlockFlags= AddToHash | NoAddToHash | MaxTime
 -- the cache holder
++ref2cache :: IORef (Maybe (Cache a))+ref2cache= unsafePerformIO $ newIORef Nothing +-- set the cache. this is useful for hot loaded modules that will update an existing cache+setCache :: Cache a -> IO()+setCache ch= writeIORef ref2cache  $ Just ch 
 refcache :: Cache a 
-refcache =unsafePerformIO $  do c <-  H.new (==) hashString
-				newIORef (c,0,nowTime 1)
-
+refcache =unsafePerformIO $do+          n <- readIORef ref2cache+          case n of+             Nothing -> do +                          c <-  H.new (==) hashString
+	                  newIORef (c,0)
+             Just ch -> return ch
 
 getTVars :: (IResource a)=> [a] -> IO [Maybe (TVar a)] getTVars rs= do-    (cache,_,_) <- readIORef refcache
+    (cache,_) <- readIORef refcache
     takeBlocks rs cache MaxTime
 	
 withResourcesID:: (IResource a)=> [a]->([Maybe a]->[Operation a])->IO ()
 withResourcesID rs f=  do
-	(cache,_,_) <- readIORef refcache
+	(cache,_) <- readIORef refcache
         mtrs  <- takeBlocks rs cache NoAddToHash
 	idrs <- atomically $ do
 	    mrs <- mapM mreadTVar mtrs
@@ -219,7 +235,7 @@  withResources:: (IResource a)=> [a]->([Maybe a]->[a])->IO ()
 withResources rs f=  do
-	(cache,size,time) <- readIORef refcache 
+	(cache,_) <- readIORef refcache 
         mtrs  <-   takeBlocks rs cache NoAddToHash                    
@@ -239,7 +255,7 @@ 	c <-  H.lookup cache keyr
 	case c of
 		Nothing   -> do
-                  mr <- readResource r -- `debug1` ("read "++keyr++ " hash= "++ (show $ H.hashString  keyr))
+                  mr <- readResource r                       -- `debug1` ("read "++keyr++ " hash= "++ (show $ H.hashString  keyr))
 		  case mr of
                     Nothing -> return Nothing
 	            Just r2 -> do 
@@ -247,22 +263,25 @@ 			case flags of
                            NoAddToHash -> return $ Just tvr
                            AddToHash   -> do 
+                                    ti  <-  timeInteger
 			            H.update cache keyr (tvr, ti, 0) -- accesed, not modified
                                     return $ Just tvr
-                           MaxTime -> do+                                    
+                           MaxTime -> do
+                                    ti  <-  timeInteger
+                                    let maxtime= ti + 1000000000                                     H.update cache keyr (tvr, maxtime, maxtime) -- accesed, not modified
                                     return $ Just tvr-                                    where-                                    maxtime= ti + 10000000
+                                    +                                    
 
 		Just(tvr,_,_)  -> return $ Just tvr
 
 	where 	keyr= keyResource r
-		ti= t `seq` t where TOD t _=unsafePerformIO getClockTime
  releaseTVars :: (IResource a)=> [a]-> IO() releaseTVars rs=do-  (cache,_,_) <- readIORef refcache
+  (cache,_) <- readIORef refcache
   atomically $ releaseBlocks rs cache   
 releaseBlocks :: (IResource a)=> [a] -> Ht a  ->STM ()@@ -273,56 +292,60 @@ 	c <- unsafeIOToSTM $ H.lookup cache keyr
 	case c of
 	    Nothing   -> do tvr <- newTVar r  
+	                    ti  <- unsafeIOToSTM timeInteger
 			    unsafeIOToSTM $ H.update cache keyr (tvr, ti, ti ) -- accesed and modified XXX
 								 
 				
 	    Just(tvr,_,tm)  ->do  writeTVar tvr r
-				  unsafeIOToSTM $ H.update cache keyr (tvr ,ti,ti)
+	                          ti  <- unsafeIOToSTM timeInteger
+	                          let t=  max ti tm
+				  unsafeIOToSTM $ H.update cache keyr (tvr ,t,t)
 									
 					
 						
 	where 	keyr= keyResource r
-		ti= t `seq` t where TOD t _=unsafePerformIO getClockTime-
+                
+                
+timeInteger= do TOD t _ <- getClockTime
+                return t
+		         
 getResource r= do{mr<-getResources [r];return $! head mr}
 
 getResources:: (IResource a)=>[a]-> IO [Maybe a]
 getResources rs= do
-   (cache,_,_) <- readIORef refcache 
+   (cache,_) <- readIORef refcache 
    mtrs <- takeBlocks rs cache AddToHash
    atomically $ mapM mreadTVar mtrs
 		
 
 deleteResource r= deleteResources [r]
 deleteResources rs=do   
-   (cache,_,time) <- readIORef refcache 
+   (cache,_) <- readIORef refcache 
    atomically $! do
 	unsafeIOToSTM $ mapM delResource rs
 	unsafeIOToSTM $ delListFromHash cache $ map keyResource rs
         
- where
-    ntime= nowTime 1
 
+
 delListFromHash  hash l= do{mapM (delete hash) l; return()}
 
 updateListToHash hash kv= do{mapM (update1 hash) kv; return()}where
 	update1 h (k,v)= update h k v
 
 -----------------------clear, sync cache-------------
-clearSyncCacheProc ::(IResource a)=> Cache a->Int->(Integer->Integer->Bool)->Int->IO ThreadId
+clearSyncCacheProc ::(IResource a)=> Cache a->Int->(Integer -> Integer->Integer->Bool)->Int->IO ThreadId
 clearSyncCacheProc refcache time check sizeObjects= 
-  	forkIO $ clear refcache time check sizeObjects
+  	forkIO  clear   
 
  where - clear :: (IResource a) => Cache a->Int->(Integer->Integer->Bool)->Int->IO ()- clear refcache time check sizeObjects= do
+ clear = do
     	threadDelay $ (fromIntegral$ time * 1000000)
-    	clearSyncCache refcache time check sizeObjects
-    	clear refcache  time check sizeObjects
+    	clearSyncCache refcache time check sizeObjects  
+    	clear 
  
 
 syncCache refcache = do
-   (cache,_,_) <- readIORef refcache 
+   (cache,_) <- readIORef refcache 
    list <- toList cache
    atomically $ save list 0 
    --print $ "write to persistent storage finised: "++ show (length list)++ " objects" 
@@ -330,59 +353,50 @@ --  - saves the unsaved elems of the cache
 --  - 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 ::(IResource a) => Cache a-> Int -> (Integer->Integer-> Bool)-> Int -> IO ()
+clearSyncCache ::(IResource a) => Cache a-> Int -> (Integer -> Integer->Integer-> Bool)-> Int -> IO ()
 clearSyncCache refcache time check sizeObjects=do
-   (cache,size,last) <- readIORef refcache 
+   (cache,lastSync) <- readIORef refcache 
    handle (\e->do{print e;return ()})$ do
-    (nsize,ntime) <- atomically $  clearCache cache size last check sizeObjects
-    writeIORef refcache (cache,size, ntime) 
-
-save:: (IResource a) => [(String, Block a)]-> Integer-> STM ()
-save list lastSave= mapM_ save1 list 
-  where-        save1 ::  IResource a =>(String, Block a) -> STM()
-	save1(_, (tvr,_,modTime))= do  
-		if modTime > lastSave 
-		  then do
-			r<-  readTVar tvr
-			unsafeIOToSTM $! writeResource r  --`debug1` ("saved " ++ keyResource r)
-		  else return()
-
-nowTime x = t where TOD t _=unsafePerformIO getClockTime
-
-
-
-clearCache:: (IResource a) =>Ht a->Int->Integer->
-              (Integer->Integer-> Bool)->Int -> STM (Int,Integer)
-
-clearCache cache size lastSync check sizeObjects= do
-	elems <- unsafeIOToSTM $ toList cache
-	let size=length elems
-	save elems lastSync 
-	if size > sizeObjects then filtercache lastSync elems else return (size,lastSync) 
-
+      elems <-   toList cache
+      let size=length elems
+      atomically $ save elems lastSync 
+      t<- timeInteger 
+      when (size > sizeObjects)  (filtercache t cache lastSync elems) 
+      writeIORef refcache (cache, t) 
 
   where
         -- delete elems from the cache according with the check criteria
-	filtercache lastSync elems= do
-	    n <- unsafeIOToSTM $ mapM filter elems 
-	    return(size - sum n,nowTime 1)
+	filtercache t cache lastSync elems= mapM_ filter elems 	    
 	    where
-		check1 (_,lastAccess,_)=check lastAccess lastSync 
+		check1 (_,lastAccess,_)=check t lastAccess lastSync 
 
 		filter ::(String,Block a)->IO Int
 		filter (k,e)=  if check1 e then do{H.delete cache k;return 1} else return 0
 
 --to drop from the cache all the elems not accesed since  half the time between now and the last sync
-defaultCheck:: Integer->Integer->Bool
-defaultCheck lastAccess lastSync
+defaultCheck:: Integer -> Integer->Integer->Bool
+defaultCheck  now lastAccess lastSync
 	| lastAccess > halftime = False
 	| otherwise  = True
 
         where 
         halftime= now- (now-lastSync) `div` 2
-        now= nowTime 1
+      
   
+
+save:: (IResource a) => [(String, Block a)]-> Integer-> STM ()
+save list lastSave= mapM_ save1 list                                           --`debug1` "saving"
+  where+        save1 ::  IResource a =>(String, Block a) -> STM()
+	save1(_, (tvr,_,modTime))= do 
+		if modTime >= lastSave                                         --`debug1` ("modTime="++show modTime++"lastSave="++show lastSave)
+		  then do
+			r<-  readTVar tvr
+			unsafeIOToSTM $! writeResource r                       --`debug1` ("saved " ++ keyResource r)
+		  else return()
+
+
+
 
 
 readFileStrict f = do

@@ -0,0 +1,221 @@+{-# OPTIONS -fglasgow-exts  -fallow-undecidable-instances -fbang-patterns #-}++-- Data.TCache.Dynamic:+-- a dynamic interface for TCache+ +module Data.TCache.Dynamic(+  T.IResource(..)   -- from TCache+  ,T.Operation(..)+  ,T.setCache+  ,T.refcache+  ,T.defaultCheck,T.readFileStrict+  ,IDynamic(..)        -- serializable/indexable existential datatype+  ,T.Cache+  ,DynamicInterface (   +    toIDyn           -- :: x -> IDynamic+    ,registerType   -- :: x -> IO()          +    ,fromIDyn        -- :: IDynamic -> x+    ,unsafeFromIDyn  -- :: IDynamic -> x+   )+  ,Key(..)            {- Key datatype can be used to read any object trough the Dynamic interface++                          let key= <key of the object >+                          mst <- getDResource $ Key key+                          case mst of+                           Nothing -> error $ "getResource: not found "++ key +                           Just (idyn) -> do+                             let st = fromIDyn idyn :: <desired datatype>+                             ....+                     -}++-- same access interface , this time for Dynamic type. See Data.TCache for their equivalent definitions+,getDTVars,withDResource, withDResources, withDResourcesID, getDResource, getDResources, deleteDResource, deleteDResources+++-- syncache has no parameters now (see Data.TCache.syncCache)
+,syncCache++-- Same than Data.TCache but without Cache parameter
+,clearSyncCacheProc
+
+-- the same interface for any datatype:
+, withResource, withResources, withResourcesID, getResource, getResources, deleteResource, deleteResources
+++)++where+import System.IO.Unsafe+import Control.Concurrent.MVar+import Data.Typeable+import Unsafe.Coerce+import qualified Data.TCache as T+import Debug.Trace+import Control.Concurrent.STM(TVar)+import Unsafe.Coerce++++debug a b= trace b a ++data IDynamic= forall a. (Typeable a, T.IResource a) => IDynamic  a deriving Typeable++++type Deserializer =   (String, (String -> IDynamic ))+list :: MVar [fromStringr]++list = unsafePerformIO $ newMVar [] ++instance  T.IResource IDynamic  where+   keyResource (IDynamic  x)= T.keyResource x+   defPath (IDynamic x)= T.defPath x+   serialize (IDynamic  x)= show (typeOf x) ++ "\n"++ T.serialize x+   deserialize str= case lookup  key (unsafePerformIO $ readMVar list) of+                           Nothing ->   error $ "not registered type "++key++" please registerType it"+                           Just f  ->   f (tail objstr)  +                                                      +     where+     (key, objstr)= span (/='\n') str+++instance Show IDynamic where+ show (IDynamic x)= "(IDynamic \""++show (typeOf x) ++"\" "++  T.serialize x++")"+  ++class DynamicInterface  x where + toIDyn :: x -> IDynamic+ registerType ::   IO x+ fromIDyn :: IDynamic -> x+ unsafeFromIDyn :: IDynamic -> x+ -- get(toIDyn x)== x++instance (T.IResource x,Typeable x) => DynamicInterface  x where+ toIDyn x= IDynamic  x+ + registerType = do+       let x= unsafeCoerce 1 :: x+       let f= T.deserialize :: (String -> x)        +       let f1 s= IDynamic  (f s) +       l <- takeMVar list+       case lookup (strType x) l of+         Just _ -> do+                   putMVar list l+                   return x+         _      -> do+                   putMVar list $ (strType x ,f1):l+                   return x+       where+       strType x= show $ typeOf x+       + fromIDyn d@(IDynamic  a)= if type2 == type1 then v+                        else error ("fromIDyn: casting "++ show type1 ++" to type "++show type2 ++" for data "++ T.serialize a)+           where +           v=  unsafeCoerce a :: x+           type1= typeOf a+           type2= typeOf v+ + unsafeFromIDyn (IDynamic  a)= unsafeCoerce a+ +{- Key datatype can be used to read any object trough the Dynamic interface++                          let key= <key of the object >+                          mst <- getDResource $ Key key+                          case mst of+                           Nothing -> error $ "getResource: not found "++ key +                           Just (idyn) -> do+                             let st = fromIDyn idyn :: <desired datatype>+-}++data Key= Key String deriving Typeable+instance T.IResource Key where+  keyResource (Key k)=k+  serialize (Key x)= x+  deserialize str= Key str+
+withDResource :: IDynamic->(Maybe IDynamic->IDynamic)->IO ()
+withDResource =  T.withResource +
+withDResources:: [IDynamic]->([Maybe IDynamic]->[IDynamic])->IO ()
+withDResources =  T.withResources 
+withDResourcesID :: [IDynamic]->([Maybe IDynamic]->[T.Operation IDynamic])->IO ()
+withDResourcesID =  T.withResourcesID +
+getDResource :: IDynamic ->  IO (Maybe IDynamic)
+getDResource  = T.getResource 
+
+getDResources :: [IDynamic] ->  IO [Maybe IDynamic]
+getDResources = T.getResources
++getDTVars ::  [IDynamic] -> IO [Maybe (TVar IDynamic)]+getDTVars= T.getTVars+
+-- return error if any resource is not found
+justGetDResources rs=do mrs <- getDResources rs
+                        return $ map process $ zip mrs rs  
+        where
+            process (Nothing, r) = error ("\""++T.keyResource r ++ "\" does not exist")
+            process (Just r', _) = r'
+    
+justGetDResource r= do  [r']<- justGetDResources [r]
+                        return r'
+
+                 
+
+deleteDResource :: IDynamic -> IO ()
+deleteDResource= T.deleteResource
++deleteDResources :: [IDynamic] -> IO ()
+deleteDResources= T.deleteResources
+
+syncCache=   T.syncCache (T.refcache :: T.Cache IDynamic) 
+                 
+                
+
+clearSyncCacheProc= T.clearSyncCacheProc (T.refcache :: T.Cache IDynamic)
+
+withResource ::(Typeable a, T.IResource a) => a->(Maybe a->a)->IO ()
+withResource r f=  withResources [r] (\[mr]-> [f mr])+
+withResources::(Typeable a, T.IResource a) => [a]->([Maybe a]->[a])->IO ()
+withResources rs f=  withDResources (map toIDyn rs) (\mrs-> f' mrs) where+          f' = map toIDyn . f . map g+          g Nothing= Nothing+          g (Just x)= Just (fromIDyn x)+          +
+withResourcesID :: (Typeable a, T.IResource a) => [a]->([Maybe a]->[T.Operation a])->IO ()
+withResourcesID rs f=  withDResourcesID (map toIDyn rs) (\mrs-> f' mrs) where+          f' = map h . f . map  g+          g Nothing= Nothing+          g (Just x)= Just (fromIDyn x)+          h (T.Insert x)= T.Insert $ toIDyn x+          h (T.Delete x)= T.Delete $ toIDyn x+          +          
+getResource ::(Typeable a, T.IResource a) => a ->  IO (Maybe a)
+getResource  x= getDResource (toIDyn x) >>= return . g where 
+          g Nothing= Nothing+          g (Just x)= Just (fromIDyn x)+          
+getResources ::(Typeable a, T.IResource a) => [a] ->  IO [Maybe a]
+getResources rs = getDResources (map toIDyn rs) >>= return . map g where
+          g Nothing= Nothing+          g (Just x)= Just (fromIDyn x)
+
+                 
+
+deleteResource ::(Typeable a, T.IResource a) => a -> IO ()
+deleteResource x= deleteDResource (toIDyn x)
+
+deleteResources ::(Typeable a, T.IResource a) => [a] -> IO ()
+deleteResources xs= deleteDResources (map toIDyn xs)
+
+
+
+                 
+                
+
+
++  

@@ -0,0 +1,198 @@+{-# OPTIONS -fglasgow-exts  -fallow-undecidable-instances -fbang-patterns #-}++-- IDynamic: an Extensible, serializable, T.IResource datatype,+-- to be used within any container in order to handle, store and retrieve+-- heterogeneous datatypes defined in different modules.++module Data.TCache.Dynamic(+  T.IResource(..),+  Register (+    toDyn           -- :: x -> IDynamic+    ,registerType   -- :: x -> IO()+    ,fromDyn        -- :: IDynamic -> x+    ,unsafeFromDyn  -- :: IDynamic -> x+))++where+import System.IO.Unsafe+import Control.Concurrent.MVar+import Data.Typeable+import Unsafe.Coerce+import qualified Data.TCache as T+import Debug.Trace++++debug a b= trace b a ++type IDynamic= forall a. (Typeable a, T.IResource a) =>   a ++++type Deserializer =   (String, (String -> IDynamic ))+list :: MVar [fromStringr]++list = unsafePerformIO $ newMVar [] +++instance  T.IResource IDynamic  where+   keyResource (  x)= T.keyResource x+   serialize (  x)= show (typeOf x) ++ "\n"++ T.serialize x+   deserialize str= case lookup  key (unsafePerformIO $ readMVar list) of+                           Nothing ->   error $ "not registered type "++key++" please registerType it"+                           Just f  ->  unsafeCoerce $ f tail  +                                                      +     where+     (key, tail)= span (/='\n') str+++instance Show IDynamic where+ show x= T.serialize x+  ++class Register  x where + toDyn :: x -> IDynamic+ registerType ::  x -> IO()+ fromDyn :: IDynamic -> x+ unsafeFromDyn :: IDynamic -> x+ -- get(toDyn x)== x++instance (T.IResource x,Typeable x) => Register  x where+ toDyn x= unsafeCoerce  x+ + registerType  x = do+       let f= T.deserialize :: (String -> x)        +       let f1 s= unsafeCoerce  (f s) +       l <- takeMVar list+       putMVar list $ (show $ typeOf x ,f1):l+       + fromDyn (  a)= if type2 == type1 then v+                        else error ("fromDyn: casting "++ "from type "++ T.serialize a ++" to type "++show type2)+           where +           v=  unsafeCoerce a :: x+           type1= typeOf a+           type2= typeOf v+ + unsafeFromDyn (  a)= unsafeCoerce a+ +
+withDResource :: IDynamic->(Maybe IDynamic->IDynamic)->IO ()
+withDResource =  T.withResource +
+withDResources:: [IDynamic]->([Maybe IDynamic]->[IDynamic])->IO ()
+withDResources =  T.withResources 
+withDResourcesID :: [IDynamic]->([Maybe IDynamic]->[T.Operation IDynamic])->IO ()
+withDResourcesID =  T.withResourcesID +
+getDResource :: IDynamic ->  IO (Maybe IDynamic)
+getDResource  = T.getResource 
+
+getDResources :: [IDynamic] ->  IO [Maybe IDynamic]
+getDResources = T.getResources
+
+-- return error if any resource is not found
+justGetDResources rs=do mrs <- getDResources rs
+                        return $ map process $ zip mrs rs  
+        where
+            process (Nothing, r) = error ("\""++T.keyResource r ++ "\" does not exist")
+            process (Just r', _) = r'
+    
+justGetDResource r= do  [r']<- justGetDResources [r]
+                        return r'
+
+                 
+
+deleteDResource :: IDynamic -> IO ()
+deleteDResource= T.deleteResource
+
+
+syncCache=   T.syncCache (T.refcache :: T.Cache IDynamic) 
+                 
+                
+
+clearSyncCacheProc= T.clearSyncCacheProc (T.refcache :: T.Cache IDynamic)
+
+++
+withResource ::(Typeable a, T.IResource a) => a->(Maybe a->a)->IO ()
+withResource r f=  withResources [r] (\[mr]-> [f mr])+
+withResources::(Typeable a, T.IResource a) => [a]->([Maybe a]->[a])->IO ()
+withResources rs f=  withDResources (map toDyn rs) (\mrs-> f' mrs) where+          f' = map toDyn . f . map g+          g Nothing= Nothing+          g (Just x)= Just (fromDyn x)+          +
+withResourcesID :: (Typeable a, T.IResource a) => [a]->([Maybe a]->[T.Operation a])->IO ()
+withResourcesID rs f=  withDResourcesID (map toDyn rs) (\mrs-> f' mrs) where+          f' = map h . f . map  g+          g Nothing= Nothing+          g (Just x)= Just (fromDyn x)+          h (T.Insert x)= T.Insert $ toDyn x+          h (T.Delete x)= T.Delete $ toDyn x+          +          
+getResource ::(Typeable a, T.IResource a) => a ->  IO (Maybe a)
+getResource  x= getDResource (toDyn x) >>= return . g where 
+          g Nothing= Nothing+          g (Just x)= Just (fromDyn x)+          
+getResources ::(Typeable a, T.IResource a) => [a] ->  IO [Maybe a]
+getResources rs = getDResources (map toDyn rs) >>= return . map g where
+          g Nothing= Nothing+          g (Just x)= Just (fromDyn x)
+
+                 
+
+deleteResource ::(Typeable a, T.IResource a) => a -> IO ()
+deleteResource x= deleteDResource (toDyn x)
+
+
+
+
+                 
+                
+
+
++++-------------- tests---------++instance T.IResource Int where+   keyResource _= "I"+   serialize = show+   deserialize = read+  +  + +instance T.IResource String where+   keyResource _= "S"+   serialize = show+   deserialize = read+++++test= do++  registerType (1::Int)+  registerType ("hola")+  + +  withResources  []  (\_->[1 ::Int, 1::Int])+  withResources  []  (\_->[ "hola", "hola"])+  +  syncCache +  +  res <- getResources [1::Int,  1::Int]+  print res+  +  res <- getResources ["hola", "hola"]+  print res+  +  res <- getDResources [toDyn "hola", toDyn ( 1::Int)]+  print res+  

@@ -0,0 +1,56 @@+{-# OPTIONS -XTypeSynonymInstances #-}
+-- XTypeSynonymInstances added only to permit IResource instances for Strings
+module Main where
+import Data.TCache.Dynamic
+
+{------------- tests---------
+example of IDynamic usage.
+
+-}
+
+--very simple data:
+--two objects with two different datatypes: Int and String
+
+instance IResource Int where     
+   keyResource _= "I"
+   serialize = show
+   deserialize = read
+   defPath _= "data/"
+  
+  
+ 
+instance IResource String where
+   keyResource _= "S"
+   serialize = show
+   deserialize = read
+   defPath _= "data/"
+
+
+
+
+main= do
+
+  registerType :: IO Int           -- register both datatypes (Int, and String)
+  registerType :: IO String
+  
+  let x= 1:: Int
+  withDResources  []  (\_->[toIDyn x, toIDyn "hola"])   --resource creation for the example
+  
+  syncCache                                    --syncCache now has no parameters (refcache is not used)
+  
+  res <- getResources [1::Int,  1::Int]        --getResources works as allways 
+  print res
+  
+  res <- getResources ["hola", "hola"]         --with multiple datatypes this time
+  print res
+  
+  res <- getDResources [toIDyn "hola", toIDyn ( 1::Int)]  -- DResource calls can manage many datatypes simultaneously
+  print res
+  
+  mres <- getDResource $ IDynamic $ Key "S"        --Key permits to retrieve any object of any datatype
+  case mres of
+   Nothing -> error "not found"
+   Just res -> do
+     print (fromIDyn  res :: String)              -- get the String content
+  
+     print (fromIDyn res :: Int)                  -- error reported: casting a String object to Int

@@ -0,0 +1,91 @@+ module Main where+-------------------------------------------------+-- A example of Transactional cache usage (TCache.hs)+-- (Something like the Java Hibernate)+-- Author: Alberto Gómez Corona Nov 2006+-- Language: Haskell+-- Terms of use: you can do whatever you want+-- with this code as long as you keep this notice+------------------------------------------------++import Data.TCache++import Control.Concurrent+import Debug.Trace++debug a b= trace b a++--1 and 4: The data elements to be used in the example++data  Data=   Data Int String+ +              deriving (Read, Show)++--3 The mappings between the cache and the phisical storage are defined by the interface IResource++--      to extract the resource unique key, required++--      to serialize/deserialize it into/from a String, required++--      to define the prefix used for default persistence in files (if prefix have "/", a folder will be created)++-- OPTINONAL:++--      to read the resource from the physical storage, (default provided in file)++--      to store it  (default provided)++--      to delete the resource from the physical storage. (default provided)++ ++instance IResource Data where+        keyResource         (Data i _)= show i   +        serialize x= show x+        deserialize x= read x+        defPath _ = "data/"  -- directory where the data is stored.+        +        -- other definable methods: readResource, writeResource delResource. here the default persistence in files are used+        +-- buy is the operation to be performed in the example++--4 withResources gets a partial definition of each resource necessary for extracting the key, +--fill all the rest of the data structures (if found ) and return a list of Maybe Data. +--BuyIt is part of the domain problem. it receive this list and generates a new list of +--data objects that are updated in the cache. buyIt is executed atomically.++++++main= do+        --asyncronous write every 10 seconds, 100 elems max cache+        clearSyncCacheProc (refcache :: Cache Data) 10 defaultCheck 100 +        +        -- create resources (+        -- (acces no resources and return two new Data objects defined in items)+        withResources[] (\_ ->[Data i "olddata" | i <-[1..200]])+              +        -- after 10 seconds, 200 files  have been created in the folder "data"+        -- because 200 exceeds the maximum cache size (100) defaultCheck will discard +        -- then 150 first and older elems from cache to reduce it to a half.+        +        +        -- wait 20 seconds +        +        threadDelay 20000000+        +        +        print "modifyng"+        --update all the list. discarded elems from cache are also updated atomically+        withResources[]  (\_ ->[Data i "newdata" | i <-[1..200]]) +        --state in disk is also atomically written.+        +       +        +        threadDelay 20000000+       +        +++

@@ -1,17 +1,12 @@ name:                TCache-version:             0.5.4+version:             0.5.5 synopsis:            A Transactional data cache with configurable persistence  description: -        This version correct an error in the version 0.5.3. since 0.5 nothing in the code has changed except that-        the  "&& <4" in the build dependencies added in the 0.5.3 the behaviour of getClocktime to be lazy, that indeed-        makes the cache write algoritm not to work, with the result tha no file is written. -        This version force the strict evaluation and correct this error.-                    Data.Tcache is a transactional cache with configurable persistence. It tries to simulate Hibernate          for Java or Rails for Ruby. The main difference is that transactions are done in memory trough STM.          There are transactional cache implementations for some J2EE servers like JBOSS. -        TCache uses STM . It can  atomically apply a function to a list of cached objects. The resulting +        TCache uses STM. It can  atomically apply a function to a list of cached objects. The resulting          objects go back to the cache (withResources). It also can retrieve these objects (getResources).           Persistence can be syncronous (syncCache)  or asyncronous, wtih configurable time between cache          writes and configurable cache clearance strategy. the size of the cache can be configured too . @@ -19,12 +14,19 @@         directly (getTVar) to acceess all the semantic of atomic blocks while maintaining the persistence of the          TVar updates. -        Persistence can be defined for each object.: Each object must have a defined key, a default filename+        Persistence can be defined for each object: Each object must have a defined key, a default filename         path (if applicable). Persistence is pre-defined in files, but the readResource writeResource and          delResource methods can be redefined to persist in databases or whatever. -        There is a Sample.hs that explain the main features.-+        There are  Samples here that explain the main features.+        +        +        In this release:+           Added a Data.TCache.Dynamic.  (SEE dynamicsample.hs)+             - Can handle, transact, and serialize to disk many datatypes simultaneously and incrementally+             - Dynamic uses the same interface than TCache and add *DResource(s) calls +             - Safe dynamic data handling trough a lighter, indexable and serializable version of Data.Dynamic+             - Added KEY object for retrieving any object of any type.   category:            Middleware@@ -34,8 +36,8 @@ maintainer:          agocorona@gmail.com Tested-With:         GHC == 6.8.2 Build-Type:          Simple-build-Depends:       base >=3 && <4,directory >= 1.0, old-time >=1.0+build-Depends:       base >=3 && <4,directory >= 1.0, old-time >=1.0,stm>=2 Cabal-Version:       >= 1.2 -exposed-modules:   Data.TCache+exposed-modules:   Data.TCache, Data.TCache.Dynamic ghc-options: