    {-# LANGUAGE CPP #-}
    {-# OPTIONS -fno-cse #-}
    module Happstack.Server.Internal.Clock
        ( getApproximateTime
        , getApproximatePOSIXTime
        , getApproximateUTCTime
        , formatHttpDate
        ) where

    import Control.Concurrent
    import Control.Monad
    import qualified Data.ByteString.Char8 as B
    import Data.IORef
    import Data.Time.Clock       (UTCTime)
    import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime, posixSecondsToUTCTime)
    import Data.Time.Format (formatTime, defaultTimeLocale)
    import System.IO.Unsafe

    data DateCache = DateCache {
          DateCache -> IORef POSIXTime
    cachedPOSIXTime :: !(IORef POSIXTime)
        , DateCache -> IORef ByteString
    cachedHttpDate  :: !(IORef B.ByteString)
        }

    formatHttpDate :: UTCTime -> String
    formatHttpDate :: UTCTime -> String
    formatHttpDate = TimeLocale -> String -> UTCTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale String
    "%a, %d %b %Y %X GMT"
    {-# INLINE formatHttpDate #-}

    mkTime :: IO (POSIXTime, B.ByteString)
    mkTime :: IO (POSIXTime, ByteString)
    mkTime =
        do now <- IO POSIXTime
    getPOSIXTime
           return (now, B.pack $ formatHttpDate (posixSecondsToUTCTime now))

    {-# NOINLINE clock #-}
    clock :: DateCache
    clock :: DateCache
    clock = IO DateCache -> DateCache
    forall a. IO a -> a
    unsafePerformIO (IO DateCache -> DateCache) -> IO DateCache -> DateCache
    forall a b. (a -> b) -> a -> b
    $ do
      (now, httpDate) <- IO (POSIXTime, ByteString)
    mkTime
      nowRef      <- newIORef now
      httpDateRef <- newIORef httpDate
      let dateCache = (IORef POSIXTime -> IORef ByteString -> DateCache
    DateCache IORef POSIXTime
    nowRef IORef ByteString
    httpDateRef)
      void $ forkIO $ updater dateCache
      return dateCache

    updater :: DateCache -> IO ()
    updater :: DateCache -> IO ()
    updater DateCache
    dateCache =
        do Int -> IO ()
    threadDelay (Int
    10Int -> Int -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(Int
    6 :: Int)) -- Every second
           (now, httpDate) <- IO (POSIXTime, ByteString)
    mkTime
           writeIORef (cachedPOSIXTime dateCache) now
           writeIORef (cachedHttpDate  dateCache) httpDate
           updater dateCache

    getApproximateTime :: IO B.ByteString
    getApproximateTime :: IO ByteString
    getApproximateTime = IORef ByteString -> IO ByteString
    forall a. IORef a -> IO a
    readIORef (DateCache -> IORef ByteString
    cachedHttpDate DateCache
    clock)

    getApproximatePOSIXTime :: IO POSIXTime
    getApproximatePOSIXTime :: IO POSIXTime
    getApproximatePOSIXTime = IORef POSIXTime -> IO POSIXTime
    forall a. IORef a -> IO a
    readIORef (DateCache -> IORef POSIXTime
    cachedPOSIXTime DateCache
    clock)

    getApproximateUTCTime :: IO UTCTime
    getApproximateUTCTime :: IO UTCTime
    getApproximateUTCTime = POSIXTime -> UTCTime
    posixSecondsToUTCTime (POSIXTime -> UTCTime) -> IO POSIXTime -> IO UTCTime
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO POSIXTime
    getApproximatePOSIXTime