TCache-0.6.4: A Transactional data cache with configurable persistenceContentsIndex
Data.TCache.Dynamic
Description

Data.TCache.Dynamic: A dynamic interface for TCache so that mixed datatypes can be managed participating in a single transaction. The objects are encapsulated in a IDynamic datatype, that is d Dynamic type that is serializable and indexable

Dynamic present essentially the same methods than Data.TCache. The added functionality is the management of IDynamic types. Any datatype that is instance of IResource and Typeable can be handled mixed with any other datatype. TCache.Dynamic is essentially a TCache working with a single datatype: IDynamic that is indexable and serializable. You dont need to do anything special except to define Typeable besides the IResource instance for your particular datatype. Also, before use, your datatype must be registered (with registerType, see example in the package).

there are basically two types of methods in this module:

  • with(STM)Resource(s) calls: manage one single type of data, in the same way than the naked Data.TCache module, Are the same than Data.TCache. The marsalling to and from IDynamic is managed internally. These calls do exactly the same than the TCache calls with the same name these cals allows different modules to handle their particular kind of data without regard that it is being handled in the same cache with other datatypes.
  • wthD(STM)Resource(s): are new, and handle the IDynamic type. The user must wrap your datatypes (with toIDyn) and unwap it (with fromIDyn) These call permts to handle arbitrary types at the same time and partticipate in transactions.

There is also a useful Key object whose purpose is to retrieve any objecto fo any datatype by its sting key

Also the parameter refcache has been dropped from the methods that used it (the syncronization methods)

Synopsis
class IResource a where
keyResource :: a -> String
serialize :: a -> String
deserialize :: String -> a
tshowp :: a -> ST String
treadp :: ST a
defPath :: a -> String
readResource :: a -> IO (Maybe a)
writeResource :: a -> IO ()
delResource :: a -> IO ()
data Resources a b
= Retry
| Resources {
toAdd :: [a]
toDelete :: [a]
toReturn :: b
}
resources :: Resources a ()
setCache :: (Ht a, Integer) -> IO ()
refcache :: Cache a
defaultCheck :: Integer -> Integer -> Integer -> Bool
readFileStrict
data IDynamic = forall a . (Typeable a, IResource a) => IDynamic a
type Cache a = IORef (Ht a, Integer)
class DynamicInterface x where
toIDyn :: x -> IDynamic
registerType :: IO x
fromIDyn :: IDynamic -> x
unsafeFromIDyn :: IDynamic -> x
safeFromIDyn :: IDynamic -> Maybe x
data Key = Key TypeRep String
getTVars :: [IDynamic] -> STM [Maybe (TVar IDynamic)]
releaseTVars :: [IDynamic] -> STM ()
getTVarsIO :: [IDynamic] -> IO [TVar IDynamic]
withDResource :: IDynamic -> (Maybe IDynamic -> IDynamic) -> IO ()
withDResources :: [IDynamic] -> ([Maybe IDynamic] -> [IDynamic]) -> IO ()
withDSTMResources :: [IDynamic] -> ([Maybe IDynamic] -> Resources IDynamic x) -> STM x
getDResource :: IDynamic -> IO (Maybe IDynamic)
getDResources :: [IDynamic] -> IO [Maybe IDynamic]
deleteDResource :: IDynamic -> IO ()
deleteDResources :: [IDynamic] -> IO ()
syncCache :: IO ()
clearSyncCacheProc :: Int -> (Integer -> Integer -> Integer -> Bool) -> Int -> IO ThreadId
withResource :: (Typeable a, Typeable b, IResource a, IResource b) => a -> (Maybe a -> b) -> IO ()
withResources :: (Typeable a, Typeable b, IResource a, IResource b) => [a] -> ([Maybe a] -> [b]) -> IO ()
withSTMResources :: forall x a b. (Typeable a, Typeable b, IResource a, IResource b) => [a] -> ([Maybe a] -> Resources b x) -> STM x
getResource :: (Typeable a, Typeable b, IResource a, IResource b) => a -> IO (Maybe b)
getResources :: (Typeable a, Typeable b, IResource a, IResource b) => [a] -> IO [Maybe b]
deleteResource :: (Typeable a, IResource a) => a -> IO ()
deleteResources :: (Typeable a, IResource a) => [a] -> IO ()
Documentation
class IResource a where

