SetIndexPersist

Data/TCache.hs

@@ -133,6 +133,7 @@ DBRef's and @*Resource(s)@ primitives are completely interoperable. The latter o
 ,newDBRef
 --,newDBRefIO
 ,readDBRef
+,readDBRefs
 ,writeDBRef
 ,delDBRef
 
@@ -379,14 +380,45 @@ readDBRef dbref@(DBRef key  tv)= do
        return $ Just x
    DoNotExist -> return $ Nothing
    NotRead ->  do
-     r <-   safeIOToSTM $ readResourceByKey key
-     case r of
-       Nothing -> writeTVar tv DoNotExist >> return Nothing
-       Just x  -> do
+       r <- safeIOToSTM $ readResourceByKey key
+       case r of
+         Nothing -> writeTVar tv DoNotExist >> return Nothing
+         Just x  -> do
            t <- unsafeIOToSTM timeInteger
-           writeTVar tv $ Exist $ Elem  x t t
+           writeTVar tv $ Exist $ Elem  x t (-1)
            return $ Just  x
 
+-- | Read multiple DBRefs in a single request using the new 'readResourcesByKey'
+readDBRefs :: (IResource a, Typeable a)  => [DBRef a] -> STM [(Maybe a)]
+readDBRefs dbrefs= do
+  let mf (DBRef key  tv)= do
+      r <- readTVar tv
+      case r of
+        Exist (Elem x _ mt) -> do
+          t <- unsafeIOToSTM timeInteger
+          writeTVar tv  . Exist $ Elem x t mt
+          return $ Right $ Just x
+        DoNotExist -> return $ Right Nothing
+        NotRead ->  return $ Left key
+  inCache <- mapM mf dbrefs
+  let pairs = foldr(\pair@(x,dbr) xs -> case x of Left k -> pair:xs; _ -> xs ) [] $ zip inCache dbrefs
+  let (toReadKeys, dbrs) = unzip pairs
+  let fromLeft (Left k)= k
+      formLeft _ = error "this will never happen"
+  rs <- safeIOToSTM . readResourcesByKey $ map fromLeft toReadKeys
+  let processTVar (r, DBRef key  tv)= do
+           case r of
+             Nothing -> writeTVar tv DoNotExist
+             Just x  -> do
+               t <- unsafeIOToSTM timeInteger
+               writeTVar tv $ Exist $ Elem  x t (-1)
+
+  mapM_ processTVar $ zip rs dbrs
+  let mix (Right x:xs) ys   = x:mix xs ys
+      mix (Left _:xs) (y:ys)= y:mix xs ys
+
+  return $ mix inCache rs
+
 -- | 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
@@ -715,7 +747,8 @@ takeDBRef cache flags x =do
             Just dbref -> return . Just $! castErr dbref
             Nothing -> unsafeIOToSTM (finalize w)  >> takeDBRef cache flags x
        Nothing   -> do
-           safeIOToSTM $ readToCache flags cache  keyr -- unsafeIOToSTM $ readResourceByKey keyr
+           safeIOToSTM $ readToCache flags cache  keyr
+              -- unsafeIOToSTM $ readResourceByKey keyr
 
    where
    readToCache flags cache key= do
@@ -724,7 +757,7 @@ takeDBRef cache flags x =do
             Nothing -> return Nothing
             Just r2 -> do
                ti  <-   timeInteger
-               tvr <-   newTVarIO . Exist $ Elem r2 ti ti
+               tvr <-   newTVarIO . Exist $ Elem r2 ti (-1)
                case flags of
                    NoAddToHash -> return . Just $ DBRef key  tvr
                    AddToHash   -> do

Data/TCache/DefaultPersistence.hs

