-- |
-- Formatting time is slow.
-- This package provides mechanisms to cache formatted date.
module System.Date.Cache (
  -- * Types
    DateCacheConf(..)
  , DateCacheGetter
  , DateCacheCloser
  -- * Date cacher
  , 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 {
    DateCache t -> t
timeKey :: !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
/= :: DateCache t -> DateCache t -> Bool
$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
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
showList :: [DateCache t] -> ShowS
$cshowList :: forall t. Show t => [DateCache t] -> ShowS
show :: DateCache t -> String
$cshow :: forall t. Show t => DateCache t -> String
showsPrec :: Int -> DateCache t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> DateCache t -> ShowS
Show)

data DateCacheConf t = DateCacheConf {
    -- | A function to get a time. E.g 'epochTime' and 'getCurrentTime'.
    DateCacheConf t -> IO t
getTime :: IO t
    -- | A function to format a time.
  , DateCacheConf t -> t -> IO ByteString
formatDate :: t -> IO ByteString
  }

newDate :: DateCacheConf t -> t -> IO (DateCache t)
newDate :: DateCacheConf t -> t -> IO (DateCache t)
newDate setting :: DateCacheConf t
setting tm :: 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

-- |
-- Date cacher which gets a time and formatted it only when
-- returned getter is executed.
ondemandDateCacher :: Eq t => DateCacheConf t -> IO (DateCacheGetter, DateCacheCloser)
ondemandDateCacher :: DateCacheConf t -> IO (IO ByteString, DateCacheCloser)
ondemandDateCacher setting :: 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 (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 (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 (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 ref :: 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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return ()

-- |
-- Date cacher which gets a time and formatted it every second.
-- This returns a getter.
clockDateCacher :: Eq t => DateCacheConf t -> IO (DateCacheGetter, DateCacheCloser)
clockDateCacher :: DateCacheConf t -> IO (IO ByteString, DateCacheCloser)
clockDateCacher setting :: 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 (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 (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 (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 ref :: 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 ref :: IORef (DateCache t)
ref = do
        Int -> DateCacheCloser
threadDelay 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 = $WDateCache :: forall t. t -> ByteString -> DateCache t
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 tid :: ThreadId
tid = ThreadId -> DateCacheCloser
killThread ThreadId
tid