packages feed

TCache 0.10.2.4 → 0.11.0.0

raw patch · 10 files changed

+151/−115 lines, 10 files

Files

Data/TCache.hs view
@@ -133,6 +133,7 @@ ,newDBRef --,newDBRefIO ,readDBRef+,readDBRefs ,writeDBRef ,delDBRef @@ -379,14 +380,45 @@        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 @@             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 @@             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 view
@@ -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 @@   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 view
@@ -101,10 +101,16 @@ 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
Data/TCache/IResource.hs view
@@ -40,11 +40,15 @@         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 @@         -- Since there is no provision for rollback from failure in writing to         -- persistent storage, 'writeResource' must retry until success.     	writeResource:: a-> IO()+    	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 tocommit   
-    	delResource:: a-> IO()
-
-
+        -- | 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 view
@@ -53,8 +53,7 @@ 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 @@  {-# LANGUAGE  DeriveDataTypeable, MultiParamTypeClasses , FunctionalDependencies, FlexibleInstances, UndecidableInstances-, TypeSynonymInstances, IncoherentInstances #-}+, TypeSynonymInstances, IncoherentInstances, OverlappingInstances #-} module Data.TCache.IndexQuery(   index , (.==.)@@ -85,9 +84,7 @@ , (.&&.) , (.||.) , select-, Queriable-, setIndexPersist-, getIndexPersist)+, Queriable) where  import Data.TCache@@ -102,21 +99,22 @@ 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,34 +126,31 @@      = 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+  setPersist index= persistIndex $ getType index+    where+    getType :: Index reg a -> reg+    getType= undefined -- type level -_indexPersist= unsafePerformIO $ newIORef Nothing --- | 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  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 view
@@ -87,7 +87,6 @@         , mapDocKeyInt :: M.Map String Int         , mapIntDocKey :: M.Map Int String         , mapTextInteger :: M.Map T.Text Integer-          } deriving (Typeable)  @@ -100,7 +99,7 @@ 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 view
@@ -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 @@              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,14 @@ 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.hs+                    demos/DBRef.hs  source-repository head     type: git
− demos/DynamicSample.hs 
@@ -1,66 +0,0 @@-{-# OPTIONS -XTypeSynonymInstances  -XFlexibleInstances  -XUndecidableInstances #-}
--- XTypeSynonymInstances added only to permit IResource instances for Strings
-module Main where-import Data.TCache-import Data.TCache.DefaultPersistence-import Data.ByteString.Lazy.Char8(pack,unpack)
-import Data.Typeable
-
-{------------- tests---------
-example of IDynamic usage.
-
--}
-
---very simple data:
---two objects with two different datatypes: Int and String
-
-instance Indexable Int where     
-   key =  show 
-
-
-instance Indexable String where
-   key x=  take 2 x
- 
-instance (Read a, Show a) => Serializable a where-   serialize= pack . show-   deserialize= read . unpack
-
-
-main= do
-  putStrLn "see the code to know the meaning of he results"--  -- NOTE: registerType no longer needed-  
-  
-  let x= 1:: Int--  -- now *Resources primitives suppont different datatypes-  -- without the need  of Data.Dynamic
-  withResources  [] $ const  [x]-  withResources  [] $ const  ["hola"]  --resources creation 
-  
-  syncCache                           
-  
-  res <- getResource  x        
-  print res 
-  
-  res <- getResource  "ho"                   
-  print res   
--  -- to use heterogeneous data in the same transaction,-  -- use DBRef's:-  s <- atomically $ do-        let refInt    = getDBRef $ key x    :: DBRef Int-            refString = getDBRef $ key "ho" :: DBRef String-        i <- readDBRef refInt-        writeDBRef refString $ "hola, the retrieved value of x is " ++ show i-        s <- readDBRef refString-        return s--  print s--  -- however, retrieval of data with the incorrect type will generate an exception:-
-  syncCache
-  
-
+ demos/IndexText.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE DeriveDataTypeable#-}+module Main where+import Data.TCache+import Data.TCache.DefaultPersistence+import Data.TCache.IndexQuery(select)+import Data.TCache.IndexText+import Data.ByteString.Lazy.Char8(pack,unpack)+import qualified Data.Text.Lazy as T(pack)
+import Data.Typeable++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"
+ demos/memoization.hs view
@@ -0,0 +1,15 @@+import Data.TCache.Memoization+import Data.TCache.DefaultPersistence+import Control.Concurrent+import System.Time++++main= do+        cachedByKey "" 4 f >>= print+        threadDelay 1000000+        main++f= do+  TOD t _ <- getClockTime+  return t