Dynamic.hs

{-# OPTIONS -fglasgow-exts  #-}

{- | Data.TCache.TMVar.Dynamic:
A dynamic interface for TCache using TMVars

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 don´t need to do anything special except to define the IResource and typeable instances 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:

  **Resource(s) : manage one type of data, Are the same than Data.TCache. The marsalling to and from IDynamic is managed internally

  **DResource(s): handle the IDynamic type. you must wrap your datatype (with toIDyn) and unwap it (with fromIDyn)

The first set allows different modules to handle their particular kind of data without regard that it is being handled in the same cache with other datatypes.

The second set allows to handle, transact etc with many datatypes at the same time.

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)

-}

module Data.TCache.TMVar.Dynamic(
  T.IResource(..)   -- from TCache
  ,T.Resources(..)
  ,T.resources
  ,T.setCache
  ,T.refcache
  ,T.defaultCheck,T.readFileStrict
  ,I.IDynamic(..)        -- serializable/indexable existential datatype
  ,T.Cache


  ,DynamicInterface (
    toIDyn           -- :: x -> IDynamic
    ,registerType   -- :: x
    ,fromIDyn        -- :: IDynamic -> x
    ,unsafeFromIDyn  -- :: IDynamic -> x

   )
  --,ofType
  ,I.Key(..)            {- Key datatype can be used to read any object trough the Dynamic interface

                          let key= <key of the object >
                          mst <- getDResource $ Key (ofType :: Type) key
                          case mst of
                           Nothing -> error $ "getResource: not found "++ key
                           Just (idyn) -> do
                             let st = fromIDyn idyn :: <desired datatype>
                             ....
                     -}

-- same access interface , this time for Dynamic type. See Data.TCache for their equivalent definitions
,getTMVars,getTMVarsIO,withDResource, withDResources, withDSTMResources, getDResource, getDResources, deleteDResource, deleteDResources


-- syncache has no parameters now (see Data.TCache.syncCache)
,syncCache

-- Same than Data.TCache but without Cache parameter
,clearSyncCacheProc
 
-- the same interface for any datatype:
, withResource, withResources, withSTMResources, getResource, getResources, deleteResource, deleteResources


)

where

import System.IO.Unsafe
import Data.Typeable
import qualified Data.TCache.TMVar as T
import Data.TCache.IDynamic as I
import Debug.Trace
import Control.Concurrent.STM(atomically,STM)
import Control.Concurrent.STM.TMVar
import Control.Concurrent(forkIO)
import Control.Exception(finally)


debug a b= trace b a



withDResource :: IDynamic->(Maybe IDynamic->IDynamic)->IO ()
withDResource =  T.withResource

withDResources:: [IDynamic]->([Maybe IDynamic]->[IDynamic])->IO ()
withDResources =  T.withResources


withDSTMResources :: [IDynamic]->([Maybe IDynamic]->T.Resources IDynamic x)->STM x
withDSTMResources =  T.withSTMResources

getDResource :: IDynamic ->  IO (Maybe IDynamic)
getDResource  = T.getResource 

getDResources :: [IDynamic] ->  IO [Maybe IDynamic]
getDResources = T.getResources

getTMVars ::  [IDynamic] -> STM [Maybe (TMVar IDynamic)]
getTMVars= T.getTMVars

getTMVarsIO ::  [IDynamic] -> IO [TMVar IDynamic]
getTMVarsIO= T.getTMVarsIO



-- | return error if any resource is not found
justGetDResources rs=do mrs <- getDResources rs
                        return $ map process $ zip mrs rs  
        where
            process (Nothing, r) = error ("\""++T.keyResource r ++ "\" does not exist")
            process (Just r', _) = r'
    
justGetDResource r= do  [r']<- justGetDResources [r]
                        return r'

                 

deleteDResource :: IDynamic -> IO ()
deleteDResource= T.deleteResource

deleteDResources :: [IDynamic] -> IO ()
deleteDResources= T.deleteResources

syncCache=   T.syncCache (T.refcache :: T.Cache IDynamic) 
                 
                

clearSyncCacheProc= T.clearSyncCacheProc (T.refcache :: T.Cache IDynamic)

withResource ::(Typeable a, Typeable b, T.IResource a, T.IResource b) => a->(Maybe a->b)->IO ()
withResource r f=  withResources [r] (\[mr]-> [f mr])

withResources::(Typeable a, Typeable b, T.IResource a, T.IResource b) => [a]->([Maybe a]->[b])->IO ()
withResources rs f=  withDResources (map toIDyn rs) (\mrs-> f' mrs) where
          f' = map toIDyn . f . map g
          g Nothing= Nothing
          g (Just x)= Just (fromIDyn x)


withSTMResources :: forall x.forall a.forall b.(Typeable a, Typeable b, T.IResource a, T.IResource b) => [a] -- ^ the list of resources to be retrieved
                     ->([Maybe a]-> T.Resources b x)         -- ^ The function that process the resources found and return a Resources structure
                     -> STM x                          -- ^ The return value in the STM monad.
withSTMResources rs f=  withDSTMResources (map toIDyn rs)  f' where
          f' :: [Maybe IDynamic]-> T.Resources IDynamic x
          f' =  h . f . map g

          g (Just x)= Just $ fromIDyn x
          g Nothing = Nothing


          maybeDyn ( Just x) =  Just $ toIDyn x
          maybeDyn Nothing   = Nothing

          h (T.Resources  a d r)= T.Resources (map toIDyn a) (map toIDyn d)  r

          
getResource ::(Typeable a, Typeable b, T.IResource a, T.IResource b) => a ->  IO (Maybe b)
getResource  x= getDResource (toIDyn x) >>= return . g where 
          g Nothing= Nothing
          g (Just x)= Just (fromIDyn x)
          
getResources ::(Typeable a, Typeable b, T.IResource a, T.IResource b) => [a] ->  IO [Maybe b]
getResources rs = getDResources (map toIDyn rs) >>= return . map g where
          g Nothing= Nothing
          g (Just x)= Just (fromIDyn x)

                 

deleteResource ::(Typeable a, T.IResource a) => a -> IO ()
deleteResource x= deleteDResource (toIDyn x)

deleteResources ::(Typeable a, T.IResource a) => [a] -> IO ()
deleteResources xs= deleteDResources (map toIDyn xs)