TCache 0.8.0.2 → 0.9

raw patch · 8 files changed

+479/−127 lines, 8 filesdep +bytestringdep +textPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, text

API changes (from Hackage documentation)

Files

• Data/TCache.hs +43/−39
• Data/TCache/DefaultPersistence.hs +188/−0
• Data/TCache/Defs.hs +9/−0
• Data/TCache/FilePersistence.hs +0/−23
• Data/TCache/IResource.hs +17/−8
• Data/TCache/IndexQuery.hs +35/−46
• Data/TCache/IndexText.hs +172/−0
• TCache.cabal +15/−11

@@ -141,11 +141,7 @@ {- | cached objects must be instances of IResource. Such instances can be implicitly derived trough auxiliary clasess for file persistence -}-,IResource(..)   -- class interface to be implemented for the object by the user
-,Serializable(..)
-,Indexable(..)--+,IResource(..)  -- * Operations with cached objects {- | Operations with DBRef's can be performed implicitly with the \"traditional\" TCache operations@@ -248,11 +244,6 @@ ,clearSyncCacheProc  
 ,defaultCheck -- * auxiliary file operations used for default persistence in files.
-,readFileStrict-,defaultReadResource                                                                  
-,defaultReadResourceByKey-,defaultWriteResource-,defaultDelResource
 )
 where 
 
@@ -268,20 +259,17 @@ import Data.TCache.Defs
 import Data.TCache.IResource import Data.TCache.Triggers
-import Control.Exception(handle,assert, SomeException)+import Control.Exception(handle,assert, bracket, SomeException) import Data.Typeable
 import System.Time import System.Mem import System.Mem.Weak-import Debug.Trace+--import Debug.Trace  import Control.Concurrent.MVar
  ---debug a b = trace b a-+--debug = flip trace  -- there are two references to the DBRef here -- The Maybe one keeps it alive until the cache releases it for *Resources@@ -483,11 +471,16 @@   mr <- readDBRef dbref   case mr of    Just x -> do-     safeIOToSTM $ delResource x      applyTriggers [dbref] [Nothing]      writeTVar tv DoNotExist++     safeIOToSTM $ bracket+       (takeMVar saving)+       (putMVar saving)+       $ const $ delResource x+    Nothing -> return ()-    --withSTMResources [] $ const  resources{toDelete=[x]}+     		
  @@ -535,11 +528,15 @@   case f mrs of
       Retry  -> retry
       Resources  as ds r  -> do-          safeIOToSTM $ mapM_ delResource ds           applyTriggers (map (getDBRef . keyResource) as) (map Just as)           applyTriggers (map (getDBRef . keyResource) ds) (repeat (Nothing  `asTypeOf` (Just(head ds))))           delListFromHash cache   ds
-          releaseTPVars as cache 
+          releaseTPVars as cache++          safeIOToSTM $ bracket+             (takeMVar saving)+             (putMVar saving)+             $ const $ mapM_ delResource ds
           return r
   
   where@@ -709,13 +706,17 @@ -- | 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  = do-  (cache,lastSync) <- readIORef refcache-  t2<- timeInteger-  elems <- toList cache
-  (tosave,_,_) <- atomically $ extract elems lastSync
-  save tosave
-  writeIORef refcache (cache, t2) 
+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)+  
 
 
 
@@ -724,14 +725,18 @@ --  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=do-  (cache,lastSync) <- readIORef refcache-  t <- timeInteger-  elems <- toList cache-  (tosave, elems, size) <- atomically $ extract elems lastSync
-  save tosave  
-  when (size > sizeObjects) $  forkIO (filtercache t cache lastSync elems) >> performGC-  writeIORef refcache (cache, t)+clearSyncCache check sizeObjects= bracket+  (takeMVar saving)+  (putMVar saving)+  $ const $ do+      (cache,lastSync) <- readIORef refcache+      t <- timeInteger+      elems <- toList cache+      (tosave, elems, size) <- atomically $ extract elems lastSync
+      save tosave  
+      when (size > sizeObjects) $  forkIO (filtercache t cache lastSync elems) >> performGC+      writeIORef refcache (cache, t)+           
   where 
@@ -782,14 +787,13 @@  saving= unsafePerformIO $ newMVar False 
-save  tosave = do-     takeMVar saving
+save  tosave = do
      (pre, post) <-  readIORef refConditions
      pre      mapM (\(Filtered x) -> writeResource x) tosave
      post-     putMVar saving  False + data Filtered= forall a.(IResource a)=> Filtered a  @@ -817,7 +821,7 @@            
 safeIOToSTM :: IO a -> STM a-safeIOToSTM req= unsafeIOToSTM $  do+safeIOToSTM req= unsafeIOToSTM  $ do   tv   <- newEmptyMVar   forkIO $ req >>= putMVar  tv   takeMVar tv