@@ -8,7 +8,9 @@
 {- | This module decouples the 'IResource" class in two classes
  one for key extraction 'Indexable' and other ('Serializable" for serlalization and persistence
  .The last one defines persistence in files as default, but it can be changed
- to persistence in databases, for examople.
+ to persistence in databases, for example.
+
+ The definitions of these classes are  in Defs.hs
 -}
 module Data.TCache.DefaultPersistence(
 Indexable(..)
@@ -33,4 +35,6 @@ instance  (Typeable a,  Indexable a, Serializable a) => IResource a where
   readResourceByKey = defReadResourceByKey
   delResource = defDelResource
 
-
+-- | By default the  index of a `Serializable` data persist with the data.
+instance Serializable a => PersistIndex a where
+   persistIndex= setPersist

Data/TCache/Defs.hs

@@ -101,11 +101,17 @@ The performance of serialization is not critical.
 class Serializable a  where
   serialize   :: a -> B.ByteString
   deserialize :: B.ByteString -> a
+  deserialize= error "No deserialization defined for your data"
   deserialKey :: String -> B.ByteString -> a
   deserialKey _ v= deserialize v
   setPersist  :: a -> Maybe Persist              -- ^ `defaultPersist` if Nothing
   setPersist =  const Nothing
 
+-- |  Used by IndexQuery for index persistence(see "Data.TCache.IndexQuery".
+class PersistIndex a where
+   persistIndex :: a -> Maybe Persist
+
+
 type Key= String
 --instance (Show a, Read a)=> Serializable a where
 --  serialize= show

Data/TCache/IResource.hs

@@ -40,11 +40,15 @@ class IResource a where
         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.
         If the object contains DBRefs, this avoids unnecesary cache lookups.
-        This method is called inside 'atomically' blocks.
+        This method is called within 'atomically' blocks.
         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
         . However, because it is executed by 'safeIOToSTM' it is guaranteed that the execution is not interrupted.
         -}
         readResourceByKey :: String -> IO(Maybe a)
+        readResourceByKey k= return . head =<< readResourcesByKey [k]
+        -- | hopefully optimized read of many objects by key.
+        readResourcesByKey :: [String] -> IO [Maybe a]
+        readResourcesByKey = mapM readResourceByKey
 
         -- To allow accesses not by key but by any criteria based on the content of the record fields
         -- included in the -partial- definition of the input record. (it defaults as @readResourceByKey $ keyResource x@)
@@ -60,11 +64,19 @@ class IResource a where
         -- Since there is no provision for rollback from failure in writing to
         -- persistent storage, 'writeResource' must retry until success.
     	writeResource:: a-> IO()
-
-        -- | Delete the resource. It is called syncronously. So it must tocommit   
+    	writeResource r= writeResources [r]
+
+    	-- | multiple write (hopefully) in a single request. That is up to you and your backend
+    	-- . Defined by default as 'mapM_ writeResource'
+    	writeResources :: [a] -> IO()
+    	writeResources= mapM_ writeResource
+
+        -- | Delete the resource. It is called syncronously. So it must commit   
     	delResource:: a-> IO()
-
-
+    	delResource x= delResources [x]
+
+        delResources :: [a] -> IO()
+        delResources= mapM_ delResource
 -- | Resources data definition used by 'withSTMResources'    
 data Resources a b
        = Retry             -- ^ forces a retry

Data/TCache/IndexQuery.hs

@@ -53,8 +53,7 @@ Will produce:
 NOTES:
 
 * the index is instance of 'Indexable' and 'Serializable'. This can be used to
-persist in the user-defined storoage. If "Data.TCache.FilePersistence" is included
-the indexes will be written in files.
+persist in the user-defined storage using DefaultPersistence
 
 * The Join feature has not been properly tested
 
@@ -72,7 +71,7 @@ fields in a registers are to be indexed, they must have different types.
 
 {-# LANGUAGE  DeriveDataTypeable, MultiParamTypeClasses
 , FunctionalDependencies, FlexibleInstances, UndecidableInstances
-, TypeSynonymInstances, IncoherentInstances #-}
+, TypeSynonymInstances, IncoherentInstances, OverlappingInstances #-}
 module Data.TCache.IndexQuery(
   index
 , (.==.)
@@ -85,9 +84,7 @@ module Data.TCache.IndexQuery(
 , (.&&.)
 , (.||.)
 , select
-, Queriable
-, setIndexPersist
-, getIndexPersist)
+, Queriable)
 where
 
 import Data.TCache
@@ -102,21 +99,22 @@ import qualified  Data.Map as M
 import System.IO.Unsafe
 import Data.ByteString.Lazy.Char8(pack, unpack)
 
+
 class (Read reg, Read a, Show reg, Show a
       , IResource reg,Typeable reg
-      , Typeable a,Ord a)
+      , Typeable a,Ord a,PersistIndex reg)
       => Queriable reg a
 
 instance (Read reg, Read a, Show reg, Show a
       , IResource reg,Typeable reg
-      , Typeable a,Ord a)
+      , Typeable a,Ord a,PersistIndex reg)
       => Queriable reg a
 
---instance  Queriable reg a => IResource (Index reg a) where
---  keyResource = key
---  writeResource =defWriteResource
---  readResourceByKey = defReadResourceByKey
---  delResource = defDelResource
+instance  Queriable reg a => IResource (Index reg a) where
+  keyResource = key
+  writeResource =defWriteResource
+  readResourceByKey = defReadResourceByKey
+  delResource = defDelResource
 
 
 
@@ -128,20 +126,14 @@ instance (IResource reg, Typeable reg, Ord a, Read a)
      = map (\(r,s) -> (Index r, s)) rs where rs= readsPrec n str
   readsPrec _ s= error $ "indexQuery: can not read index: \""++s++"\""
 
-
 instance (Queriable reg a) => Serializable (Index reg a)  where
   serialize= pack . show
   deserialize= read . unpack
-  setPersist= const $ unsafePerformIO $ readIORef _indexPersist
-
-_indexPersist= unsafePerformIO $ newIORef Nothing
+  setPersist index= persistIndex $ getType index
+    where
+    getType :: Index reg a -> reg
+    getType= undefined -- type level
 
--- | Set the default persistence for the indexes
---
--- Must be called before any other TCache sentence
-setIndexPersist p= writeIORef _indexPersist $ Just p
-
-getIndexPersist=  unsafePerformIO $  readIORef _indexPersist
 
 
 keyIndex treg tv= "index " ++ show treg ++ show tv
@@ -150,12 +142,15 @@ instance (Typeable reg, Typeable a) => Indexable (Index reg a) where
    key map= keyIndex typeofreg typeofa
        where
        [typeofreg, typeofa]= typeRepArgs $! typeOf map
-
-instance (Queriable reg a, Typeable reg, Typeable a) => IResource (Index reg a) where
-  keyResource = key
-  writeResource =defWriteResource
-  readResourceByKey = defReadResourceByKey
-  delResource = defDelResource
+--   defPath index= defPath $ ofRegister index
+--       where
+--       ofRegister :: Index reg a -> reg
+--       ofRegister = undefined -- type level
+-- instance (Queriable reg a, Typeable reg, Typeable a) => IResource (Index reg a) where
+--  keyResource = key
+--  writeResource =defWriteResource
+--  readResourceByKey = defReadResourceByKey
+--  delResource = defDelResource
 
 getIndex :: (Queriable reg a)
    => ( reg -> a) -> a -> STM(DBRef (Index reg a), Index reg a,[DBRef reg])

Data/TCache/IndexText.hs

@@ -87,7 +87,6 @@ data IndexText=  IndexText
         , mapDocKeyInt :: M.Map String Int
         , mapIntDocKey :: M.Map Int String
         , mapTextInteger :: M.Map T.Text Integer
-
          } deriving (Typeable)
 
 
