X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=time-http.git;a=blobdiff_plain;f=Data%2FTime%2FRFC733%2FInternal.hs;h=d1de6d864014437577cc95654705161be866d18e;hp=5002655afb2148499c2ff1a24310f9d55fb8c27c;hb=512f9a8;hpb=d39ace5728c981d8c9d83fe8eefcd811dbb1e8aa diff --git a/Data/Time/RFC733/Internal.hs b/Data/Time/RFC733/Internal.hs index 5002655..d1de6d8 100644 --- a/Data/Time/RFC733/Internal.hs +++ b/Data/Time/RFC733/Internal.hs @@ -1,105 +1,107 @@ -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE + OverloadedStrings + , UnicodeSyntax + #-} module Data.Time.RFC733.Internal ( rfc733DateAndTime ) where -import Control.Monad -import Data.Fixed +import Control.Applicative +import Data.Attoparsec.Char8 import Data.Time -import Data.Time.Calendar.WeekDate import Data.Time.HTTP.Common --- |This is a parsec parser for RFC 733 date and time strings. -rfc733DateAndTime :: Stream s m Char => ParsecT s u m ZonedTime +-- |Parse RFC 733 date and time strings. +rfc733DateAndTime ∷ Parser ZonedTime rfc733DateAndTime = dateTime -dateTime :: Stream s m Char => ParsecT s u m ZonedTime -dateTime = do weekDay <- optionMaybe $ - do w <- try longWeekDayNameP - <|> - shortWeekDayNameP - _ <- string ", " - return w - gregDay <- date +dateTime ∷ Parser ZonedTime +dateTime = do weekDay ← optionMaybe $ + do w ← longWeekDayNameP + <|> + shortWeekDayNameP + _ ← string ", " + return w + gregDay ← date case weekDay of Nothing - -> return () + → return () Just givenWD - -> assertWeekDayIsGood givenWD gregDay - (tod, timeZone) <- time + → assertWeekDayIsGood givenWD gregDay + (tod, timeZone) ← time 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 '-' <|> char ' ' - month <- try longMonthNameP - <|> - shortMonthNameP - _ <- char '-' <|> char ' ' - year <- try read4 - <|> - liftM (+ 1900) read2 - _ <- char ' ' +date ∷ Parser Day +date = do day ← read2 + _ ← char '-' <|> char ' ' + month ← try longMonthNameP + <|> + shortMonthNameP + _ ← char '-' <|> char ' ' + year ← try read4 + <|> + (+ 1900) <$> read2 + _ ← char ' ' assertGregorianDateIsGood year month day -time :: Stream s m Char => ParsecT s u m (TimeOfDay, TimeZone) -time = do tod <- hour - _ <- char '-' <|> char ' ' - tz <- zone +time ∷ Parser (TimeOfDay, TimeZone) +time = do tod ← hms + _ ← char '-' <|> char ' ' + tz ← zone return (tod, tz) -hour :: Stream s m Char => ParsecT s u m TimeOfDay -hour = do hour <- read2 - _ <- optional (char ':') - minute <- read2 - second <- option 0 $ - do _ <- optional (char ':') - read2 - assertTimeOfDayIsGood hour minute second +hms ∷ Parser TimeOfDay +hms = do hour ← read2 + _ ← optional (char ':') + minute ← read2 + second ← option 0 $ + do _ ← optional (char ':') + read2 + assertTimeOfDayIsGood hour minute second -zone :: Stream s m Char => ParsecT s u m TimeZone -zone = choice [ string "GMT" >> return (TimeZone 0 False "GMT") +zone ∷ Parser TimeZone +zone = choice [ string "GMT" *> return (TimeZone 0 False "GMT") , char 'N' - >> choice [ string "ST" >> return (TimeZone ((-3) * 60 - 30) False "NST") + *> choice [ string "ST" *> return (TimeZone ((-3) * 60 - 30) False "NST") , return (TimeZone (1 * 60) False "N") ] , char 'A' - >> choice [ string "ST" >> return (TimeZone ((-4) * 60) False "AST") - , string "DT" >> return (TimeZone ((-3) * 60) False "AST") + *> choice [ string "ST" *> return (TimeZone ((-4) * 60) False "AST") + , string "DT" *> return (TimeZone ((-3) * 60) False "AST") , return (TimeZone ((-1) * 60) False "A") ] , char 'E' - >> choice [ string "ST" >> return (TimeZone ((-5) * 60) False "EST") - , string "DT" >> return (TimeZone ((-4) * 60) True "EDT") + *> choice [ string "ST" *> return (TimeZone ((-5) * 60) False "EST") + , string "DT" *> return (TimeZone ((-4) * 60) True "EDT") ] , char 'C' - >> choice [ string "ST" >> return (TimeZone ((-6) * 60) False "CST") - , string "DT" >> return (TimeZone ((-5) * 60) True "CDT") + *> choice [ string "ST" *> return (TimeZone ((-6) * 60) False "CST") + , string "DT" *> return (TimeZone ((-5) * 60) True "CDT") ] , char 'M' - >> choice [ string "ST" >> return (TimeZone ((-7) * 60) False "MST") - , string "DT" >> return (TimeZone ((-6) * 60) True "MDT") + *> choice [ string "ST" *> return (TimeZone ((-7) * 60) False "MST") + , string "DT" *> return (TimeZone ((-6) * 60) True "MDT") , return (TimeZone ((-12) * 60) False "M") ] , char 'P' - >> choice [ string "ST" >> return (TimeZone ((-8) * 60) False "PST") - , string "DT" >> return (TimeZone ((-7) * 60) True "PDT") + *> choice [ string "ST" *> return (TimeZone ((-8) * 60) False "PST") + , string "DT" *> return (TimeZone ((-7) * 60) True "PDT") ] , char 'Y' - >> choice [ string "ST" >> return (TimeZone ((-9) * 60) False "YST") - , string "DT" >> return (TimeZone ((-8) * 60) True "YDT") + *> choice [ string "ST" *> return (TimeZone ((-9) * 60) False "YST") + , string "DT" *> return (TimeZone ((-8) * 60) True "YDT") , return (TimeZone ( 12 * 60) False "Y") ] , char 'H' - >> choice [ string "ST" >> return (TimeZone ((-10) * 60) False "HST") - , string "DT" >> return (TimeZone (( -9) * 60) True "HDT") + *> choice [ string "ST" *> return (TimeZone ((-10) * 60) False "HST") + , string "DT" *> return (TimeZone (( -9) * 60) True "HDT") ] , char 'B' - >> choice [ string "ST" >> return (TimeZone ((-11) * 60) False "BST") - , string "DT" >> return (TimeZone ((-10) * 60) True "BDT") + *> choice [ string "ST" *> return (TimeZone ((-11) * 60) False "BST") + , string "DT" *> return (TimeZone ((-10) * 60) True "BDT") ] - , char 'Z' >> return (TimeZone 0 False "Z") + , char 'Z' *> return (TimeZone 0 False "Z") , read4digitsTZ ]