    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE CPP          #-}

    module Snap.Internal.Http.Server.Date
      ( getDateString
      , getLogDateString
      ) where

    ------------------------------------------------------------------------------
    import           Control.Exception        (mask_)
    import           Control.Monad            (when)
    import           Data.ByteString          (ByteString)
    import           Data.IORef               (IORef, newIORef, readIORef, writeIORef)
    import           Foreign.C.Types          (CTime)
    import           System.IO.Unsafe         (unsafePerformIO)
    import           System.PosixCompat.Time  (epochTime)
    ------------------------------------------------------------------------------
    import           Snap.Internal.Http.Types (formatHttpTime, formatLogTime)

    ------------------------------------------------------------------------------
    data DateState = DateState {
          DateState -> IORef ByteString
    _cachedDateString :: !(IORef ByteString)
        , DateState -> IORef ByteString
    _cachedLogString  :: !(IORef ByteString)
        , DateState -> IORef EpochTime
    _lastFetchTime    :: !(IORef CTime)
        }

    ------------------------------------------------------------------------------
    dateState :: DateState
    dateState :: DateState
    dateState = IO DateState -> DateState
    forall a. IO a -> a
    unsafePerformIO (IO DateState -> DateState) -> IO DateState -> DateState
    forall a b. (a -> b) -> a -> b
    $ do
        (s1, s2, date) <- IO (ByteString, ByteString, EpochTime)
    fetchTime
        bs1 <- newIORef $! s1
        bs2 <- newIORef $! s2
        dt  <- newIORef $! date

        return $! DateState bs1 bs2 dt
    {-# NOINLINE dateState #-}

    ------------------------------------------------------------------------------
    fetchTime :: IO (ByteString,ByteString,CTime)
    fetchTime :: IO (ByteString, ByteString, EpochTime)
    fetchTime = do
        !now <- IO EpochTime
    epochTime
        !t1  <- formatHttpTime now
        !t2  <- formatLogTime now
        let !out = (ByteString
    t1, ByteString
    t2, EpochTime
    now)
        return out

    ------------------------------------------------------------------------------
    updateState :: DateState -> IO ()
    updateState :: DateState -> IO ()
    updateState (DateState IORef ByteString
    dateString IORef ByteString
    logString IORef EpochTime
    time) = do
        (s1, s2, now) <- IO (ByteString, ByteString, EpochTime)
    fetchTime
        writeIORef dateString $! s1
        writeIORef logString  $! s2
        writeIORef time       $! now

        return $! ()

    ------------------------------------------------------------------------------
    ensureFreshDate :: IO ()
    ensureFreshDate :: IO ()
    ensureFreshDate = IO () -> IO ()
    forall a. IO a -> IO a
    mask_ (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        now <- IO EpochTime
    epochTime
        old <- readIORef $ _lastFetchTime dateState
        when (now > old) $! updateState dateState

    ------------------------------------------------------------------------------
    getDateString :: IO ByteString
    getDateString :: IO ByteString
    getDateString = IO ByteString -> IO ByteString
    forall a. IO a -> IO a
    mask_ (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ do
        IO ()
    ensureFreshDate
        IORef ByteString -> IO ByteString
    forall a. IORef a -> IO a
    readIORef (IORef ByteString -> IO ByteString)
    -> IORef ByteString -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ DateState -> IORef ByteString
    _cachedDateString DateState
    dateState

    ------------------------------------------------------------------------------
    getLogDateString :: IO ByteString
    getLogDateString :: IO ByteString
    getLogDateString = IO ByteString -> IO ByteString
    forall a. IO a -> IO a
    mask_ (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ do
        IO ()
    ensureFreshDate
        IORef ByteString -> IO ByteString
    forall a. IORef a -> IO a
    readIORef (IORef ByteString -> IO ByteString)
    -> IORef ByteString -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ DateState -> IORef ByteString
    _cachedLogString DateState
    dateState