diff --git a/Data/TCache.hs b/Data/TCache.hs --- a/Data/TCache.hs +++ b/Data/TCache.hs @@ -626,7 +626,7 @@ -- 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. -withSTMResources :: (IResource a, Typeable a)=> [a] -- ^ the list of resources to be retrieved +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. diff --git a/Data/TCache/Defs.hs b/Data/TCache/Defs.hs --- a/Data/TCache/Defs.hs +++ b/Data/TCache/Defs.hs @@ -126,13 +126,14 @@ -- | Set the default persistence mechanism of all 'serializable' objetcts. By default it is 'filePersist' -- --- this statement must be the first one before any other in TCache +-- this statement must be the first one before any other TCache call setDefaultPersist p= writeIORef defaultPersistIORef p getDefaultPersist = unsafePerformIO $ readIORef defaultPersistIORef getPersist x= unsafePerformIO $ case setPersist x of Nothing -> readIORef defaultPersistIORef + Just p -> return p `Exception.catch` (\(e:: SomeException) -> error "setPersist must depend on the type, not the value of the parameter: " ) @@ -215,6 +216,6 @@ readIt h= do s <- hFileSize h let n= fromIntegral s - str <- B.hGet h n -- replicateM n (B.hGetChar h) + str <- B.hGet h n return str diff --git a/Data/TCache/IResource.hs b/Data/TCache/IResource.hs --- a/Data/TCache/IResource.hs +++ b/Data/TCache/IResource.hs @@ -46,7 +46,8 @@ -} readResourceByKey :: String -> IO(Maybe a) - -- To allow accesses not by key. (it defaults as @readResourceByKey $ keyResource x@) + -- 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@) readResource :: a -> IO (Maybe a) readResource x = readResourceByKey $ keyResource x @@ -138,7 +139,7 @@ filename= defPathIO iox ++ k - defPathIO ::(Serializable a, Indexable a)=> IO (Maybe a) -> String + defPathIO :: (Serializable a, Indexable a)=> IO (Maybe a) -> String defPathIO iox= defPath x where Just x= unsafePerformIO $ (return $ Just undefined) `asTypeOf` iox diff --git a/Data/TCache/IndexQuery.hs b/Data/TCache/IndexQuery.hs --- a/Data/TCache/IndexQuery.hs +++ b/Data/TCache/IndexQuery.hs @@ -84,7 +84,10 @@ , recordsWith , (.&&.) , (.||.) -, select) +, select +, Queriable +, setIndexPersist +, getIndexPersist) where import Data.TCache @@ -99,7 +102,7 @@ import System.IO.Unsafe import Data.ByteString.Lazy.Char8(pack, unpack) -class (Read reg, Read a, Show reg, Show a +class ( Read a, Show a , IResource reg,Typeable reg , Typeable a,Ord a) => Queriable reg a @@ -117,9 +120,9 @@ -data Index reg a= Index (M.Map a [DBRef reg]) deriving ( 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) +instance (IResource reg, Typeable reg, Ord a, Read 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 @@ -129,7 +132,16 @@ instance (Queriable reg a) => Serializable (Index reg a) where serialize= pack . show deserialize= read . unpack + setPersist= const $ unsafePerformIO $ readIORef _indexPersist +_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 diff --git a/Data/TCache/IndexText.hs b/Data/TCache/IndexText.hs --- a/Data/TCache/IndexText.hs +++ b/Data/TCache/IndexText.hs @@ -76,6 +76,8 @@ import Control.Concurrent(threadDelay) import Data.ByteString.Lazy.Char8(pack, unpack) import Control.Monad +import System.IO.Unsafe + --import Debug.Trace --(!>)= flip trace @@ -98,6 +100,7 @@ instance Serializable IndexText where serialize= pack . show deserialize= read . unpack + setPersist= const $ getIndexPersist instance Indexable IndexText where key (IndexText v _ _ _ _)= "indextext " ++ v diff --git a/Data/TCache/Memoization.hs b/Data/TCache/Memoization.hs --- a/Data/TCache/Memoization.hs +++ b/Data/TCache/Memoization.hs @@ -49,7 +49,7 @@ execute:: m a -> a instance Executable IO where - execute m = unsafePerformIO $ f1 m "" + execute m = unsafePerformIO $! f1 m "" where f1 m x= m diff --git a/TCache.cabal b/TCache.cabal --- a/TCache.cabal +++ b/TCache.cabal @@ -1,5 +1,5 @@ name: TCache -version: 0.10.2.0 +version: 0.10.2.1 cabal-version: >= 1.6 build-type: Simple license: BSD3 @@ -13,6 +13,9 @@ 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. + Fixed issues with ghc 7.6.3 + . 0.10 version add memoization and a persistent and transactional collection/queue. . 0.10.0.8 subversion add cachedByKeySTM @@ -23,8 +26,8 @@ . In this release: . - added setDefaultPersist and modified the signature of setPersist in Data.TCache.DefaultPersistence. - Fixed issues with ghc 7.6.3 + This release: + Inproved default persistence mechanism to permit different @@ -47,11 +50,15 @@ RefSerialize -any + 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 Data.Persistent.IDynamic + + + exposed: True buildable: True extensions: OverlappingInstances UndecidableInstances