module Util.Cache
( cached, cached2, cached3, cached4
, printCache, writeCache
) where
import Control.Monad
import qualified Data.Map as M
import Data.IORef
import System.IO.Unsafe
cached :: (Ord a, Show a, Show b) => String -> (a -> b) -> a -> b
cached n = withCache . newCache n
cached2 :: (Ord a, Ord b, Show a, Show b, Show c) => String -> (a -> b -> c) -> a -> b -> c
cached2 s f = curry $ cached s $ uncurry $ f
cached3 :: (Ord a, Ord b, Ord c, Show a, Show b, Show c, Show d) => String -> (a -> b -> c -> d) -> a -> b -> c -> d
cached3 s f = curry3 $ cached s $ uncurry3 $ f
where
curry3 f a b c = f (a, b, c)
uncurry3 f (a, b, c) = f a b c
cached4 :: (Ord a, Ord b, Ord c, Ord d, Show a, Show b, Show c, Show d, Show e) => String -> (a -> b -> c -> d -> e) -> a -> b -> c -> d -> e
cached4 s f = curry4 $ cached s $ uncurry4 $ f
where
curry4 f a b c d = f (a, b, c, d)
uncurry4 f (a, b, c, d) = f a b c d
data Cache a b = Cache
{ name :: String
, function :: a -> b
, showKey :: a -> String
, showValue :: b -> String
, counter :: IORef Int
, cache :: IORef (M.Map a b)
}
newCache :: (Show a, Show b) => String -> (a -> b) -> Cache a b
newCache n f = unsafePerformIO $ do
r <- newIORef M.empty
cnt <- newIORef 0
let c = Cache n f show show cnt r
modifyIORef register (c:)
return c
withCache :: Ord a => Cache a b -> a -> b
withCache c a = unsafePerformIO $ do
modifyIORef (counter c) (+1)
m <- readIORef (cache c)
case M.lookup a m of
Just b -> return b
Nothing -> do
let b = function c a
writeIORef (cache c) (M.insert a b m)
return b
register :: IORef [Cache a b]
register = unsafePerformIO (newIORef [])
printCache :: IO ()
printCache = showCache >>= putStrLn
writeCache :: FilePath -> IO ()
writeCache file = showCache >>= writeFile file
showCache :: IO String
showCache = do
xs <- readIORef register
fmap unlines $ forM xs $ \c -> do
n <- readIORef (counter c)
m <- readIORef (cache c)
let sz = M.size m
line = replicate 50 '-'
f (a, b) = showKey c a ++ ": " ++ showValue c b
summary = name c ++ ": size=" ++ show sz ++
", access=" ++ show n ++
", efficiency=" ++ showRatio (n-sz) n
return $ unlines $ summary : line : map f (M.toList m)
showRatio :: Int -> Int -> String
showRatio a b = show rd
where
r = (fromIntegral a / fromIntegral b) :: Double
rn = round (r*1000) :: Int
rd = (fromIntegral rn/1000) :: Double