@@ -0,0 +1,188 @@+{- |++This module provides default persistence , understood as retrievong and storing thje object in serialized blobs+for Indexable and serializable instances. The user can define it with setPersist. If the user does not+set it, persistence in files is used.+++-}+{-# LANGUAGE   FlexibleInstances, UndecidableInstances+               , MultiParamTypeClasses, FunctionalDependencies+               , ExistentialQuantification+                #-}+module Data.TCache.DefaultPersistence(Indexable(..),Serializable(..),setPersist,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++--debug a b = trace b a++{- | Indexable is an utility class used to derive instances of IResource++Example:++@data Person= Person{ pname :: String, cars :: [DBRef Car]} deriving (Show, Read, Typeable)+data Car= Car{owner :: DBRef Person , cname:: String} deriving (Show, Read, Eq, Typeable)+@++Since Person and Car are instances of 'Read' ans 'Show', by defining the 'Indexable' instance+will implicitly define the IResource instance for file persistence:++@+instance Indexable Person where  key Person{pname=n} = \"Person \" ++ n+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+-}+class Serializable a {-serialFormat-} | a -> {-serialFormat-} where+  serialize   :: a -> B.ByteString --serialFormat+  deserialize :: {-serialFormat-} B.ByteString -> a++{-+instance (Show a, Read a)=> Serializable a where+  serialize= show+  deserialize= read+-}+++-- |+data Persist = Persist{+       readByKey   ::  (String -> IO(Maybe B.ByteString)) -- ^  read+     , write       ::  (String -> B.ByteString -> IO())   -- ^  write+     , delete      ::  (String -> IO())}       -- ^  delete++defaultPersist= Persist+    {readByKey= defaultReadByKey+    ,write= defaultWrite+    ,delete= defaultDelete}+++persist :: IORef  Persist+persist = unsafePerformIO $ newIORef $  defaultPersist++-- | set an alternative persistence for Indexable and Serializable objects+setPersist ::  Persist -> IO ()+setPersist p = writeIORef persist   p+++instance  (Typeable a,  Indexable a, Serializable a ) => IResource a where++  keyResource = key+  writeResource s=do+      Persist _ f _ <- readIORef persist+      f (defPath s ++ key s) $ castErr $ serialize s++  readResourceByKey k= iox where+    iox= do+      Persist f _ _ <- readIORef persist+      f  file >>= return . fmap  deserialize . castErr+      where+      file= defPath x ++ k+      x= undefined `asTypeOf` (fromJust $ unsafePerformIO iox)++  delResource s= do+      Persist _ _ f <- readIORef persist+      f $ defPath s ++ key s+++++defaultReadByKey ::   String-> IO (Maybe B.ByteString)
+defaultReadByKey k= iox+     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     --`debug` ("write "++filename)+safeWrite filename str= handle  handler  $ B.writeFile filename str+     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 =do+                --phPutStrLn 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+
++
+
+-- | 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+

@@ -17,3 +17,12 @@ type TPVar a=   TVar (Status(Elem a))  data DBRef a= DBRef String  (TPVar a)  deriving Typeable+++
+castErr a= r where+  r= case cast a of+      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+

@@ -1,23 +0,0 @@-{-# LANGUAGE   FlexibleInstances, UndecidableInstances #-}-module Data.TCache.FilePersistence where-
--import Data.TCache.IResource----- | Read, Show,  instances are implicit instances of Serializable-instance (Show a, Read a) => Serializable a where-    serialize= show-    deserialize= read------- | Serializable, Indexable instances are implicit instances of IResource-instance  (Serializable a, Indexable a) => IResource a where-        keyResource =key-        readResourceByKey = defaultReadResourceByKey 
-        writeResource = defaultWriteResource
-    	delResource = defaultDelResource--

@@ -78,7 +78,7 @@ resources =  Resources  [] [] ()
 
 -+{-  {- | Indexable is an utility class used to derive instances of IResource @@ -119,18 +119,15 @@   deserialize :: String -> a  +-} +++{- defaultReadResource :: (Serializable a, Indexable a, Typeable a) =>  a -> IO (Maybe a) defaultReadResource x= defaultReadResourceByKey $ key x -   
-castErr a= r where-  r= case cast a of-      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 - defaultReadResourceByKey :: (Serializable a, Indexable a) =>  String-> IO (Maybe a)
 defaultReadResourceByKey k= iox      where@@ -202,3 +199,15 @@       return str
     
 +newtype Transient a= Transient a++-- | Transient wraps any indexable object for living in the cache, but not+-- in persistent storage. This is useful for memoization.+-- @Transient x@ is neither writeen nor read.+instance Indexable a => IResource (Transient a) where+   keyResource (Transient x)= key x+   readResourceByKey = const $ return Nothing+   writeResource= const $ return ()+   delResource = const $ return ()++-}

@@ -70,12 +70,13 @@  -} -{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses+{-# LANGUAGE  DeriveDataTypeable, MultiParamTypeClasses , FunctionalDependencies, FlexibleInstances, UndecidableInstances-, TypeSynonymInstances, IncoherentInstances  #-}-module Data.TCache.IndexQuery(index,RelationOps(..), recordsWith, (.&&.), (.||.), Select(..)) where+, TypeSynonymInstances, IncoherentInstances #-}+module Data.TCache.IndexQuery(index, RelationOps(..), recordsWith, (.&&.), (.||.), Select(..)) where  import Data.TCache+import Data.TCache.DefaultPersistence import Data.List import Data.Typeable import Control.Concurrent.STM@@ -84,11 +85,25 @@ import Data.IORef import qualified  Data.Map as M import System.IO.Unsafe+import Data.ByteString.Lazy.Char8(pack, unpack)   -newtype Index reg a= Index (M.Map a [DBRef reg]) deriving (Read, Show, Typeable)+data Index reg a= Index (M.Map a [DBRef reg]) deriving (  Show, Typeable) +instance (IResource reg, Typeable reg,Read reg,Show reg, Show a, Read a, Ord a)+   => 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+++class (Read reg, Read a, Show reg, Show a, IResource reg,Typeable reg, Typeable a,Ord a) => Queriable reg a++instance (Queriable reg a) => Serializable (Index reg a)  where+  serialize= pack . show+  deserialize= read . unpack++ keyIndex treg tv= "Index " ++ show treg ++ show tv  instance (Typeable reg, Typeable a) => Indexable (Index reg a) where@@ -97,6 +112,7 @@        [typeofreg, typeofa]= typeRepArgs $! typeOf map  +{- instance (IResource reg,Typeable reg, Ord a,Read reg, Read a, Show reg, Show a) => Serializable (Index reg a) where    serialize= show    deserialize= read@@ -130,15 +146,18 @@ persistIndex :: IORef (Maybe PersistIndex) persistIndex = unsafePerformIO $ newIORef Nothing --+-} +getIndex :: (Queriable reg a)+   => ( reg -> a) -> a -> STM(DBRef (Index reg a), Index reg a,[DBRef reg]) getIndex selector val= do    let [one, two]= typeRepArgs $! typeOf selector    let rindex= getDBRef $! keyIndex one two    getIndexr rindex val  +getIndexr :: (Queriable reg a)+   => DBRef(Index reg a) -> a -> STM(DBRef (Index reg a), Index reg a,[DBRef reg]) getIndexr rindex val= do    mindex <- readDBRef rindex @@ -151,15 +170,8 @@    return (rindex, Index index, dbrefs)  selectorIndex-  :: (Typeable reg,-      IResource reg,-      Typeable a,-      Read reg,-      Show reg,-      Read a,-      Show a,-      Ord a,-      Indexable reg) =>+  :: (Queriable reg a+      ) =>      (reg -> a) -> DBRef (Index reg a) -> DBRef reg -> Maybe reg -> STM ()  selectorIndex selector rindex pobject mobj = do@@ -193,15 +205,7 @@ -}  index-  :: (Typeable reg,-      Typeable a,-      Read reg,-      Show reg,-      Read a,-      Show a,-      Ord a,-      IResource reg,-      Indexable reg) =>+  :: (Queriable reg a) =>      (reg -> a) -> IO () index sel=    let [one, two]= typeRepArgs $! typeOf sel@@ -218,15 +222,7 @@  -- Instance of relations betweeen fields and values -- field .op. valued-instance (Indexable reg,-         Typeable reg,-         Typeable a,-         Show reg,-         Ord a,-         Show a,-         Read a,-         IResource reg,-         Read reg) => RelationOps (reg -> a) a  [DBRef reg] where+instance (Queriable reg a) => RelationOps (reg -> a) a  [DBRef reg] where     (.==.) field value= do        (_ ,_ ,dbrefs) <- getIndex field value        return dbrefs@@ -237,8 +233,7 @@     (.<=.)  field value= retrieve field value (<=)  -join:: (Typeable rec,IResource rec, Typeable v, Typeable rec', IResource rec', Read v,-       Show v, Read rec, Show rec, Ord v, Read rec', Show rec')+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@@ -254,15 +249,7 @@  -- Instance of relations betweeen fields -- field1 .op. field2-instance (IResource  reg,-         Typeable reg,-         IResource reg',-         Typeable reg',-         Typeable a,-         Ord a,-         Read a,-         Show a, Read reg, Show reg, Read reg', Show reg',-         Serializable a) =>RelationOps (reg -> a) (reg' -> a)  (JoinData reg reg') where+instance (Queriable reg a ,Queriable reg' a ) =>RelationOps (reg -> a) (reg' -> a)  (JoinData reg reg') where      (.==.)= join (==)     (.>.) = join (>)@@ -313,8 +300,9 @@      ys <- fys      return [(zs, union xs ys) | (zs,xs) <- xss] -retrieveIndexes :: (Typeable reg, Typeable a, Read a, Show a-                   , Read reg, Show reg, Ord a, IResource reg)+++retrieveIndexes :: (Queriable reg a )                    => (reg -> a) -> STM [(a,[DBRef reg])] retrieveIndexes selector= do    let [one, two]= typeRepArgs $! typeOf selector@@ -322,6 +310,7 @@    mindex <- readDBRef rindex    case mindex of Just (Index index) -> return $ M.toList index; _ -> return [] +retrieve :: Queriable reg a => (reg -> a) -> a -> (a -> a -> Bool) -> STM[DBRef reg] retrieve field value op= do    index <- retrieveIndexes field    let higuer = map (\(v, vals) -> if op v value then  vals else [])  index

@@ -0,0 +1,172 @@+{-# LANGUAGE TypeSynonymInstances+             , DeriveDataTypeable+             , FlexibleInstances+             , UndecidableInstances+             , MultiParamTypeClasses #-}+module Data.TCache.IndexText(indexText, contains) where++{-Implements full text indexation (`indexText`) and text search(`contains`), as an addition to+the query language implemented in `Data.TCache.IndexQuery`++An example:++@+data Doc= Doc{title, body :: String} deriving (Read,Show, Typeable)+instance Indexable Doc where+  key Doc{title=t}= t++instance Serializable Doc  where+  serialize= pack . show+  deserialize= read . unpack++main= do+  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"+  print r1++  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"+@++-}+import Data.TCache+import Data.TCache.IndexQuery+import Data.TCache.DefaultPersistence+import qualified Data.Text.Lazy as T+import Data.Typeable+import qualified Data.Map as M+import Data.Maybe (catMaybes)+import Data.Bits+import System.Mem.StableName+import Data.List((\\))+import GHC.Conc(unsafeIOToSTM)+import Control.Concurrent(forkIO)+import Data.Char+import Control.Concurrent(threadDelay)+import Data.ByteString.Lazy.Char8(pack, unpack)++data IndexText=  IndexText+        { fieldType :: !String+        , lastDoc :: Int+        , mapDocKeyInt :: M.Map String Int+        , mapIntDocKey :: M.Map Int String+        , mapTextInteger :: M.Map T.Text Integer++         } deriving (Typeable)+++instance Show IndexText  where+   show (IndexText t a b c d)= show (t,a,b,c,d)++instance Read IndexText  where+  readsPrec n str= [(IndexText t a b c d, str2)| ((t,a,b,c,d),str2) <- readsPrec n str]++instance Serializable IndexText  where+  serialize= pack . show+  deserialize= read . unpack++instance  Indexable IndexText  where+   key (IndexText v _ _ _ _)=    "IndexText " ++ v+++readInitDBRef v x= do+  mv <- readDBRef x+  case mv of+    Nothing -> writeDBRef x v >> return v+    Just v -> return v++add ref t key w = op ref t setBit w key+del ref t key w = op ref t clearBit w key++op refIndex t set w key =  do+ if T.length w <3+  then return ()+  else do+   mindex <- readDBRef refIndex+   case mindex of+       Nothing -> writeDBRef refIndex $ IndexText t 0 (M.singleton key 0) (M.singleton  0 key) (M.singleton w 1)+       Just (IndexText t n mapSI mapIS map) -> do+        let (docLocation,n', mapSI')= case M.lookup key mapSI  of+               Nothing  -> let n'= n+1 in (n', n', M.insert key n' mapSI)  -- new Document+               Just m -> (m,n, mapSI)         -- already indexed document++        case M.lookup w map of+         Nothing ->    --new word+            writeDBRef refIndex $ IndexText t  n mapSI mapIS (M.insert w (set 0 docLocation) map)+         Just integer ->  -- word already indexed+               writeDBRef refIndex $ IndexText t n mapSI mapIS $ M.insert w (set integer docLocation) map++-- | start a trigger to index the contents of a register field+indexText+  :: (IResource a, Typeable a, Typeable b)+     => (a -> b)      -- ^ field to index+     -> (b -> T.Text) -- ^ method to convert the field content to Text (for example `pack` in case of String fields). This permits to index non Textual fields+     -> IO ()+indexText sel convert= addTrigger (indext sel refIndex convert) where+ [t1,t2]=  typeRepArgs $! typeOf sel+ t=  show t1 ++ show t2+ refIndex= getDBRef . key $ IndexText t u u u u where u= undefined+ indext :: (IResource a, Typeable a) => (a -> b) -> DBRef IndexText -> (b -> T.Text)  -> DBRef a -> Maybe a -> STM()+ indext sel refIndex convert dbref  mreg= f1 --  unsafeIOToSTM $! f+  where+  f=  forkIO (atomically f1) >> return()+  f1=  do+   moldreg <- readDBRef dbref+   case ( moldreg,  mreg) of+      (Nothing, Just reg)    -> mapM_ (add refIndex t (keyResource reg))    . words1 . convert $ sel reg+      (Just oldreg, Nothing) -> mapM_ (del refIndex t (keyResource oldreg)) . words1 . convert $ sel oldreg+      (Just oldreg, Just reg) -> do+        st  <- unsafeIOToSTM $ makeStableName $ sel oldreg -- test if field+        st' <- unsafeIOToSTM $ makeStableName $ sel reg    -- has changed+        if st== st'+          then return ()+          else do+            let key= keyResource reg+            let wrds = words1 . convert $ sel oldreg+            let wrds'= words1 . convert $ sel reg+            let new=  wrds' \\ wrds+            let old= wrds \\ wrds'+            mapM (del refIndex t key) old+            mapM (add refIndex t key) new+            return()++search :: (IResource a, Typeable a, Typeable b) => (a -> b)  -> T.Text -> STM [DBRef a]+search  sel w = do+    let [t1, t2]=  typeRepArgs $! typeOf sel+    let t=  show t1 ++ show t2+    let u= undefined+    mr <- withSTMResources [IndexText t u u u u]+       $ \[r] -> resources{toReturn= r}+    case mr of+      Nothing -> return []+      Just (IndexText t n _ mmapIntString map1) ->+       case M.lookup w map1 of+        Nothing ->  return []+        Just integer ->  do+            let mns=map (\n ->case testBit integer n of True -> Just n; _ -> Nothing)  [0..n]+            let wordsr = catMaybes $ map (\n -> M.lookup n mmapIntString) $ catMaybes mns+            return $ map getDBRef wordsr++words1= T.split (\c -> isSeparator c || c=='\n' || isPunctuation c )++-- | return the DBRefs whose fields include all the words of length three or more in the requested text contents+contains+  :: (IResource a, Typeable a, Typeable b)+  =>( a -> b)      -- ^ field to search in+   -> String       -- ^ text to search+   -> STM [DBRef a]+contains sel str= let text= T.pack str in case  T.words text of+     [] -> return []+     [w] -> search sel w+     ws  -> do+        let rs = map (search sel) $ filter (\t -> T.length t >2) ws+        foldl (.&&.) (head rs)  (tail rs)++++

@@ -1,8 +1,10 @@ name:                TCache-version:             0.8.0.2-synopsis:            Data caching and Persistent STM transactions+version:             0.9+synopsis:            A Transactional cache with user-defined persistence description: +    This version now has full text search. Serialization is now trough byteStrings+     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@@ -29,25 +31,27 @@     .     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.FIlePersistence" needed+    To ease the implementation of other user-defined persistence, "Data.TCache.DefaultPersistence" needed     to be imported  explcitly for deriving file persistence instances.     .-    In this release some stuff has been supressed without losing functionality. Dynamic interfaces-    are not needed since TCache can handle heterogeneous data.--+    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.  category:            Data, Database, Concurrency license:             BSD3 license-file:        LICENSE author:              Alberto Gómez Corona maintainer:          agocorona@gmail.com-Tested-With:         GHC == 7.0+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+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  -exposed-modules:   Data.TCache, Data.TCache.FilePersistence-                   , Data.TCache.IndexQuery, Data.TCache.Triggers+exposed-modules:   Data.TCache, Data.TCache.DefaultPersistence+                   , Data.TCache.IndexQuery,Data.TCache.IndexText, Data.TCache.Triggers                    , Data.TCache.IResource, Data.TCache.Defs ghc-options:       -O2