From: PHO <pho@cielonegro.org>
Date: Wed, 17 Mar 2010 07:00:27 +0000 (+0900)
Subject: RFC1123
X-Git-Tag: RELEASE-0.1.0.1~8
X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=269a28dfe8b08af854f7217bbe9c141c9c18f1ec;p=time-http.git

RFC1123
---

diff --git a/Data/Time/RFC1123.hs b/Data/Time/RFC1123.hs
new file mode 100644
index 0000000..abb0a6d
--- /dev/null
+++ b/Data/Time/RFC1123.hs
@@ -0,0 +1,52 @@
+module Data.Time.RFC1123
+    ( format
+    , parse
+    )
+    where
+
+import qualified Text.Parsec as P
+
+import Data.Time
+import Data.Time.Calendar.WeekDate
+import Data.Time.HTTP.Common
+import Data.Time.RFC1123.Parsec
+
+{-
+         The syntax for the date is hereby changed to:
+
+            date = 1*2DIGIT month 2*4DIGIT
+-}
+
+format :: ZonedTime -> String
+format zonedTime
+    = let localTime          = zonedTimeToLocalTime zonedTime
+          timeZone           = zonedTimeZone zonedTime
+          (year, month, day) = toGregorian (localDay localTime)
+          (_, _, week)       = toWeekDate  (localDay localTime)
+          timeOfDay          = localTimeOfDay localTime
+      in
+        concat [ shortWeekDayName week
+               , ", "
+               , show2 day
+               , " "
+               , shortMonthName month
+               , " "
+               , show4 year
+               , " "
+               , show2 (todHour timeOfDay)
+               , ":"
+               , show2 (todMin timeOfDay)
+               , ":"
+               , show2 (floor (todSec timeOfDay))
+               , " "
+               , show4digitsTZ timeZone
+               ]
+
+parse :: String -> Maybe ZonedTime
+parse src = case P.parse p "" src of
+              Right zt -> Just zt
+              Left  _  -> Nothing
+    where
+      p = do zt <- rfc1123DateAndTime
+             _  <- P.eof
+             return zt
diff --git a/Data/Time/RFC1123/Parsec.hs b/Data/Time/RFC1123/Parsec.hs
new file mode 100644
index 0000000..f2176cf
--- /dev/null
+++ b/Data/Time/RFC1123/Parsec.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE FlexibleContexts #-}
+module Data.Time.RFC1123.Parsec
+    ( rfc1123DateAndTime
+    )
+    where
+
+import Control.Monad
+import Data.Fixed
+import Data.Time
+import Data.Time.Calendar.WeekDate
+import Data.Time.HTTP.Common
+import Data.Time.RFC822.Parsec
+import Text.Parsec
+
+
+rfc1123DateAndTime :: Stream s m Char => ParsecT s u m ZonedTime
+rfc1123DateAndTime = dateTime
+
+dateTime :: Stream s m Char => ParsecT s u m ZonedTime
+dateTime = do weekDay <- optionMaybe $
+                         do w <- shortWeekDayNameP
+                            _ <- string ", "
+                            return w
+              gregDay <- date
+              case weekDay of
+                Nothing
+                    -> return () -- No day in week exists.
+                Just givenWD
+                    -> assertWeekDayIsGood givenWD gregDay
+              (tod, timeZone) <- rfc822time
+              let lt = LocalTime gregDay tod
+                  zt = ZonedTime lt timeZone
+              return zt
+
+date :: Stream s m Char => ParsecT s u m Day
+date = do day   <- read2
+          _     <- char ' '
+          month <- shortMonthNameP
+          _     <- char ' '
+          year  <- read4
+          _     <- char ' '
+          assertGregorianDateIsGood (toInteger year) month day
diff --git a/Data/Time/RFC733.hs b/Data/Time/RFC733.hs
index c7a1e6b..615ce2a 100644
--- a/Data/Time/RFC733.hs
+++ b/Data/Time/RFC733.hs
@@ -83,6 +83,6 @@ parse src = case P.parse p "" src of
               Right zt -> Just zt
               Left  _  -> Nothing
     where