Interface that must be defined for every object being cached. readResource and writeResource are implemented by default as read-write to files with its key as filename serialize and deserialize are specified just to allow these defaults. If you define your own persistence, then serialize and deserialize are not needed. The package Workflow need them anyway.

minimal definition: keyResource, serialize, deserialize

While serialize and deserialize are agnostic about the way of converison to strings, either binary or textual, treadp and tshowp use the monad defined in the RefSerialize package. Both ways of serialization are alternative. one is defined by default in terms of the other. the RefSerialize monad has been introduced to permit IResource objects to be serialized as part of larger structures that embody them. This is necessary for the Workdlow package.

The keyResource string must be a unique since this is used to index it in the hash table. when accessing a resource, the user must provide a partial object for wich the key can be obtained. for example:

data Person= Person{name, surname:: String, account :: Int ....)

keyResource Person n s ...= n++s

the data being accesed must have the fields used by keyResource filled. For example

  readResource Person {name=John, surname= Adams}

leaving the rest of the fields undefined

IResource has defaults definitions for all the methods except keyResource Either one or other serializer must be defiened for default witeResource, readResource and delResource

Methods
keyResource
:: a
-> Stringmust be defined
serialize
:: a
-> Stringmust be defined by the user
deserialize
:: String
-> amust be defined by the user
tshowp
:: a
-> ST Stringserializer in the RefSerialize monad. Either one or other serializer must be defined to use default persistence
treadp
:: ST adeserialize in the RefSerilzlize monad.
defPath
:: a
-> Stringadditional extension for default file paths or key prefixes
readResource :: a -> IO (Maybe a)
writeResource :: a -> IO ()
delResource :: a -> IO ()
show/hide Instances
data Resources a b
Resources returned by withSTMResources'
Constructors
Retryforces a retry
Resources
toAdd :: [a]resources to be inserted back in the cache
toDelete :: [a]resources to be deleted from the cache and from permanent storage
toReturn :: bresult to be returned
resources :: Resources a ()
resources= Resources  [] [] ()
setCache :: (Ht a, Integer) -> IO ()
set the cache. this is useful for hot loaded modules that will update an existing cache. Experimental
refcache :: Cache a
defaultCheck
:: Integercurrent time in seconds
-> Integerlast access time for a given object
-> Integerlast cache syncronization (with the persisten storage)
-> Boolreturn true for all the elems not accesed since half the time between now and the last sync
To drop from the cache all the elems not accesed since half the time between now and the last sync ths is a default cache clearance procedure -- it is invoke when the cache size exceeds the defined in clearSyncCacheProc
readFileStrict
data IDynamic
Constructors
forall a . (Typeable a, IResource a) => IDynamic a
show/hide Instances
type Cache a = IORef (Ht a, Integer)
class DynamicInterface x where
DynamicInterface groups a set of default method calls to handle dynamic objects. It is not necessary to derive instances from it
Methods
toIDyn
:: x
-> IDynamicencapsulates data in a dynamic object
registerType
:: IO xregisters the deserialize, readp and readResource methods for this data type
fromIDyn
:: IDynamic
-> xextract the data from the dynamic object. trows a user error when the cast fails
unsafeFromIDyn
:: IDynamic
-> xunsafe version.
safeFromIDyn
:: IDynamic
-> Maybe xsafe extraction with Maybe
data Key

Key datatype can be used to read any object trough the Dynamic interface.

 data Key =  Key TypeRep String deriving Typeable

Example

  mst <- getDResource $ Key type keyofDesiredObject
             case mst of
               Nothing -> error $ "not found "++ key
               Just (idyn) ->  fromIDyn idyn :: DesiredDatatype}
