X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=time-http.git;a=blobdiff_plain;f=Data%2FTime%2FRFC733.hs;h=6234c1b50b8fb9848123ccd602a6a1814de22ffc;hp=615ce2a43781c2cfccedee3a71aa8bd4ef979f8d;hb=4e2898d9c40d6e962a33d5d05a3aa80c10c312fc;hpb=269a28dfe8b08af854f7217bbe9c141c9c18f1ec diff --git a/Data/Time/RFC733.hs b/Data/Time/RFC733.hs index 615ce2a..6234c1b 100644 --- a/Data/Time/RFC733.hs +++ b/Data/Time/RFC733.hs @@ -1,88 +1,71 @@ +{-# LANGUAGE + UnicodeSyntax + #-} +-- |This module provides functions to parse and format RFC 733 date +-- and time formats. +-- +-- The syntax is as follows: +-- +-- > date-time ::= [ day-of-week ", " ] date SP time ("-" | SP) zone +-- > day-of-week ::= "Monday" | "Mon" | "Tuesday" | "Tue" +-- > | "Wednesday" | "Wed" | "Thursday" | "Thu" +-- > | "Friday" | "Fri" | "Saturday" | "Sat" +-- > | "Sunday" | "Sun" +-- > date ::= day ("-" | SP) month ("-" | SP) year +-- > day ::= 2DIGIT +-- > year ::= 2DIGIT | 4DIGIT +-- > month ::= "January" | "Jan" | "February" | "Feb" +-- > | "March" | "Mar" | "April" | "Apr" +-- > | "May" | "June" | "Jun" +-- > | "July" | "Jul" | "August" | "Aug" +-- > | "September" | "Sep" | "October" | "Oct" +-- > | "November" | "Nov" | "December" | "Dec" +-- > time ::= hour [ ":" ] minute [ [ ":" ] second ] +-- > hour ::= 2DIGIT +-- > minute ::= 2DIGIT +-- > second ::= 2DIGIT +-- > zone ::= "GMT" ; Universal Time +-- > | "NST" ; Newfoundland: -3:30 +-- > | "AST" | "ADT" ; Atlantic : -4 / -3 +-- > | "EST" | "EDT" ; Eastern : -5 / -4 +-- > | "CST" | "CDT" ; Central : -6 / -5 +-- > | "MST" | "MDT" ; Mountain : -7 / -6 +-- > | "PST" | "PDT" ; Pacific : -8 / -7 +-- > | "YST" | "YDT" ; Yukon : -9 / -8 +-- > | "HST" | "HDT" ; Haw/Ala : -10 / -9 +-- > | "BST" | "BDT" ; Bering : -11 / -10 +-- > | "Z" ; GMT +-- > | "A" ; -1 +-- > | "M" ; -12 +-- > | "N" ; +1 +-- > | "Y" ; +12 +-- > | ("+" | "-") 4DIGIT ; Local diff: HHMM module Data.Time.RFC733 - ( format - , parse + ( -- * Formatting + toAscii + , toAsciiBuilder + + -- * Parsing + , fromAscii + , rfc733DateAndTime ) where - -import qualified Text.Parsec as P - +import Data.Ascii (Ascii) +import qualified Data.Ascii as A +import qualified Data.Attoparsec.Char8 as P import Data.Time -import Data.Time.Calendar.WeekDate -import Data.Time.HTTP.Common -import Data.Time.RFC733.Parsec - -{- -date-time = [ day-of-week "," ] date time - -day-of-week = "Monday" / "Mon" / "Tuesday" / "Tue" - / "Wednesday" / "Wed" / "Thursday" / "Thu" - / "Friday" / "Fri" / "Saturday" / "Sat" - / "Sunday" / "Sun" - -date = 1*2DIGIT ["-"] month ; day month year - ["-"] (2DIGIT /4DIGIT) ; e.g. 20 Aug [19]77 - -month = "January" / "Jan" / "February" / "Feb" - / "March" / "Mar" / "April" / "Apr" - / "May" / "June" / "Jun" - / "July" / "Jul" / "August" / "Aug" - / "September" / "Sep" / "October" / "Oct" - / "November" / "Nov" / "December" / "Dec" - -time = hour zone ; ANSI and Military - ; (seconds optional) - -hour = 2DIGIT [":"] 2DIGIT [ [":"] 2DIGIT ] - ; 0000[00] - 2359[59] - -zone = ( ["-"] ( "GMT" ; Relative to GMT: - ; North American - / "NST" / ; Newfoundland:-3:30 - / "AST" / "ADT" ; Atlantic: - 4/ - 3 - / "EST" / "EDT" ; Eastern: - 5/ - 4 - / "CST" / "CDT" ; Central: - 6/ - 5 - / "MST" / "MDT" ; Mountain: - 7/ - 6 - / "PST" / "PDT" ; Pacific: - 8/ - 7 - / "YST" / "YDT" ; Yukon: - 9/ - 8 - / "HST" / "HDT" ; Haw/Ala -10/ - 9 - / "BST" / "BDT" ; Bering: -11/ -10 - 1ALPHA )) ; Military: Z = GMT; - ; A:-1; (J not used) - ; M:-12; N:+1; Y:+12 - / ( ("+" / "-") 4DIGIT ) ; Local differential - ; hours/min. (HHMM) --} +import Data.Time.RFC733.Internal +import Prelude.Unicode -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 [ longWeekDayName week - , ", " - , show2 day - , "-" - , shortMonthName month - , "-" - , show4 year - , " " - , show2 (todHour timeOfDay) - , ":" - , show2 (todMin timeOfDay) - , ":" - , show2 (floor (todSec timeOfDay)) - , " " - , show4digitsTZ timeZone - ] +-- |Convert a 'ZonedTime' to RFC 733 date and time string. +toAscii ∷ ZonedTime → Ascii +toAscii = A.fromAsciiBuilder ∘ toAsciiBuilder -parse :: String -> Maybe ZonedTime -parse src = case P.parse p "" src of - Right zt -> Just zt - Left _ -> Nothing +-- |Parse an RFC 733 date and time string. When the string can't be +-- parsed, it returns @'Left' err@. +fromAscii ∷ Ascii → Either String ZonedTime +fromAscii = P.parseOnly p ∘ A.toByteString where - p = do zt <- rfc733DateAndTime - _ <- P.eof + p = do zt ← rfc733DateAndTime + P.endOfInput return zt