@@ -100,7 +99,7 @@ instance Read IndexText  where
 instance Serializable IndexText  where
   serialize= pack . show
   deserialize= read . unpack
-  setPersist= const $ getIndexPersist
+  setPersist=  const Nothing
 
 instance  Indexable IndexText  where
    key (IndexText v _ _ _ _)=    "indextext " ++ v

TCache.cabal

@@ -1,5 +1,5 @@
 name: TCache
-version: 0.10.2.4
+version: 0.11.0.0
 cabal-version: >= 1.6
 build-type: Simple
 license: BSD3
@@ -13,7 +13,10 @@ description: TCache is a transactional cache with configurable persitence. It al
              The package implements serializable STM references, access by key and by record field value, triggers,
              full text and field indexation, default serialization and a query language based on record fields
              .
-             0.10.2.0 added setDefaultPersist and modified the signature of setPersist in Data.TCache.DefaultPersistence.
+             0.11.0.0 added setIndexParsist to define persistence for indexes by type. started the addition of readDBRefs, readResources and so on for simultaneous read, writes and deletes of
+             objects of the same type.
+             .
+             0.10.2.0 Added setDefaultPersist and modified the signature of setPersist in Data.TCache.DefaultPersistence.
              Fixed issues with ghc 7.6.3
              .
              0.10  version add memoization and a persistent and transactional collection/queue.
