{-# OPTIONS -fglasgow-exts  -XUndecidableInstances -XBangPatterns #-}

{- | 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 don´t 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)
-}

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


  ,DynamicInterface (
    toIDyn           -- :: x -> IDynamic
    ,registerType   -- :: x
    ,fromIDyn        -- :: IDynamic -> x
    ,unsafeFromIDyn  -- :: IDynamic -> x
    ,safeFromIDyn   ---- :: IDynamic -> Maybe x
   )
  --,ofType
  ,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 than TCache , this time for handling the Dynamic type. See Data.TCache for their equivalent definitions
-- to use it you have to wrap (with toIDyn)  and unwrap(with fromIDyn) your data in a IDynamic object
,getTVars, releaseTVars, getTVarsIO,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. wrapping and unwrapping are made internally.
--have the same functionalities than the Data.TCache primitives with the same name.
, withResource, withResources, withSTMResources, getResource, getResources, deleteResource, deleteResources


)

where

import System.IO.Unsafe
import Data.Typeable
import qualified Data.TCache as T
import Data.TCache.IDynamic as I
import Debug.Trace
import Control.Concurrent.STM(atomically,STM)
import Control.Concurrent.STM.TVar
import Control.Concurrent(forkIO)
import Control.Exception(finally)
import Data.TCache.IDynamic
import Control.Concurrent(ThreadId)
debug a b= trace b a

-- | handles Dynamic objects using  @Data.TCache.withResource@
--
--  @withDResource =  Data.TCache..withResource @
withDResource   :: IDynamic-> (Maybe IDynamic-> IDynamic)-> IO ()
withDResource =  T.withResource

--  | @withDResources =   Data.TCache.withResources@
withDResources:: [IDynamic]-> ([Maybe IDynamic]-> [IDynamic])-> IO ()
withDResources =  T.withResources

-- | 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
withDSTMResources
            :: [IDynamic]                             -- ^ The list of resources to be retrieved
            -> ([Maybe IDynamic]   -> T.Resources IDynamic x)      -- ^ The function that process the resources found and return a Resources structure
            -> STM x                                    -- ^ The return value in the STM monad.
withDSTMResources =  T.withSTMResources

-- | @getDResource  = Data.TCache.getResource@
getDResource :: IDynamic ->  IO (Maybe IDynamic)
getDResource  = T.getResource 

-- | @getDResources  = Data.TCache.getResources@
getDResources :: [IDynamic] ->  IO [Maybe IDynamic]
getDResources = T.getResources

-- | 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'
getTVars ::  [IDynamic] -> STM [Maybe (TVar IDynamic)]
getTVars= T.getTVars

releaseTVars ::  [IDynamic] -> STM ()
releaseTVars= T.releaseTVars

getTVarsIO ::  [IDynamic] -> IO [TVar IDynamic]
getTVarsIO= T.getTVarsIO



-- | retrieve a list of objects and return error if any resource is not found. instead of Nothing
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'

                 
-- | delete a resource  from the cache and the storage
deleteDResource :: IDynamic -> IO ()
deleteDResource= T.deleteResource

-- | delete a list of resources from the cache and the storage
deleteDResources :: [IDynamic] -> IO ()
deleteDResources= T.deleteResources

-- syncronize the cache with the permanent storage
syncCache :: IO ()
syncCache=   T.syncCache (T.refcache :: T.Cache IDynamic) 
                 
-- | Start the thread that clean and writes on the persistent storage. 
-- Otherwise, syncCache must be invoked explicitly or no persistence will exist
clearSyncCacheProc
      ::  Int                          -- ^ number of seconds betwen checks. objects not written to disk are written
      -> (Integer -> Integer-> Integer-> Bool)  -- ^ The user-defined check-for-cleanup-from-cache for each object. 'defaultCheck' is an example
      -> Int                          -- ^ The max number of objects in the cache, if more, the  cleanup starts
      -> IO ThreadId           -- ^ Identifier of the thread created
clearSyncCacheProc= T.clearSyncCacheProc (T.refcache :: T.Cache IDynamic)

{- | 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
withResource ::(Typeable a, Typeable b, T.IResource a, T.IResource b) => a-> (Maybe a-> b)-> IO ()
withResource r f=  withResources [r] (\[mr]-> [f mr])

-- | similar to @Data.TCache.withResources@.
-- The fact that this method may return a type different that the source type permits to use ' Key' objects
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)

-- | 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
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

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

-- | similar to Data.@TCache.getResource@.
-- The fact that this method may return a type different that the source type permits to use ' Key' objects
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)

-- | similar to @Data.TCache.getResources@.
-- The fact that this method may return a type different that the source type permits to use ' Key' objects
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)

-- | similar to @Data.TCache.deleteResource@
deleteResource ::(Typeable a, T.IResource a) => a -> IO ()
deleteResource x= deleteDResource (toIDyn x)

-- | similar to @Data.TCache.deleteResource@
deleteResources ::(Typeable a, T.IResource a) => [a] -> IO ()
deleteResources xs= deleteDResources (map toIDyn xs)