module Data.Time.Format.RFC822.Internal
( RFC822
, rfc822DateAndTime
, rfc822Time
)
where
import Control.Applicative
import Data.Ascii (Ascii, AsciiBuilder)
import qualified Data.Ascii as A
import Data.Attoparsec.Char8
import Data.Convertible.Base
import Data.Monoid.Unicode
import Data.Tagged
import Data.Time
import Data.Time.Calendar.WeekDate
import Data.Time.Format.HTTP.Common
import Prelude.Unicode
data RFC822
instance ConvertSuccess ZonedTime (Tagged RFC822 Ascii) where
convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs
instance ConvertSuccess ZonedTime (Tagged RFC822 AsciiBuilder) where
convertSuccess = Tagged ∘ toAsciiBuilder
instance ConvertSuccess TimeZone (Tagged RFC822 Ascii) where
convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs
instance ConvertSuccess TimeZone (Tagged RFC822 AsciiBuilder) where
convertSuccess tz
| timeZoneMinutes tz ≡ 0 = Tagged $ A.toAsciiBuilder "GMT"
| otherwise = Tagged $ show4digitsTZ tz
instance ConvertAttempt (Tagged RFC822 Ascii) ZonedTime where
convertAttempt = parseAttempt' rfc822DateAndTime ∘ untag
rfc822DateAndTime ∷ Parser ZonedTime
rfc822DateAndTime = dateTime
dateTime ∷ Parser ZonedTime
dateTime = do weekDay ← optionMaybe $
do w ← shortWeekDayNameP
_ ← string ", "
return w
gregDay ← date
case weekDay of
Nothing
-> return ()
Just givenWD
-> assertWeekDayIsGood givenWD gregDay
(tod, timeZone) ← rfc822Time
let lt = LocalTime gregDay tod
zt = ZonedTime lt timeZone
return zt
date ∷ Parser Day
date = do day ← read2
_ ← char ' '
month ← shortMonthNameP
_ ← char ' '
year ← (+ 1900) <$> read2
_ ← char ' '
assertGregorianDateIsGood year month day
rfc822Time ∷ Parser (TimeOfDay, TimeZone)
rfc822Time = do tod ← hms
_ ← char ' '
tz ← zone
return (tod, tz)
hms ∷ Parser TimeOfDay
hms = do hour ← read2
minute ← char ':' *> read2
second ← option 0 (char ':' *> read2)
assertTimeOfDayIsGood hour minute second
zone ∷ Parser TimeZone
zone = choice [ string "UT" *> return (TimeZone 0 False "UT" )
, string "GMT" *> return (TimeZone 0 False "GMT")
, char 'E'
*> 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")
]
, char 'M'
*> 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")
]
, char 'Z' *> return (TimeZone 0 False "Z")
, char 'A' *> return (TimeZone ((1) * 60) False "A")
, char 'N' *> return (TimeZone ( 1 * 60) False "N")
, char 'Y' *> return (TimeZone ( 12 * 60) False "Y")
, read4digitsTZ
]
toAsciiBuilder ∷ ZonedTime → AsciiBuilder
toAsciiBuilder zonedTime
= let localTime = zonedTimeToLocalTime zonedTime
timeZone = zonedTimeZone zonedTime
(year, month, day) = toGregorian (localDay localTime)
(_, _, week) = toWeekDate (localDay localTime)
timeOfDay = localTimeOfDay localTime
in
shortWeekDayName week
⊕ A.toAsciiBuilder ", "
⊕ show2 day
⊕ A.toAsciiBuilder " "
⊕ shortMonthName month
⊕ A.toAsciiBuilder " "
⊕ show2 (year `mod` 100)
⊕ A.toAsciiBuilder " "
⊕ show2 (todHour timeOfDay)
⊕ A.toAsciiBuilder ":"
⊕ show2 (todMin timeOfDay)
⊕ A.toAsciiBuilder ":"
⊕ show2 (floor (todSec timeOfDay) ∷ Int)
⊕ A.toAsciiBuilder " "
⊕ untag (cs timeZone ∷ Tagged RFC822 AsciiBuilder)
deriveAttempts [ ([t| ZonedTime |], [t| Tagged RFC822 Ascii |])
, ([t| ZonedTime |], [t| Tagged RFC822 AsciiBuilder |])
, ([t| TimeZone |], [t| Tagged RFC822 Ascii |])
, ([t| TimeZone |], [t| Tagged RFC822 AsciiBuilder |])
]