HTTP

diff --git a/Data/Time/HTTP.hs b/Data/Time/HTTP.hs
new file mode 100644 (file)
index 0000000..3a3dc3e
--- /dev/null
+++ b/Data/Time/HTTP.hs
@@ -0,0 +1,29 @@
+module Data.Time.HTTP
+    ( format
+    , parse
+    )
+    where
+
+import qualified Data.Time.RFC1123 as RFC1123
+import qualified Text.Parsec as P
+
+import Data.Time
+import Data.Time.HTTP.Parsec
+
+
+format :: UTCTime -> String
+format utcTime
+    = let timeZone  = TimeZone 0 False "GMT"
+          zonedTime = utcToZonedTime timeZone utcTime
+      in
+        RFC1123.format zonedTime
+
+
+parse :: String -> Maybe UTCTime
+parse src = case P.parse p "" src of
+              Right ut -> Just ut
+              Left  _  -> Nothing
+    where
+      p = do zt <- rfc2616DateAndTime
+             _  <- P.eof
+             return zt

diff --git a/Data/Time/HTTP/Parsec.hs b/Data/Time/HTTP/Parsec.hs
new file mode 100644 (file)
index 0000000..03bd54c
--- /dev/null
+++ b/Data/Time/HTTP/Parsec.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE FlexibleContexts #-}
+module Data.Time.HTTP.Parsec
+    ( rfc2616DateAndTime
+    )
+    where
+
+import Control.Monad
+import Data.Time
+import Data.Time.RFC1123.Parsec
+import Data.Time.RFC733.Parsec
+import Data.Time.Asctime.Parsec
+import Text.Parsec
+
+
+rfc2616DateAndTime :: Stream s m Char => ParsecT s u m UTCTime
+rfc2616DateAndTime
+    = choice [ liftM zonedTimeToUTC $ try rfc1123DateAndTime
+             , liftM zonedTimeToUTC $ try rfc733DateAndTime
+             , liftM (localTimeToUTC utc) $ asctime
+             ]

diff --git a/Data/Time/RFC1123.hs b/Data/Time/RFC1123.hs
index abb0a6d53e882eee4e70aaf27e3ea928a1cbce92..bf68f057704661b6b7b9617a6068761fff441213 100644 (file)
--- a/Data/Time/RFC1123.hs
+++ b/Data/Time/RFC1123.hs
@@ -9,6 +9,7 @@ import qualified Text.Parsec as P
 import Data.Time
 import Data.Time.Calendar.WeekDate
 import Data.Time.HTTP.Common
+import Data.Time.RFC822 (showRFC822TimeZone)
 import Data.Time.RFC1123.Parsec
 
 {-
@@ -39,7 +40,7 @@ format zonedTime
                , ":"
                , show2 (floor (todSec timeOfDay))
                , " "
-               , show4digitsTZ timeZone
+               , showRFC822TimeZone timeZone
                ]
 
 parse :: String -> Maybe ZonedTime

diff --git a/Data/Time/RFC822.hs b/Data/Time/RFC822.hs
index 8feeb764e1b2c0b6ed05c1178436061240caeeb1..1352e6d58428e12c760cda253de160db92956590 100644 (file)
--- a/Data/Time/RFC822.hs
+++ b/Data/Time/RFC822.hs
@@ -1,6 +1,9 @@
 module Data.Time.RFC822
     ( format
     , parse
+
+    -- private
+    , showRFC822TimeZone
     )
     where
 
@@ -66,9 +69,14 @@ format zonedTime
                , ":"
                , show2 (floor (todSec timeOfDay))
                , " "
-               , show4digitsTZ timeZone
+               , showRFC822TimeZone timeZone
                ]
 
+showRFC822TimeZone :: TimeZone -> String
+showRFC822TimeZone tz
+    | timeZoneMinutes tz == 0 = "GMT"
+    | otherwise               = show4digitsTZ tz
+
 parse :: String -> Maybe ZonedTime
 parse src = case P.parse p "" src of
               Right zt -> Just zt

diff --git a/time-http.cabal b/time-http.cabal
index 051216baf59ea6809f29a7776b9879e6ec8b7ca8..c703beb1eb8f1cd6725b6b9cb41530845328f41f 100644 (file)
--- a/time-http.cabal
+++ b/time-http.cabal
@@ -29,6 +29,8 @@ Library
         Data.Time.RFC1123.Parsec
         Data.Time.Asctime
         Data.Time.Asctime.Parsec
+        Data.Time.HTTP
+        Data.Time.HTTP.Parsec
 
     Other-modules:
         Data.Time.HTTP.Common