From 7ed69912b457694657e70496f695685493abcab5 Mon Sep 17 00:00:00 2001
From: PHO <pho@cielonegro.org>
Date: Wed, 17 Mar 2010 18:38:04 +0900
Subject: [PATCH] HTTP
---
Data/Time/HTTP.hs | 29 +++++++++++++++++++++++++++++
Data/Time/HTTP/Parsec.hs | 20 ++++++++++++++++++++
Data/Time/RFC1123.hs | 3 ++-
Data/Time/RFC822.hs | 10 +++++++++-
time-http.cabal | 2 ++
5 files changed, 62 insertions(+), 2 deletions(-)
create mode 100644 Data/Time/HTTP.hs
create mode 100644 Data/Time/HTTP/Parsec.hs
diff --git a/Data/Time/HTTP.hs b/Data/Time/HTTP.hs
new file mode 100644
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
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 abb0a6d..bf68f05 100644
--- 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 8feeb76..1352e6d 100644
--- 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 051216b..c703beb 100644
--- 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
--
2.40.0