RFC1123

diff --git a/Data/Time/RFC1123.hs b/Data/Time/RFC1123.hs
new file mode 100644 (file)
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 (file)
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 c7a1e6b4e879281ba31ba1dcfad4e06c353e1103..615ce2a43781c2cfccedee3a71aa8bd4ef979f8d 100644 (file)
--- 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
               Right zt -> Just zt
               Left  _  -> Nothing
     where

-      p = do zt <- parser
+      p = do zt <- rfc733DateAndTime

              _  <- P.eof
              return zt
              _  <- P.eof
              return zt

diff --git a/Data/Time/RFC733/Parsec.hs b/Data/Time/RFC733/Parsec.hs
index baf24691047965c05eb9dfd93ebc6967931b795c..996c94e51ee803fcbafaa56258b5192a6e140b9f 100644 (file)
--- a/Data/Time/RFC733/Parsec.hs
+++ b/Data/Time/RFC733/Parsec.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 module Data.Time.RFC733.Parsec
 {-# LANGUAGE FlexibleContexts #-}
 module Data.Time.RFC733.Parsec

-    ( parser
+    ( rfc733DateAndTime

     )
     where
 
     )
     where
 


@@ -12,8 +12,8 @@ import Data.Time.HTTP.Common
 import Text.Parsec
 
 
 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 $
 
 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 c31c2448de6c2914938daa1c5ea1ed436938271c..8feeb764e1b2c0b6ed05c1178436061240caeeb1 100644 (file)
--- 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
               Right zt -> Just zt
               Left  _  -> Nothing
     where

-      p = do zt <- parser
+      p = do zt <- rfc822DateAndTime

              _  <- P.eof
              return zt
              _  <- P.eof
              return zt

diff --git a/Data/Time/RFC822/Parsec.hs b/Data/Time/RFC822/Parsec.hs
index 138b9a4390232f5aadf53af2baf8c923b749c31f..0c6762e6a679fee91368e20dca4996d4ca1ac2f2 100644 (file)
--- a/Data/Time/RFC822/Parsec.hs
+++ b/Data/Time/RFC822/Parsec.hs
@@ -1,6 +1,9 @@
 {-# LANGUAGE FlexibleContexts #-}
 module Data.Time.RFC822.Parsec
 {-# LANGUAGE FlexibleContexts #-}
 module Data.Time.RFC822.Parsec

-    ( parser
+    ( rfc822DateAndTime
+
+      -- private
+    , rfc822time

     )
     where
 
     )
     where
 


@@ -12,8 +15,8 @@ import Data.Time.HTTP.Common
 import Text.Parsec
 
 
 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 $
 
 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
                     -> 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
               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
 
           _     <- 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
 
 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 cfdc663a1bd485079e378ff34613494ecda3fa91..aeef0f6f88a521e600af42087d07a9bcec072563 100644 (file)
--- a/time-http.cabal
+++ b/time-http.cabal
@@ -21,10 +21,12 @@ Source-Repository head
 
 Library
     Exposed-modules:
 
 Library
     Exposed-modules:

-        Data.Time.RFC822
-        Data.Time.RFC822.Parsec

         Data.Time.RFC733
         Data.Time.RFC733.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
 
     Other-modules:
         Data.Time.HTTP.Common