-- |
-- 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 {
    forall t. DateCache t -> t
timeKey :: !t
  , forall t. DateCache t -> ByteString
formattedDate :: !ByteString
  } deriving (DateCache t -> DateCache t -> Bool
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
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'.
    forall t. DateCacheConf t -> IO t
getTime :: IO t
    -- | A function to format a time.
  , 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 = forall t. t -> ByteString -> DateCache t
DateCache t
tm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall t.
Eq t =>
DateCacheConf t -> IO (IO ByteString, DateCacheCloser)
ondemandDateCacher DateCacheConf t
setting = do
    IORef (DateCache t)
ref <- forall t. DateCacheConf t -> IO t
getTime DateCacheConf t
setting forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t. DateCacheConf t -> t -> IO (DateCache t)
newDate DateCacheConf t
setting forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> IO (IORef a)
newIORef
    forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- forall t. DateCacheConf t -> IO t
getTime DateCacheConf t
setting
        DateCache t
cache <- forall a. IORef a -> IO a
readIORef IORef (DateCache t)
ref
        let oldTm :: t
oldTm = forall t. DateCache t -> t
timeKey DateCache t
cache
        if t
oldTm forall a. Eq a => a -> a -> Bool
== t
newTm then
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall t. DateCache t -> ByteString
formattedDate DateCache t
cache
          else do
            DateCache t
newCache <- forall t. DateCacheConf t -> t -> IO (DateCache t)
newDate DateCacheConf t
setting t
newTm
            forall a. IORef a -> a -> DateCacheCloser
writeIORef IORef (DateCache t)
ref DateCache t
newCache
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall t. DateCache t -> ByteString
formattedDate DateCache t
newCache
    closer :: DateCacheCloser
closer = 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 :: forall t.
Eq t =>
DateCacheConf t -> IO (IO ByteString, DateCacheCloser)
clockDateCacher DateCacheConf t
setting = do
    IORef (DateCache t)
ref <- forall t. DateCacheConf t -> IO t
getTime DateCacheConf t
setting forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t. DateCacheConf t -> t -> IO (DateCache t)
newDate DateCacheConf t
setting forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> IO (IORef a)
newIORef
    ThreadId
tid <- DateCacheCloser -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ forall {b}. IORef (DateCache t) -> IO b
clock IORef (DateCache t)
ref
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (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 = forall t. DateCache t -> ByteString
formattedDate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall t. DateCacheConf t -> IO t
getTime DateCacheConf t
setting
        ByteString
date <- 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
              }
        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