inproved defaultPersistence

Data/Persistent/IDynamic.hs

@@ -36,8 +36,8 @@ import Data.Map as M(empty)
 import Data.RefSerialize
 import Data.HashTable as HT
 
-import Debug.Trace
-(!>)= flip trace
+--import Debug.Trace
+--(!>)= flip trace
 
 
 data IDynamic  =  IDyn  (IORef IDynType) deriving Typeable
@@ -120,8 +120,8 @@ toIDyn x= IDyn . unsafePerformIO . newIORef $ DRight x
 serializedEqual (IDyn r) str= unsafePerformIO $ do
   t <- readIORef r
   case t of
-   DRight x -> return $ runW (showp x) == str   !> ("R "++ (show $ unpack $ runW (showp x)))
-   DLeft (str', _) -> return $ str== str'       !> ("L "++ (show $ unpack str' ))
+   DRight x -> return $ runW (showp x) == str   -- !> ("R "++ (show $ unpack $ runW (showp x)))
+   DLeft (str', _) -> return $ str== str'       -- !> ("L "++ (show $ unpack str' ))
 
 fromIDyn :: (Typeable a , Serialize a)=> IDynamic -> a
 fromIDyn x= case safeFromIDyn x of

Data/TCache/DefaultPersistence.hs

@@ -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 @@ import Data.TCache
 
 
 
-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

Data/TCache/Defs.hs

@@ -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,31 +101,39 @@ The performance of serialization is not critical.
 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
 --  deserialize= read
 
 
 -- | 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)
@@ -186,18 +194,18 @@ defaultDelete filename =do
 
 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
 
 

Data/TCache/IndexQuery.hs

@@ -74,17 +74,21 @@ fields in a registers are to be indexed, they must have different types.
 , FunctionalDependencies, FlexibleInstances, UndecidableInstances
 , TypeSynonymInstances, IncoherentInstances #-}
 module Data.TCache.IndexQuery(
-index
-, RelationOps((.==.),(.<.),(.<=.),(.>=.),(.>.))
+  index
+, (.==.)
+, (.<.)
+, (.<=.)
+, (.>=.)
+, (.>.)
 , indexOf
 , recordsWith
 , (.&&.)
 , (.||.)
-, Select(..))
+, select)
 where
 
 import Data.TCache
-import Data.TCache.Defs
+import Data.TCache.DefaultPersistence
 import Data.List
 import Data.Typeable
 import Control.Concurrent.STM
@@ -105,11 +109,13 @@ instance (Read reg, Read a, Show reg, Show a
       , 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)
 
@@ -132,7 +138,7 @@ instance (Typeable reg, Typeable a) => Indexable (Index reg a) where
        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])
@@ -213,15 +219,15 @@ class RelationOps field1 field2 res | field1 field2 -> res  where
     (.<.) :: field1 -> field2 ->  STM  res
 
 -- Instance of relations betweeen fields and values
--- field .op. valued
+-- field .op. value
 instance (Queriable reg a) => RelationOps (reg -> a) a  [DBRef reg] where
     (.==.) field value= do
        (_ ,_ ,dbrefs) <- getIndex field value
        return dbrefs
 
     (.>.)  field value= retrieve field value (>)
     (.<.)  field value= retrieve field value (<)
-    (.<=.)  field value= retrieve field value (<=)
+    (.<=.) field value= retrieve field value (<=)
 
     (.>=.) field value= retrieve field value (>=)
 

Data/TCache/IndexText.hs

@@ -54,10 +54,15 @@ main= do
 
 -}
 
-module Data.TCache.IndexText(indexText, indexList,  contains, containsElem, allElemsOf) where
+module Data.TCache.IndexText(
+  indexText
+, indexList
+, contains
+, containsElem
+, 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
@@ -97,11 +102,11 @@ instance Serializable IndexText  where
 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

TCache.cabal

@@ -1,5 +1,5 @@
 name: TCache
-version: 0.10.0.8
+version: 0.10.1.0
 cabal-version: >= 1.6
 build-type: Simple
 license: BSD3
@@ -17,9 +17,15 @@ description: TCache is a transactional cache with configurable persitence. It al
              .
              0.10.0.8 subversion add cachedByKeySTM
              .
+             0.10.0.9 fixed an error in clearSyncChacheProc and SynWrite Asyncronous that checked the cache continuously
+             .
              See "Data.TCache" for details
+             .
+             In this release:
+             .
+             added setDefaultPersist and modified the signature of setPersist in Data.TCache.DefaultPersistence.
+
 
-             This release fixes some bugs in the module IndexText
 
 
 category: Data, Database

dist/build/autogen/Paths_TCache.hs

@@ -12,13 +12,13 @@ catchIO = Exception.catch
 
 
 version :: Version
-version = Version {versionBranch = [0,10,0,1], versionTags = []}
+version = Version {versionBranch = [0,10,1,0], versionTags = []}
 bindir, libdir, datadir, libexecdir :: FilePath
 
-bindir     = "C:\\Users\\agocorona\\AppData\\Roaming\\cabal\\bin"
-libdir     = "C:\\Users\\agocorona\\AppData\\Roaming\\cabal\\TCache-0.10.0.1\\ghc-7.4.1"
-datadir    = "C:\\Users\\agocorona\\AppData\\Roaming\\cabal\\TCache-0.10.0.1"
-libexecdir = "C:\\Users\\agocorona\\AppData\\Roaming\\cabal\\TCache-0.10.0.1"
+bindir     = "C:\\Users\\magocoal\\AppData\\Roaming\\cabal\\bin"
+libdir     = "C:\\Users\\magocoal\\AppData\\Roaming\\cabal\\TCache-0.10.1.0\\ghc-7.4.2"
+datadir    = "C:\\Users\\magocoal\\AppData\\Roaming\\cabal\\TCache-0.10.1.0"
+libexecdir = "C:\\Users\\magocoal\\AppData\\Roaming\\cabal\\TCache-0.10.1.0"
 
 getBinDir, getLibDir, getDataDir, getLibexecDir :: IO FilePath
 getBinDir = catchIO (getEnv "TCache_bindir") (\_ -> return bindir)

dist/build/autogen/cabal_macros.h

@@ -1,18 +1,18 @@
 /* DO NOT EDIT: This file is automatically generated by Cabal */
 
-/* package RefSerialize-0.2.8.1 */
-#define VERSION_RefSerialize "0.2.8.1"
+/* package RefSerialize-0.3.1.0 */
+#define VERSION_RefSerialize "0.3.1.0"
 #define MIN_VERSION_RefSerialize(major1,major2,minor) (\
   (major1) <  0 || \
-  (major1) == 0 && (major2) <  2 || \
-  (major1) == 0 && (major2) == 2 && (minor) <= 8)
+  (major1) == 0 && (major2) <  3 || \
+  (major1) == 0 && (major2) == 3 && (minor) <= 1)
 
