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 {
forall t. DateCache t -> t
timeKey :: !t
, forall t. DateCache t -> ByteString
formattedDate :: !ByteString
} deriving (DateCache t -> DateCache t -> Bool
(DateCache t -> DateCache t -> Bool)
-> (DateCache t -> DateCache t -> Bool) -> Eq (DateCache t)
forall t. Eq t => DateCache t -> DateCache t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall t. Eq t => DateCache t -> DateCache t -> Bool
== :: DateCache t -> DateCache t -> Bool
$c/= :: forall t. Eq t => DateCache t -> DateCache t -> Bool
/= :: DateCache t -> DateCache t -> Bool
Eq, Int -> DateCache t -> ShowS
[DateCache t] -> ShowS
DateCache t -> String
(Int -> DateCache t -> ShowS)
-> (DateCache t -> String)
-> ([DateCache t] -> ShowS)
-> Show (DateCache t)
forall t. Show t => Int -> DateCache t -> ShowS
forall t. Show t => [DateCache t] -> ShowS
forall t. Show t => DateCache t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall t. Show t => Int -> DateCache t -> ShowS
showsPrec :: Int -> DateCache t -> ShowS
$cshow :: forall t. Show t => DateCache t -> String
show :: DateCache t -> String
$cshowList :: forall t. Show t => [DateCache t] -> ShowS
showList :: [DateCache t] -> ShowS
Show)
data DateCacheConf t = DateCacheConf {
forall t. DateCacheConf t -> IO t
getTime :: IO t
, forall t. DateCacheConf t -> t -> IO ByteString
formatDate :: t -> IO ByteString
}
newDate :: DateCacheConf t -> t -> IO (DateCache t)
newDate :: forall t. DateCacheConf t -> t -> IO (DateCache t)
newDate DateCacheConf t
setting t
tm = t -> ByteString -> DateCache t
forall t. t -> ByteString -> DateCache t
DateCache t
tm (ByteString -> DateCache t) -> IO ByteString -> IO (DateCache t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DateCacheConf t -> t -> IO ByteString
forall t. DateCacheConf t -> t -> IO ByteString
formatDate DateCacheConf t
setting t
tm
ondemandDateCacher :: Eq t => DateCacheConf t -> IO (DateCacheGetter, DateCacheCloser)
ondemandDateCacher :: forall t.
Eq t =>
DateCacheConf t -> IO (IO ByteString, DateCacheCloser)
ondemandDateCacher DateCacheConf t
setting = do
IORef (DateCache t)
ref <- DateCacheConf t -> IO t
forall t. DateCacheConf t -> IO t
getTime DateCacheConf t
setting IO t -> (t -> IO (DateCache t)) -> IO (DateCache t)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DateCacheConf t -> t -> IO (DateCache t)
forall t. DateCacheConf t -> t -> IO (DateCache t)
newDate DateCacheConf t
setting IO (DateCache t)
-> (DateCache t -> IO (IORef (DateCache t)))
-> IO (IORef (DateCache t))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DateCache t -> IO (IORef (DateCache t))
forall a. a -> IO (IORef a)
newIORef
(IO ByteString, DateCacheCloser)
-> IO (IO ByteString, DateCacheCloser)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((IO ByteString, DateCacheCloser)
-> IO (IO ByteString, DateCacheCloser))
-> (IO ByteString, DateCacheCloser)
-> IO (IO ByteString, DateCacheCloser)
forall a b. (a -> b) -> a -> b
$! (IORef (DateCache t) -> IO ByteString
getter IORef (DateCache t)
ref, DateCacheCloser
closer)
where
getter :: IORef (DateCache t) -> IO ByteString
getter IORef (DateCache t)
ref = do
t
newTm <- DateCacheConf t -> IO t
forall t. DateCacheConf t -> IO t
getTime DateCacheConf t
setting
DateCache t
cache <- IORef (DateCache t) -> IO (DateCache t)
forall a. IORef a -> IO a
readIORef IORef (DateCache t)
ref
let oldTm :: t
oldTm = DateCache t -> t
forall t. DateCache t -> t
timeKey DateCache t
cache
if t
oldTm t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
newTm then
ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ DateCache t -> ByteString
forall t. DateCache t -> ByteString
formattedDate DateCache t
cache
else do
DateCache t
newCache <- DateCacheConf t -> t -> IO (DateCache t)
forall t. DateCacheConf t -> t -> IO (DateCache t)
newDate DateCacheConf t
setting t
newTm
IORef (DateCache t) -> DateCache t -> DateCacheCloser
forall a. IORef a -> a -> DateCacheCloser
writeIORef IORef (DateCache t)
ref DateCache t
newCache
ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ DateCache t -> ByteString
forall t. DateCache t -> ByteString
formattedDate DateCache t
newCache
closer :: DateCacheCloser
closer = () -> DateCacheCloser
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
clockDateCacher :: Eq t => DateCacheConf t -> IO (DateCacheGetter, DateCacheCloser)
clockDateCacher :: forall t.
Eq t =>
DateCacheConf t -> IO (IO ByteString, DateCacheCloser)
clockDateCacher DateCacheConf t
setting = do
IORef (DateCache t)
ref <- DateCacheConf t -> IO t
forall t. DateCacheConf t -> IO t
getTime DateCacheConf t
setting IO t -> (t -> IO (DateCache t)) -> IO (DateCache t)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DateCacheConf t -> t -> IO (DateCache t)
forall t. DateCacheConf t -> t -> IO (DateCache t)
newDate DateCacheConf t
setting IO (DateCache t)
-> (DateCache t -> IO (IORef (DateCache t)))
-> IO (IORef (DateCache t))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DateCache t -> IO (IORef (DateCache t))
forall a. a -> IO (IORef a)
newIORef
ThreadId
tid <- DateCacheCloser -> IO ThreadId
forkIO (DateCacheCloser -> IO ThreadId) -> DateCacheCloser -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IORef (DateCache t) -> DateCacheCloser
forall {b}. IORef (DateCache t) -> IO b
clock IORef (DateCache t)
ref
(IO ByteString, DateCacheCloser)
-> IO (IO ByteString, DateCacheCloser)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((IO ByteString, DateCacheCloser)
-> IO (IO ByteString, DateCacheCloser))
-> (IO ByteString, DateCacheCloser)
-> IO (IO ByteString, DateCacheCloser)
forall a b. (a -> b) -> a -> b
$! (IORef (DateCache t) -> IO ByteString
forall {t}. IORef (DateCache t) -> IO ByteString
getter IORef (DateCache t)
ref, ThreadId -> DateCacheCloser
closer ThreadId
tid)
where
getter :: IORef (DateCache t) -> IO ByteString
getter IORef (DateCache t)
ref = DateCache t -> ByteString
forall t. DateCache t -> ByteString
formattedDate (DateCache t -> ByteString) -> IO (DateCache t) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (DateCache t) -> IO (DateCache t)
forall a. IORef a -> IO a
readIORef IORef (DateCache t)
ref
clock :: IORef (DateCache t) -> IO b
clock IORef (DateCache t)
ref = do
Int -> DateCacheCloser
threadDelay Int
1000000
t
tm <- DateCacheConf t -> IO t
forall t. DateCacheConf t -> IO t
getTime DateCacheConf t
setting
ByteString
date <- DateCacheConf t -> t -> IO ByteString
forall t. DateCacheConf t -> t -> IO ByteString
formatDate DateCacheConf t
setting t
tm
let new :: DateCache t
new = DateCache {
timeKey :: t
timeKey = t
tm
, formattedDate :: ByteString
formattedDate = ByteString
date
}
IORef (DateCache t) -> DateCache t -> DateCacheCloser
forall a. IORef a -> a -> DateCacheCloser
writeIORef IORef (DateCache t)
ref DateCache t
new
IORef (DateCache t) -> IO b
clock IORef (DateCache t)
ref
closer :: ThreadId -> DateCacheCloser
closer ThreadId
tid = ThreadId -> DateCacheCloser
killThread ThreadId
tid