@@ -0,0 +1,55 @@
1+{-# LANGUAGE CPP #-}
2+
3+module Network.Wai.Handler.Warp.Date (
4+ withDateCache
5+ , getDate
6+ , DateCache
7+ , GMTDate
8+ ) where
9+
10+import Control.Applicative
11+import Control.Concurrent
12+import Control.Exception
13+import Control.Monad
14+import Data.ByteString.Char8
15+import Data.IORef
16+
17+#if WINDOWS
18+import Data.Time
19+import System.Locale
20+#else
21+import Network.HTTP.Date
22+import System.Posix (epochTime)
23+#endif
24+
25+type GMTDate = ByteString
26+
27+data DateCache = DateCache (IORef GMTDate)
28+
29+withDateCache :: (DateCache -> IO a) -> IO a
30+withDateCache action = bracket initialize
31+ (\(t,_) -> killThread t)
32+ (\(_,dc) -> action dc)
33+
34+initialize :: IO (ThreadId, DateCache)
35+initialize = do
36+ dc <- DateCache <$> (getCurrentGMTDate >>= newIORef)
37+ t <- forkIO $ forever $ do
38+ threadDelay 1000000
39+ update dc
40+ return (t, dc)
41+
42+getDate :: DateCache -> IO GMTDate
43+getDate (DateCache ref) = readIORef ref
44+
45+update :: DateCache -> IO ()
46+update (DateCache ref) = getCurrentGMTDate >>= writeIORef ref
47+
48+getCurrentGMTDate :: IO GMTDate
49+#ifdef WINDOWS
50+getCurrentGMTDate = formatDate <$> getCurrentTime
51+ where
52+ formatDate = pack . formatTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S GMT"
53+#else
54+getCurrentGMTDate = formatHTTPDate . epochTimeToHTTPDate <$> epochTime
55+#endif