@@ -33,9 +36,15 @@ 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
+extra-source-files: demos/DBRef.hs
+                    demos/IndexQuery.hs
+                    demos/IndexText.hs
+                    demos/basicSample.hs
+                    demos/caching.hs
                     demos/triggerRelational.lhs
+                    demos/memoization
+                    demos/triggerRelational.hs
+                    demos/DBRefs
 
 source-repository head
     type: git

demos/.tcachedata/1

@@ -0,0 +1 @@
+1

demos/.tcachedata/Emp1

@@ -0,0 +1 @@
+Emp {ename = "Emp1", salary = 41140.0}

demos/.tcachedata/Emp2

@@ -0,0 +1 @@
+Emp {ename = "Emp2", salary = 42350.0}

demos/.tcachedata/Emp3

@@ -0,0 +1 @@
+Emp {ename = "Emp3", salary = 10000.0}

demos/.tcachedata/Emp4

@@ -0,0 +1 @@
+Emp {ename = "Emp4", salary = 77440.0}

demos/.tcachedata/I54321

@@ -0,0 +1 @@
+Item {iname = "PC", iid = "I54321", price = 6000, stock = 0}

demos/.tcachedata/Queue#hi

@@ -0,0 +1,5 @@
+"hi"  [ v20 , v20 ] [] 
+where{
+ v20= "a"  ;
+
+}

demos/.tcachedata/U12345

@@ -0,0 +1 @@
+User {uname = "John", uid = "U12345", spent = 60000}

demos/.tcachedata/hola

@@ -0,0 +1 @@
+"hola"

demos/.tcachedata/mycompany

@@ -0,0 +1 @@
+Company {cname = "mycompany", personnel = [DBRef "Emp1",DBRef "Emp2",DBRef "Emp3",DBRef "Emp4"], other = Other "blah blah blah"}

demos/.tcachedata/ops

@@ -0,0 +1 @@
+Plus

demos/cacheData/1

@@ -0,0 +1 @@
+Data 1 1

demos/cacheData/10

@@ -0,0 +1 @@
+Data 10 1

demos/cacheData/100

@@ -0,0 +1 @@
+Data 100 1

demos/cacheData/101

@@ -0,0 +1 @@
+Data 101 1

demos/cacheData/102

@@ -0,0 +1 @@
+Data 102 1

demos/cacheData/103

@@ -0,0 +1 @@
+Data 103 1

demos/cacheData/104

@@ -0,0 +1 @@
+Data 104 1

demos/cacheData/105

@@ -0,0 +1 @@
+Data 105 1

demos/cacheData/106

@@ -0,0 +1 @@
+Data 106 1

demos/cacheData/107

@@ -0,0 +1 @@
+Data 107 1

demos/cacheData/108

@@ -0,0 +1 @@
+Data 108 1

demos/cacheData/109

@@ -0,0 +1 @@
+Data 109 1

demos/cacheData/11

@@ -0,0 +1 @@
+Data 11 1

demos/cacheData/110

@@ -0,0 +1 @@
+Data 110 1

demos/cacheData/111

@@ -0,0 +1 @@
+Data 111 1