TCache 0.10.0.12 → 0.10.1.0

raw patch · 5 files changed

+47/−32 lines, 5 files

Files

• Data/TCache/DefaultPersistence.hs +8/−3
• Data/TCache/Defs.hs +22/−14
• Data/TCache/IndexQuery.hs +9/−7
• Data/TCache/IndexText.hs +6/−6
• TCache.cabal +2/−2

@@ -10,7 +10,13 @@  .The last one defines persistence in files as default, but it can be changed  to persistence in databases, for examople. -}-module Data.TCache.DefaultPersistence(Indexable(..),Serializable(..),defaultPersist,Persist(..)) where+module Data.TCache.DefaultPersistence(+Indexable(..)+,Serializable(..)+,setDefaultPersist+,getDefaultPersist+,filePersist+,Persist(..)) where  import System.IO.Unsafe import Data.Typeable@@ -21,8 +27,7 @@   -instance  (Typeable a,  Indexable a, Serializable a ) => IResource a where-+instance  (Typeable a,  Indexable a, Serializable a) => IResource a where   keyResource = key   writeResource =defWriteResource   readResourceByKey = defReadResourceByKey

@@ -1,7 +1,7 @@ {-# LANGUAGE   TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables, DeriveDataTypeable #-} -{- | some internal definitions. To use default persistence, use-'Data.TCache.DefaultPersistence' instead -}+{- | some internal definitions. To use default persistence, import+@Data.TCache.DefaultPersistence@ instead -}  module Data.TCache.Defs  where import Data.Typeable@@ -101,8 +101,8 @@ class Serializable a  where   serialize   :: a -> B.ByteString   deserialize :: B.ByteString -> a-  setPersist :: a -> Persist         -- ^ `defaultPersist`if not overriden-  setPersist _= defaultPersist+  setPersist  :: a -> Maybe Persist              -- ^ `defaultPersist` if Nothing+  setPersist =  const Nothing  --instance (Show a, Read a)=> Serializable a where --  serialize= show@@ -110,24 +110,32 @@   -- | a persist mechanism has to implement these three primitives--- 'defaultpersist' is the default file persistence+-- 'filePersist' is the default file persistence data Persist = Persist{        readByKey   ::  (String -> IO(Maybe B.ByteString)) -- ^  read by key. It must be strict      , write       ::  (String -> B.ByteString -> IO())   -- ^  write. It must be strict-     , delete      ::  (String -> IO())}       -- ^  delete+     , delete      ::  (String -> IO())}                  -- ^  delete  -- | Implements default persistence of objects in files with their keys as filenames-defaultPersist= Persist+filePersist   = Persist     {readByKey= defaultReadByKey-    ,write= defaultWrite-    ,delete= defaultDelete}+    ,write    = defaultWrite+    ,delete   = defaultDelete} -getPersist x= return (setPersist x)-  `Exception.catch` (\(e:: SomeException) -> error "setPersist must not depend on the type, not the value of the parameter: " )+defaultPersistIORef = unsafePerformIO $ newIORef  filePersist +-- | 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+setDefaultPersist p= writeIORef defaultPersistIORef p +getDefaultPersist =  unsafePerformIO $ readIORef defaultPersistIORef +getPersist x= unsafePerformIO $ case setPersist x of+     Nothing -> readIORef defaultPersistIORef+  `Exception.catch` (\(e:: SomeException) -> error "setPersist must depend on the type, not the value of the parameter: " ) + defaultReadByKey ::   String-> IO (Maybe B.ByteString)
 defaultReadByKey k= iox   -- !> "defaultReadByKey"      where@@ -186,18 +194,18 @@  defReadResourceByKey k= iox where     iox= do-      let Persist f _ _ = setPersist  x+      let Persist f _ _ = getPersist  x       f  file >>=  evaluate . fmap  deserialize       where       file= defPath x ++ k       x= undefined `asTypeOf` (fromJust $ unsafePerformIO iox)  defWriteResource s= do-      let Persist _ f _ = setPersist  s+      let Persist _ f _ = getPersist  s       f (defPath s ++ key s) $ serialize s  defDelResource s= do-      let Persist _ _ f = setPersist s+      let Persist _ _ f = getPersist s       f $ defPath s ++ key s 
 

@@ -88,7 +88,7 @@ where  import Data.TCache-import Data.TCache.Defs+import Data.TCache.DefaultPersistence import Data.List import Data.Typeable import Control.Concurrent.STM@@ -109,12 +109,14 @@       , Typeable a,Ord a)       => 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 ++ 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)@@ -136,7 +138,7 @@        where        [typeofreg, typeofa]= typeRepArgs $! typeOf map -+   defPath= const ""  getIndex :: (Queriable reg a)    => ( reg -> a) -> a -> STM(DBRef (Index reg a), Index reg a,[DBRef reg])

@@ -62,7 +62,7 @@ , allElemsOf) where import Data.TCache import Data.TCache.IndexQuery-import Data.TCache.Defs+import Data.TCache.DefaultPersistence import qualified Data.Text.Lazy as T import Data.Typeable import qualified Data.Map as M@@ -102,11 +102,11 @@ instance  Indexable IndexText  where    key (IndexText v _ _ _ _)=    "indextext " ++ v -instance IResource IndexText where-  keyResource = key-  writeResource =defWriteResource-  readResourceByKey = defReadResourceByKey-  delResource = defDelResource+--instance IResource IndexText where+--  keyResource = key+--  writeResource =defWriteResource+--  readResourceByKey = defReadResourceByKey+--  delResource = defDelResource  readInitDBRef v x= do   mv <- readDBRef x

@@ -1,5 +1,5 @@ name: TCache-version: 0.10.0.12+version: 0.10.1.0 cabal-version: >= 1.6 build-type: Simple license: BSD3@@ -23,7 +23,7 @@              .              In this release:              .-             fixed reset of indexes when index, indexText or indexList is used+             added setDefaultPersist and modified the signature of setPersist in Data.TCache.DefaultPersistence.