module Network.HTTP.Lucu.RFC1123DateTime
( formatRFC1123DateTime
, formatHTTPDateTime
, parseHTTPDateTime
)
where
import Control.Monad
import Data.Time
import Data.Time.Calendar.WeekDate
import qualified Data.ByteString.Lazy as Lazy (ByteString)
import Network.HTTP.Lucu.Format
import Network.HTTP.Lucu.Parser
import Prelude hiding (min)
monthStr :: [String]
monthStr = ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"]
weekStr :: [String]
weekStr = ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"]
formatRFC1123DateTime :: ZonedTime -> String
formatRFC1123DateTime zonedTime
= let localTime = zonedTimeToLocalTime zonedTime
timeZone = zonedTimeZone zonedTime
(year, month, day) = toGregorian (localDay localTime)
(_, _, week) = toWeekDate (localDay localTime)
timeOfDay = localTimeOfDay localTime
in
id (weekStr !! (week 1))
++ ", " ++
fmtDec 2 day
++ " " ++
id (monthStr !! (month 1))
++ " " ++
fmtDec 4 (fromInteger year)
++ " " ++
fmtDec 2 (todHour timeOfDay)
++ ":" ++
fmtDec 2 (todMin timeOfDay)
++ ":" ++
fmtDec 2 (floor (todSec timeOfDay))
++ " " ++
id (timeZoneName timeZone)
formatHTTPDateTime :: UTCTime -> String
formatHTTPDateTime utcTime
= let timeZone = TimeZone 0 False "GMT"
zonedTime = utcToZonedTime timeZone utcTime
in
formatRFC1123DateTime zonedTime
parseHTTPDateTime :: Lazy.ByteString -> Maybe UTCTime
parseHTTPDateTime src
= case parse httpDateTime src of
(# Success ct, _ #) -> Just ct
(# _ , _ #) -> Nothing
httpDateTime :: Parser UTCTime
httpDateTime = do foldl (<|>) failP (map string weekStr)
char ','
char ' '
day <- liftM read (count 2 digit)
char ' '
mon <- foldl (<|>) failP (map tryEqToFst (zip monthStr [1..]))
char ' '
year <- liftM read (count 4 digit)
char ' '
hour <- liftM read (count 2 digit)
char ':'
min <- liftM read (count 2 digit)
char ':'
sec <- liftM read (count 2 digit) :: Parser Int
char ' '
string "GMT"
eof
let julianDay = fromGregorian year mon day
timeOfDay = TimeOfDay hour min (fromIntegral sec)
utcTime = UTCTime julianDay (timeOfDayToTime timeOfDay)
return utcTime
where
tryEqToFst :: (String, a) -> Parser a
tryEqToFst (str, a) = string str >> return a