-/* package base-4.5.0.0 */
-#define VERSION_base "4.5.0.0"
+/* package base-4.5.1.0 */
+#define VERSION_base "4.5.1.0"
 #define MIN_VERSION_base(major1,major2,minor) (\
   (major1) <  4 || \
   (major1) == 4 && (major2) <  5 || \
-  (major1) == 4 && (major2) == 5 && (minor) <= 0)
+  (major1) == 4 && (major2) == 5 && (minor) <= 1)
 
 /* package bytestring-0.9.2.1 */
 #define VERSION_bytestring "0.9.2.1"
@@ -21,26 +21,26 @@
   (major1) == 0 && (major2) <  9 || \
   (major1) == 0 && (major2) == 9 && (minor) <= 2)
 
-/* package containers-0.4.2.1 */
-#define VERSION_containers "0.4.2.1"
+/* package containers-0.5.2.1 */
+#define VERSION_containers "0.5.2.1"
 #define MIN_VERSION_containers(major1,major2,minor) (\
   (major1) <  0 || \
-  (major1) == 0 && (major2) <  4 || \
-  (major1) == 0 && (major2) == 4 && (minor) <= 2)
+  (major1) == 0 && (major2) <  5 || \
+  (major1) == 0 && (major2) == 5 && (minor) <= 2)
 
