module System.Date.Cache (
DateCacheConf(..)
, DateCacheGetter
, DateCacheCloser
, ondemandDateCacher
, clockDateCacher
) where
import Control.Applicative
import Control.Concurrent
import Data.ByteString (ByteString)
import Data.IORef
type DateCacheGetter = IO ByteString
type DateCacheCloser = IO ()
data DateCache t = DateCache {
timeKey :: !t
, formattedDate :: !ByteString
} deriving (Eq, Show)
data DateCacheConf t = DateCacheConf {
getTime :: IO t
, formatDate :: t -> IO ByteString
}
newDate :: DateCacheConf t -> t -> IO (DateCache t)
newDate setting tm = DateCache tm <$> formatDate setting tm
ondemandDateCacher :: Eq t => DateCacheConf t -> IO (DateCacheGetter, DateCacheCloser)
ondemandDateCacher setting = do
ref <- getTime setting >>= newDate setting >>= newIORef
return $! (getter ref, closer)
where
getter ref = do
newTm <- getTime setting
cache <- readIORef ref
let oldTm = timeKey cache
if oldTm == newTm then
return $ formattedDate cache
else do
newCache <- newDate setting newTm
writeIORef ref newCache
return $ formattedDate newCache
closer = return ()
clockDateCacher :: Eq t => DateCacheConf t -> IO (DateCacheGetter, DateCacheCloser)
clockDateCacher setting = do
ref <- getTime setting >>= newDate setting >>= newIORef
tid <- forkIO $ clock ref
return $! (getter ref, closer tid)
where
getter ref = formattedDate <$> readIORef ref
clock ref = do
threadDelay 1000000
tm <- getTime setting
date <- formatDate setting tm
let new = DateCache {
timeKey = tm
, formattedDate = date
}
writeIORef ref new
clock ref
closer tid = killThread tid