{-# LANGUAGE CPP, OverloadedStrings #-}

-- |
-- Formatting time is slow.
-- This package provides mechanisms to cache formatted date.
module Network.Wai.Logger.Date (
  -- * Types
    DateCacheGetter
  , DateCacheUpdater
  , ZonedDate
  -- * Cache configuration
  , DateCacheConf(..)
  , zonedDateCacheConf
  -- * Date cacher
  , clockDateCacher
  ) where

import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import Data.IORef (newIORef, readIORef, writeIORef)
#if WINDOWS
import qualified Data.ByteString.Char8 as BS
import Data.Time
import System.Locale
#else
import Data.UnixTime (formatUnixTime, fromEpochTime)
import System.Posix (EpochTime, epochTime)
#endif

----------------------------------------------------------------

-- | Getting cached 'ZonedDate'.
type DateCacheGetter = IO ZonedDate
-- | Updateing cached 'ZonedDate'. This should be called every second.
--   See the source code of 'withStdoutLogger'.
type DateCacheUpdater = IO ()

----------------------------------------------------------------

-- | A type for zoned date.
type ZonedDate = ByteString

----------------------------------------------------------------

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

#if WINDOWS
-- | Zoned date cacher using UTC.
zonedDateCacheConf :: DateCacheConf UTCTime
zonedDateCacheConf = DateCacheConf {
    getTime = getCurrentTime
  , formatDate = \ut -> do
      zt <- utcToLocalZonedTime ut
      return $ BS.pack $ formatTime defaultTimeLocale "%d/%b/%Y:%T %z" zt
  }
#else
-- | Zoned date cacher using UnixTime.
zonedDateCacheConf :: DateCacheConf EpochTime
zonedDateCacheConf = DateCacheConf {
    getTime = epochTime
  , formatDate = formatUnixTime "%d/%b/%Y:%T %z" . fromEpochTime
  }
#endif

----------------------------------------------------------------

data DateCache t = DateCache {
    timeKey :: !t
  , formattedDate :: !ByteString
  } deriving (Eq, Show)

----------------------------------------------------------------

newDate :: DateCacheConf t -> t -> IO (DateCache t)
newDate setting tm = DateCache tm <$> formatDate setting tm

-- |
-- Returning 'DateCacheGetter' and 'DateCacheUpdater'.

clockDateCacher :: IO (DateCacheGetter, DateCacheUpdater)
clockDateCacher = do
    ref <- getTime zonedDateCacheConf >>= newDate zonedDateCacheConf >>= newIORef
    return (getter ref, clock ref)
  where
    getter ref = formattedDate <$> readIORef ref
    clock ref = do
        tm <- getTime zonedDateCacheConf
        date <- formatDate zonedDateCacheConf tm
        let new = DateCache {
                timeKey = tm
              , formattedDate = date
              }
        writeIORef ref new