-/* package directory-1.1.0.2 */
-#define VERSION_directory "1.1.0.2"
+/* package directory-1.2.0.1 */
+#define VERSION_directory "1.2.0.1"
 #define MIN_VERSION_directory(major1,major2,minor) (\
   (major1) <  1 || \
-  (major1) == 1 && (major2) <  1 || \
-  (major1) == 1 && (major2) == 1 && (minor) <= 0)
+  (major1) == 1 && (major2) <  2 || \
+  (major1) == 1 && (major2) == 2 && (minor) <= 0)
 
-/* package mtl-2.1.1 */
-#define VERSION_mtl "2.1.1"
+/* package mtl-2.1.2 */
+#define VERSION_mtl "2.1.2"
 #define MIN_VERSION_mtl(major1,major2,minor) (\
   (major1) <  2 || \
   (major1) == 2 && (major2) <  1 || \
-  (major1) == 2 && (major2) == 1 && (minor) <= 1)
+  (major1) == 2 && (major2) == 1 && (minor) <= 2)
 
 /* package old-time-1.1.0.0 */
 #define VERSION_old_time "1.1.0.0"
@@ -49,15 +49,15 @@
   (major1) == 1 && (major2) <  1 || \
   (major1) == 1 && (major2) == 1 && (minor) <= 0)
 
-/* package stm-2.3 */
-#define VERSION_stm "2.3"
+/* package stm-2.4 */
+#define VERSION_stm "2.4"
 #define MIN_VERSION_stm(major1,major2,minor) (\
   (major1) <  2 || \
-  (major1) == 2 && (major2) <  3 || \
-  (major1) == 2 && (major2) == 3 && (minor) <= 0)
+  (major1) == 2 && (major2) <  4 || \
+  (major1) == 2 && (major2) == 4 && (minor) <= 0)
 
-/* package text-0.11.2.0 */
-#define VERSION_text "0.11.2.0"
+/* package text-0.11.2.3 */
+#define VERSION_text "0.11.2.3"
 #define MIN_VERSION_text(major1,major2,minor) (\
   (major1) <  0 || \
   (major1) == 0 && (major2) <  11 || \

dist/package.conf.inplace

