inproved default persistence

Data/TCache.hs

@@ -626,7 +626,7 @@ flushAll = do
 -- 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.
 

Data/TCache/Defs.hs

@@ -126,13 +126,14 @@ 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
+-- 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 @@ readFileStrict f = openFile f ReadMode >>= \ h -> readIt h `finally` hClose h
   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
 

Data/TCache/IResource.hs

@@ -46,7 +46,8 @@ class IResource a where
         -}
         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 @@ defaultReadResourceByKey k= iox
      
      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

Data/TCache/IndexQuery.hs

@@ -84,7 +84,10 @@ module Data.TCache.IndexQuery(
 , recordsWith
 , (.&&.)
 , (.||.)
-, select)
+, select
+, Queriable
+, setIndexPersist
+, getIndexPersist)
 where
 
 import Data.TCache
@@ -99,7 +102,7 @@ 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
+class ( Read a,  Show a
       , IResource reg,Typeable reg
       , Typeable a,Ord a)
       => Queriable reg a
@@ -117,9 +120,9 @@ instance (Read reg, Read a, Show reg, Show a
 
 
 
-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 (IResource reg, Typeable reg,Read reg,Show reg, Show a, Read a, Ord a)
 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
 

Data/TCache/IndexText.hs

@@ -76,6 +76,8 @@ import Data.Char
 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 Read IndexText  where
 instance Serializable IndexText  where
   serialize= pack . show
   deserialize= read . unpack
+  setPersist= const $ getIndexPersist
 
 instance  Indexable IndexText  where
    key (IndexText v _ _ _ _)=    "indextext " ++ v

Data/TCache/Memoization.hs

@@ -49,7 +49,7 @@ class Executable m where
   execute:: m a -> a
 
 instance Executable IO where
-  execute m = unsafePerformIO $ f1 m ""
+  execute m = unsafePerformIO $! f1 m ""
    where
    f1 m x= m
 

TCache.cabal

@@ -1,5 +1,5 @@
 name: TCache
-version: 0.10.1.0
+version: 0.10.2.0
 cabal-version: >= 1.6
 build-type: Simple
 license: BSD3
@@ -24,7 +24,7 @@ description: TCache is a transactional cache with configurable persitence. It al
              In this release:
              .
              added setDefaultPersist and modified the signature of setPersist in Data.TCache.DefaultPersistence.
-
+             Fixed issues with ghc 7.6.3
 
 
 
@@ -47,11 +47,15 @@ library
                    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

dist/build/autogen/Paths_TCache.hs

@@ -0,0 +1,32 @@
+module Paths_TCache (
+    version,
+    getBinDir, getLibDir, getDataDir, getLibexecDir,
+    getDataFileName
+  ) where
+
+import qualified Control.Exception as Exception
+import Data.Version (Version(..))
+import System.Environment (getEnv)
+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
+catchIO = Exception.catch
+
+
+version :: Version
+version = Version {versionBranch = [0,10,2,0], versionTags = []}
+bindir, libdir, datadir, libexecdir :: FilePath
+
+bindir     = "C:\\Users\\magocoal\\AppData\\Roaming\\cabal\\bin"
+libdir     = "C:\\Users\\magocoal\\AppData\\Roaming\\cabal\\TCache-0.10.2.0\\ghc-7.4.2"
+datadir    = "C:\\Users\\magocoal\\AppData\\Roaming\\cabal\\TCache-0.10.2.0"
+libexecdir = "C:\\Users\\magocoal\\AppData\\Roaming\\cabal\\TCache-0.10.2.0"
+
+getBinDir, getLibDir, getDataDir, getLibexecDir :: IO FilePath
+getBinDir = catchIO (getEnv "TCache_bindir") (\_ -> return bindir)
+getLibDir = catchIO (getEnv "TCache_libdir") (\_ -> return libdir)
+getDataDir = catchIO (getEnv "TCache_datadir") (\_ -> return datadir)
+getLibexecDir = catchIO (getEnv "TCache_libexecdir") (\_ -> return libexecdir)
+
+getDataFileName :: FilePath -> IO FilePath
+getDataFileName name = do
+  dir <- getDataDir
+  return (dir ++ "\\" ++ name)

dist/build/autogen/cabal_macros.h

@@ -0,0 +1,65 @@
+/* DO NOT EDIT: This file is automatically generated by Cabal */
+
+/* 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) <  3 || \
+  (major1) == 0 && (major2) == 3 && (minor) <= 1)
+
+/* 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) <= 1)
+
+/* package bytestring-0.9.2.1 */
+#define VERSION_bytestring "0.9.2.1"
+#define MIN_VERSION_bytestring(major1,major2,minor) (\
+  (major1) <  0 || \
+  (major1) == 0 && (major2) <  9 || \
+  (major1) == 0 && (major2) == 9 && (minor) <= 2)
+
+/* 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) <  5 || \
+  (major1) == 0 && (major2) == 5 && (minor) <= 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) <  2 || \
+  (major1) == 1 && (major2) == 2 && (minor) <= 0)
+
+/* 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) <= 2)
+
+/* package old-time-1.1.0.0 */
+#define VERSION_old_time "1.1.0.0"
+#define MIN_VERSION_old_time(major1,major2,minor) (\
+  (major1) <  1 || \
+  (major1) == 1 && (major2) <  1 || \
+  (major1) == 1 && (major2) == 1 && (minor) <= 0)
+
+/* package stm-2.4 */
+#define VERSION_stm "2.4"
+#define MIN_VERSION_stm(major1,major2,minor) (\
+  (major1) <  2 || \
+  (major1) == 2 && (major2) <  4 || \
+  (major1) == 2 && (major2) == 4 && (minor) <= 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 || \
+  (major1) == 0 && (major2) == 11 && (minor) <= 2)
+

dist/package.conf.inplace

@@ -0,0 +1,2 @@
+[InstalledPackageInfo {installedPackageId = InstalledPackageId "TCache-0.10.2.0-inplace", sourcePackageId = PackageIdentifier {pkgName = PackageName "TCache", pkgVersion = Version {versionBranch = [0,10,2,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.\nFixed issues with ghc 7.6.3", 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.2.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"]}
+]