-      p = do zt <- parser
+      p = do zt <- rfc733DateAndTime
              _  <- P.eof
              return zt
diff --git a/Data/Time/RFC733/Parsec.hs b/Data/Time/RFC733/Parsec.hs
index baf2469..996c94e 100644
--- a/Data/Time/RFC733/Parsec.hs
+++ b/Data/Time/RFC733/Parsec.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 module Data.Time.RFC733.Parsec
-    ( parser
+    ( rfc733DateAndTime
     )
     where
 
@@ -12,8 +12,8 @@ import Data.Time.HTTP.Common
 import Text.Parsec
 
 
-parser :: Stream s m Char => ParsecT s u m ZonedTime
-parser = dateTime
+rfc733DateAndTime :: Stream s m Char => ParsecT s u m ZonedTime
+rfc733DateAndTime = dateTime
 
 dateTime :: Stream s m Char => ParsecT s u m ZonedTime
 dateTime = do weekDay <- optionMaybe $
diff --git a/Data/Time/RFC822.hs b/Data/Time/RFC822.hs
index c31c244..8feeb76 100644
--- a/Data/Time/RFC822.hs
+++ b/Data/Time/RFC822.hs
@@ -74,6 +74,6 @@ parse src = case P.parse p "" src of
               Right zt -> Just zt
               Left  _  -> Nothing
     where
-      p = do zt <- parser
+      p = do zt <- rfc822DateAndTime
              _  <- P.eof
              return zt
diff --git a/Data/Time/RFC822/Parsec.hs b/Data/Time/RFC822/Parsec.hs
index 138b9a4..0c6762e 100644
--- a/Data/Time/RFC822/Parsec.hs
+++ b/Data/Time/RFC822/Parsec.hs
@@ -1,6 +1,9 @@
 {-# LANGUAGE FlexibleContexts #-}
 module Data.Time.RFC822.Parsec
-    ( parser
+    ( rfc822DateAndTime
+
+      -- private
+    , rfc822time
     )
     where
 
@@ -12,8 +15,8 @@ import Data.Time.HTTP.Common
 import Text.Parsec
 
 
-parser :: Stream s m Char => ParsecT s u m ZonedTime
-parser = dateTime
+rfc822DateAndTime :: Stream s m Char => ParsecT s u m ZonedTime
+rfc822DateAndTime = dateTime
 
 dateTime :: Stream s m Char => ParsecT s u m ZonedTime
 dateTime = do weekDay <- optionMaybe $
@@ -26,7 +29,7 @@ dateTime = do weekDay <- optionMaybe $
                     -> return () -- No day in week exists.
                 Just givenWD
                     -> assertWeekDayIsGood givenWD gregDay
-              (tod, timeZone) <- time
+              (tod, timeZone) <- rfc822time
               let lt = LocalTime gregDay tod
                   zt = ZonedTime lt timeZone
               return zt
@@ -40,11 +43,11 @@ date = do day   <- read2
           _     <- char ' '
           assertGregorianDateIsGood (toInteger year) month day
 
-time :: Stream s m Char => ParsecT s u m (TimeOfDay, TimeZone)
-time = do tod <- hour
-          _   <- char ' '
-          tz  <- zone
-          return (tod, tz)
+rfc822time :: Stream s m Char => ParsecT s u m (TimeOfDay, TimeZone)
+rfc822time = do tod <- hour
+                _   <- char ' '
+                tz  <- zone
+                return (tod, tz)
 
 hour :: Stream s m Char => ParsecT s u m TimeOfDay
 hour = do hour   <- read2
diff --git a/time-http.cabal b/time-http.cabal
index cfdc663..aeef0f6 100644
--- a/time-http.cabal
+++ b/time-http.cabal
@@ -21,10 +21,12 @@ Source-Repository head
 
 Library
     Exposed-modules:
-        Data.Time.RFC822
-        Data.Time.RFC822.Parsec
         Data.Time.RFC733
         Data.Time.RFC733.Parsec
+        Data.Time.RFC822
+        Data.Time.RFC822.Parsec
+        Data.Time.RFC1123
+        Data.Time.RFC1123.Parsec
 
     Other-modules:
         Data.Time.HTTP.Common