Asctime

[time-http.git] / Data / Time / RFC822 / Parsec.hs

diff --git a/Data/Time/RFC822/Parsec.hs b/Data/Time/RFC822/Parsec.hs
index f80633efb5fbd60987f14fc097252d0671fb1795..5d73ca8907a9406d4399b840699cdae1ec1d902f 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
-    ( parser
+    ( rfc822DateAndTime
+
+      -- private
+    , rfc822time
     )
     where
 
@@ -12,9 +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,32 +28,11 @@ dateTime = do weekDay <- optionMaybe $
                 Nothing
                     -> return () -- No day in week exists.
                 Just givenWD
-                    -> let (_, _, correctWD) = toWeekDate gregDay
-                       in
-                         if correctWD == givenWD then
-                             return () -- Correct day in the week.
-                         else
-                             let (year, month, day) = toGregorian gregDay
-                             in
-                               fail $ concat [ "Gregorian day "
-                                             , show year
-                                             , "-"
-                                             , show month
-                                             , "-"
-                                             , show day
-                                             , " is "
-                                             , longWeekDayName correctWD
-                                             , ", not "
-                                             , longWeekDayName givenWD
-                                             ]
-              (tod, timeZone) <- time
-              return ZonedTime {
-                           zonedTimeToLocalTime = LocalTime {
-                                                    localDay       = gregDay
-                                                  , localTimeOfDay = tod
-                                                  }
-                         , zonedTimeZone        = timeZone
-                         }
+                    -> 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
@@ -60,40 +41,19 @@ date = do day   <- read2
           _     <- char ' '
           year  <- liftM (+ 1900) read2
           _     <- char ' '
+          assertGregorianDateIsGood year month day
 
-          case fromGregorianValid (toInteger year) month day of
-            Nothing
-                -> fail $ concat [ "Invalid gregorian day: "
-                                 , show year
-                                 , "-"
-                                 , show month
-                                 , "-"
-                                 , show day
-                                 ]
-            Just gregDay
-                -> return gregDay
-
-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
           minute <- char ':' >> read2
           second <- option 0 (char ':' >> read2)
-          case makeTimeOfDayValid hour minute second of
-            Nothing
-                -> fail $ concat [ "Invalid time of day: "
-                                 , show hour
-                                 , ":"
-                                 , show minute
-                                 , ":"
-                                 , showFixed True second
-                                 ]
-            Just tod
-                -> return tod
+          assertTimeOfDayIsGood hour minute second
 
 zone :: Stream s m Char => ParsecT s u m TimeZone
 zone = choice [ string "UT"  >> return (TimeZone 0 False "UT" )
@@ -119,15 +79,5 @@ zone = choice [ string "UT"  >> return (TimeZone 0 False "UT" )
               , char 'A' >> return (TimeZone ((-1) * 60) False "A")
               , char 'N' >> return (TimeZone (  1  * 60) False "N")
               , char 'Y' >> return (TimeZone ( 12  * 60) False "Y")
-              , do sign   <- (char '+' >> return 1)
-                             <|>
-                             (char '-' >> return (-1))
-                   hour   <- read2
-                   minute <- read2
-                   let tz = TimeZone {
-                              timeZoneMinutes    = (sign * (hour * 60 + minute))
-                            , timeZoneSummerOnly = False
-                            , timeZoneName       = timeZoneOffsetString tz
-                            }
-                   return tz
+              , read4digitsTZ
               ]