@@ -1,2 +1,2 @@
-[InstalledPackageInfo {installedPackageId = InstalledPackageId "TCache-0.10.0.1-inplace", sourcePackageId = PackageIdentifier {pkgName = PackageName "TCache", pkgVersion = Version {versionBranch = [0,10,0,1], versionTags = []}}, license = BSD3, copyright = "", maintainer = "[email protected]", author = "Alberto G\243mez Corona", stability = "", homepage = "", pkgUrl = "", synopsis = "A Transactional cache with user-defined persistence", description = "TCache is a transactional cache with configurable persitence. It allows conventional\nSTM transactions for objects that syncronize  with\ntheir user defined storages.\nState in memory and into permanent storage is transactionally coherent.\n\nThe package implements serializable STM references, access by key and by record field value, triggers,\nfull text and field indexation, default serialization and a query language based on record fields\n\nThis version add memoization and a persistent and transactional collection/queue\n\nSee \"Data.TCache\" for details", category = "Data, Database", exposed = True, exposedModules = ["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"], hiddenModules = [], trusted = False, importDirs = ["C:\\Users\\agocorona\\Documents\\Dropbox\\Haskell\\devel\\TCache\\dist\\build"], libraryDirs = ["C:\\Users\\agocorona\\Documents\\Dropbox\\Haskell\\devel\\TCache\\dist\\build"], hsLibraries = ["HSTCache-0.10.0.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "RefSerialize-0.2.8.1-80a3dbab8a08c01d64c102718a393704",InstalledPackageId "base-4.5.0.0-597748f6f53a7442bcae283373264bb6",InstalledPackageId "bytestring-0.9.2.1-df82064cddbf74693df4e042927e015e",InstalledPackageId "containers-0.4.2.1-7c54595400348f577b3b4a45691c5afd",InstalledPackageId "directory-1.1.0.2-0270278088d4b2588b52cbec49af4cb7",InstalledPackageId "mtl-2.1.1-87121149c5eb4fc03f06f5894ea4ac0c",InstalledPackageId "old-time-1.1.0.0-7b2e123ada736534f8119498399ea8c8",InstalledPackageId "stm-2.3-2735f77d3e207163ae60f86094d82cd7",InstalledPackageId "text-0.11.2.0-b2986f5478f0efa626f8ba0494ed9670"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["C:\\Users\\agocorona\\Documents\\Dropbox\\Haskell\\devel\\TCache\\dist\\doc\\html\\TCache\\TCache.haddock"], haddockHTMLs = ["C:\\Users\\agocorona\\Documents\\Dropbox\\Haskell\\devel\\TCache\\dist\\doc\\html\\TCache"]}
+[InstalledPackageInfo {installedPackageId = InstalledPackageId "TCache-0.10.1.0-inplace", sourcePackageId = PackageIdentifier {pkgName = PackageName "TCache", pkgVersion = Version {versionBranch = [0,10,1,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "[email protected]", author = "Alberto G\243mez Corona", stability = "", homepage = "", pkgUrl = "", synopsis = "A Transactional cache with user-defined persistence", description = "TCache is a transactional cache with configurable persitence. It allows conventional\nSTM transactions for objects that syncronize  with their user-defined storages.\nState in memory and into permanent storage is transactionally coherent.\n\nThe package implements serializable STM references, access by key and by record field value, triggers,\nfull text and field indexation, default serialization and a query language based on record fields\n\n0.10  version add memoization and a persistent and transactional collection/queue.\n\n0.10.0.8 subversion add cachedByKeySTM\n\n0.10.0.9 fixed an error in clearSyncChacheProc and SynWrite Asyncronous that checked the cache continuously\n\nSee \"Data.TCache\" for details\n\nIn this release:\n\nadded setDefaultPersist and modified the signature of setPersist in Data.TCache.DefaultPersistence.", category = "Data, Database", exposed = True, exposedModules = ["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"], hiddenModules = [], trusted = False, importDirs = ["C:\\Users\\magocoal\\SkyDrive\\Haskell\\devel\\TCache\\dist\\build"], libraryDirs = ["C:\\Users\\magocoal\\SkyDrive\\Haskell\\devel\\TCache\\dist\\build"], hsLibraries = ["HSTCache-0.10.1.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "RefSerialize-0.3.1.0-680059356e6e34f4eb5ea81d8ba6ec53",InstalledPackageId "base-4.5.1.0-7c83b96f47f23db63c42a56351dcb917",InstalledPackageId "bytestring-0.9.2.1-0c74e8abeebb3c3d794fd93f5313ffd8",InstalledPackageId "containers-0.5.2.1-389d1c7cba43d9e33b52fdf739a5f6de",InstalledPackageId "directory-1.2.0.1-c2b315a200318ea41485209de361118e",InstalledPackageId "mtl-2.1.2-5337caef659244e51e2f5fb2e944d97f",InstalledPackageId "old-time-1.1.0.0-faa8f195d3a1c39bf0ccb8384aa86e9f",InstalledPackageId "stm-2.4-7929e2354ddb937b8bf4d18cb0816e56",InstalledPackageId "text-0.11.2.3-869d65d8671d33fd6c06b8d48acbf106"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["C:\\Users\\magocoal\\SkyDrive\\Haskell\\devel\\TCache\\dist\\doc\\html\\TCache\\TCache.haddock"], haddockHTMLs = ["C:\\Users\\magocoal\\SkyDrive\\Haskell\\devel\\TCache\\dist\\doc\\html\\TCache"]}
 ]