Constructors
Key TypeRep String
show/hide Instances
getTVars :: [IDynamic] -> STM [Maybe (TVar IDynamic)]
getTVars return the TVar that wraps the resources for which the keys are given . | it return Nothing if a TVar with this object has not been allocated These TVars can be used as usual in explicit user constructed atomic blocks Additionally, the retrieved TVars remain in the cache and can be accessed and updated by the rest of the TCache methods. to keep the consistence in the serialized data, the content of the TVars are written every time the cache is syncronized with the storage until releaseTVars is called See Data.TCache.getTVars
releaseTVars :: [IDynamic] -> STM ()
getTVarsIO :: [IDynamic] -> IO [TVar IDynamic]
withDResource :: IDynamic -> (Maybe IDynamic -> IDynamic) -> IO ()

handles Dynamic objects using Data.TCache.withResource

withDResource =  Data.TCache..withResource
withDResources :: [IDynamic] -> ([Maybe IDynamic] -> [IDynamic]) -> IO ()
withDSTMResources
::
=> [IDynamic]The list of resources to be retrieved
-> [Maybe IDynamic] -> Resources IDynamic xThe function that process the resources found and return a Resources structure
-> STM xThe return value in the STM monad.

this is the main function for the *Resource calls. All the rest derive from it. The results are kept in the STM monad so it can be part of a larger STM transaction involving other TVars The Resources register returned by the user-defined function is interpreted as such:

toAdd: additional resources not read in the first parameter of withSTMResources are created/updated with toAdd

toDelete: from the cache and from permanent storage

toReturn: will be returned by withSTMResources

getDResource :: IDynamic -> IO (Maybe IDynamic)
getDResource  = Data.TCache.getResource
getDResources :: [IDynamic] -> IO [Maybe IDynamic]
getDResources  = Data.TCache.getResources
deleteDResource :: IDynamic -> IO ()

retrieve a list of objects and return error if any resource is not found. instead of Nothing

delete a resource from the cache and the storage

deleteDResources :: [IDynamic] -> IO ()
delete a list of resources from the cache and the storage
syncCache :: IO ()
clearSyncCacheProc
:: Intnumber of seconds betwen checks. objects not written to disk are written
-> Integer -> Integer -> Integer -> BoolThe user-defined check-for-cleanup-from-cache for each object. defaultCheck is an example
-> IntThe max number of objects in the cache, if more, the cleanup starts
-> IO ThreadIdIdentifier of the thread created
Start the thread that clean and writes on the persistent storage. Otherwise, syncCache must be invoked explicitly or no persistence will exist
withResource :: (Typeable a, Typeable b, IResource a, IResource b) => a -> (Maybe a -> b) -> IO ()

methods that handle a single datatype.

similar to Data.TCache.withResource. The fact that this method may return a type different that the source type permits to use ' Key' objects

withResources :: (Typeable a, Typeable b, IResource a, IResource b) => [a] -> ([Maybe a] -> [b]) -> IO ()
similar to Data.TCache.withResources. The fact that this method may return a type different that the source type permits to use ' Key' objects
withSTMResources
:: forall x a b . (Typeable a, Typeable b, IResource a, IResource b)
=> [a]the list of resources to be retrieved
-> [Maybe a] -> Resources b xThe function that process the resources found and return a Resources structure
-> STM xThe return value in the STM monad.
similar to Data.TCache.withSTMResources. The return in the STM monad permits to participate in larger STM transactions The fact that this method may return a type different that the source type permits to use ' Key' objects
getResource :: (Typeable a, Typeable b, IResource a, IResource b) => a -> IO (Maybe b)
similar to Data.TCache.getResource. The fact that this method may return a type different that the source type permits to use ' Key' objects
getResources :: (Typeable a, Typeable b, IResource a, IResource b) => [a] -> IO [Maybe b]
similar to Data.TCache.getResources. The fact that this method may return a type different that the source type permits to use ' Key' objects
deleteResource :: (Typeable a, IResource a) => a -> IO ()
similar to Data.TCache.deleteResource
deleteResources :: (Typeable a, IResource a) => [a] -> IO ()
similar to Data.TCache.deleteResource
Produced by Haddock version 2.4.2