module Data.TCache.Memoization (cachedByKey,cachedp,addrStr,addrHash,Executable(..))
where
import Data.Typeable
import Data.TCache
import Data.TCache.Defs(Indexable(..))
import System.Mem.StableName
import System.IO.Unsafe
import System.Time
import Data.Maybe(fromJust)
import Control.Monad.Trans
import Control.Monad.Identity
import Debug.Trace
(!>)= flip trace
data Cached a b= forall m.Executable m => Cached a (a -> m b) b Integer deriving Typeable
addrStr :: MonadIO m => a -> m String
addrStr x = addrHash x >>= return . show
addrHash :: MonadIO m => a -> m Int
addrHash x= liftIO $ do
st <- makeStableName $! x
return $ hashStableName st
class Executable m where
execute:: m a -> a
instance Executable IO where
execute= unsafePerformIO
instance Executable Identity where
execute (Identity x)= x
instance MonadIO Identity where
liftIO= Identity . unsafePerformIO
instance (Indexable a, Typeable a) => IResource (Cached a b) where
keyResource ch@(Cached a f _ _)= "cached"++key a
writeResource _= return ()
delResource _= return ()
readResourceByKey= error "access By Indexable is undefined for chached objects"
readResource (Cached a f _ _)=do
TOD tnow _ <- getClockTime
let b = execute $ f a
return . Just $ Cached a f b tnow
instance Indexable String where
key= id
cached :: (Indexable a, Typeable a, Typeable b, Executable m,MonadIO m) => Int -> (a -> m b) -> a -> m b
cached time f a= do
cho@(Cached _ _ b t) <- liftIO $ getResource ( (Cached a f undefined undefined )) >>= return . fromJust
case time of
0 -> return b
_ -> do
TOD tnow _ <- liftIO $ getClockTime
if time /=0 && tnow t > fromIntegral time
then do
liftIO $ deleteResource cho
cached time f a
else return b
cachedByKey :: (Typeable a, Executable m,MonadIO m) => String -> Int -> m a -> m a
cachedByKey key time f = cached time (\_ -> f) key
cachedp :: (Indexable a,Typeable a,Typeable b) => (a ->b) -> a -> b
cachedp f k = execute $ cached 0 (\x -> Identity $ f x) k