3 , MultiParamTypeClasses
8 -- |This module provides functions to parse and format RFC 733 date
9 -- and time strings (<http://tools.ietf.org/html/rfc733#appendix-E>).
11 -- The syntax is as follows:
13 -- > date-time ::= [ day-of-week ", " ] date SP time ("-" | SP) zone
14 -- > day-of-week ::= "Monday" | "Mon" | "Tuesday" | "Tue"
15 -- > | "Wednesday" | "Wed" | "Thursday" | "Thu"
16 -- > | "Friday" | "Fri" | "Saturday" | "Sat"
17 -- > | "Sunday" | "Sun"
18 -- > date ::= day ("-" | SP) month ("-" | SP) year
20 -- > year ::= 2DIGIT | 4DIGIT
21 -- > month ::= "January" | "Jan" | "February" | "Feb"
22 -- > | "March" | "Mar" | "April" | "Apr"
23 -- > | "May" | "June" | "Jun"
24 -- > | "July" | "Jul" | "August" | "Aug"
25 -- > | "September" | "Sep" | "October" | "Oct"
26 -- > | "November" | "Nov" | "December" | "Dec"
27 -- > time ::= hour [ ":" ] minute [ [ ":" ] second ]
29 -- > minute ::= 2DIGIT
30 -- > second ::= 2DIGIT
31 -- > zone ::= "GMT" ; Universal Time
32 -- > | "NST" ; Newfoundland: -3:30
33 -- > | "AST" | "ADT" ; Atlantic : -4 / -3
34 -- > | "EST" | "EDT" ; Eastern : -5 / -4
35 -- > | "CST" | "CDT" ; Central : -6 / -5
36 -- > | "MST" | "MDT" ; Mountain : -7 / -6
37 -- > | "PST" | "PDT" ; Pacific : -8 / -7
38 -- > | "YST" | "YDT" ; Yukon : -9 / -8
39 -- > | "HST" | "HDT" ; Haw/Ala : -10 / -9
40 -- > | "BST" | "BDT" ; Bering : -11 / -10
46 -- > | ("+" | "-") 4DIGIT ; Local diff: HHMM
47 module Data.Time.Format.RFC733
53 import Control.Applicative
54 import Data.Ascii (Ascii, AsciiBuilder)
55 import qualified Data.Ascii as A
56 import Data.Attoparsec.Char8
57 import Data.Convertible.Base
58 import Data.Monoid.Unicode
62 import Data.Time.Calendar.WeekDate
63 import Data.Time.Format.HTTP.Common
64 import Data.Time.Format.RFC822.Internal
65 import Prelude.Unicode
67 -- |The phantom type for conversions between RFC 733 date and time
68 -- strings and 'ZonedTime'.
70 -- >>> convertSuccess (ZonedTime (LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37)) utc)
71 -- Tagged "Sunday, 06-Nov-1994 08:49:37 GMT"
74 -- |The proxy for conversions between RFC 733 date and time strings
77 {-# INLINE CONLIKE rfc733 #-}
80 instance ConvertSuccess ZonedTime (Tagged RFC733 Ascii) where
81 {-# INLINE convertSuccess #-}
82 convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs
84 instance ConvertSuccess ZonedTime (Tagged RFC733 AsciiBuilder) where
85 {-# INLINE convertSuccess #-}
86 convertSuccess = Tagged ∘ toAsciiBuilder
88 instance ConvertAttempt (Tagged RFC733 Ascii) ZonedTime where
89 {-# INLINE convertAttempt #-}
90 convertAttempt = parseAttempt' rfc733DateAndTime ∘ untag
92 -- |Parse an RFC 733 date and time string.
93 rfc733DateAndTime ∷ Parser ZonedTime
94 rfc733DateAndTime = dateTime
96 dateTime ∷ Parser ZonedTime
97 dateTime = do weekDay ← optionMaybe $
98 do w ← longWeekDayNameP
108 → assertWeekDayIsGood givenWD gregDay
109 (tod, timeZone) ← time
110 let lt = LocalTime gregDay tod
111 zt = ZonedTime lt timeZone
115 date = do day ← read2
116 _ ← char '-' <|> char ' '
117 month ← try longMonthNameP
120 _ ← char '-' <|> char ' '
125 assertGregorianDateIsGood year month day
127 time ∷ Parser (TimeOfDay, TimeZone)
129 _ ← char '-' <|> char ' '
133 hms ∷ Parser TimeOfDay
134 hms = do hour ← read2
135 _ ← optional (char ':')
138 do _ ← optional (char ':')
140 assertTimeOfDayIsGood hour minute second
142 zone ∷ Parser TimeZone
143 zone = choice [ string "GMT" *> return (TimeZone 0 False "GMT")
145 *> choice [ string "ST" *> return (TimeZone ((-3) * 60 - 30) False "NST")
146 , return (TimeZone (1 * 60) False "N")
149 *> choice [ string "ST" *> return (TimeZone ((-4) * 60) False "AST")
150 , string "DT" *> return (TimeZone ((-3) * 60) False "AST")
151 , return (TimeZone ((-1) * 60) False "A")
154 *> choice [ string "ST" *> return (TimeZone ((-5) * 60) False "EST")
155 , string "DT" *> return (TimeZone ((-4) * 60) True "EDT")
158 *> choice [ string "ST" *> return (TimeZone ((-6) * 60) False "CST")
159 , string "DT" *> return (TimeZone ((-5) * 60) True "CDT")
162 *> choice [ string "ST" *> return (TimeZone ((-7) * 60) False "MST")
163 , string "DT" *> return (TimeZone ((-6) * 60) True "MDT")
164 , return (TimeZone ((-12) * 60) False "M")
167 *> choice [ string "ST" *> return (TimeZone ((-8) * 60) False "PST")
168 , string "DT" *> return (TimeZone ((-7) * 60) True "PDT")
171 *> choice [ string "ST" *> return (TimeZone ((-9) * 60) False "YST")
172 , string "DT" *> return (TimeZone ((-8) * 60) True "YDT")
173 , return (TimeZone ( 12 * 60) False "Y")
176 *> choice [ string "ST" *> return (TimeZone ((-10) * 60) False "HST")
177 , string "DT" *> return (TimeZone (( -9) * 60) True "HDT")
180 *> choice [ string "ST" *> return (TimeZone ((-11) * 60) False "BST")
181 , string "DT" *> return (TimeZone ((-10) * 60) True "BDT")
183 , char 'Z' *> return (TimeZone 0 False "Z")
187 toAsciiBuilder ∷ ZonedTime → AsciiBuilder
188 toAsciiBuilder zonedTime
189 = let localTime = zonedTimeToLocalTime zonedTime
190 timeZone = zonedTimeZone zonedTime
191 (year, month, day) = toGregorian (localDay localTime)
192 (_, _, week) = toWeekDate (localDay localTime)
193 timeOfDay = localTimeOfDay localTime
196 ⊕ A.toAsciiBuilder ", "
198 ⊕ A.toAsciiBuilder "-"
199 ⊕ shortMonthName month
200 ⊕ A.toAsciiBuilder "-"
202 ⊕ A.toAsciiBuilder " "
203 ⊕ show2 (todHour timeOfDay)
204 ⊕ A.toAsciiBuilder ":"
205 ⊕ show2 (todMin timeOfDay)
206 ⊕ A.toAsciiBuilder ":"
207 ⊕ show2 (floor (todSec timeOfDay) ∷ Int)
208 ⊕ A.toAsciiBuilder " "
209 ⊕ untag (cs timeZone ∷ Tagged RFC822 AsciiBuilder)
211 deriveAttempts [ ([t| ZonedTime |], [t| Tagged RFC733 Ascii |])
212 , ([t| ZonedTime |], [t| Tagged RFC733 AsciiBuilder |])