X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Data%2FTime%2FHTTP%2FCommon.hs;fp=Data%2FTime%2FHTTP%2FCommon.hs;h=1ea61de90bc2a21cc0e85a5d41fe63225d188a34;hb=9f9ed0471883b50fec1b091621f332d62477a34c;hp=0000000000000000000000000000000000000000;hpb=746e89579242035ff05ceec12dd151b4b9931a5f;p=time-http.git diff --git a/Data/Time/HTTP/Common.hs b/Data/Time/HTTP/Common.hs new file mode 100644 index 0000000..1ea61de --- /dev/null +++ b/Data/Time/HTTP/Common.hs @@ -0,0 +1,151 @@ +{-# LANGUAGE FlexibleContexts #-} +module Data.Time.HTTP.Common + ( shortWeekDayName + , shortWeekDayNameP + + , longWeekDayName + , longWeekDayNameP + + , shortMonthName + , shortMonthNameP + + , show2 + , show4 + + , read2 + , read4 + ) + where + +import Control.Monad +import Text.Parsec + +shortWeekDayName :: Int -> String +shortWeekDayName 1 = "Mon" +shortWeekDayName 2 = "Tue" +shortWeekDayName 3 = "Wed" +shortWeekDayName 4 = "Thu" +shortWeekDayName 5 = "Fri" +shortWeekDayName 6 = "Sat" +shortWeekDayName 7 = "Sun" +shortWeekDayName n = error ("shortWeekDayName: unknown day number: " ++ show n) + +shortWeekDayNameP :: Stream s m Char => ParsecT s u m Int +shortWeekDayNameP + = choice [ string "Mon" >> return 1 + , char 'T' + >> choice [ string "ue" >> return 2 + , string "hu" >> return 4 + ] + , string "Wed" >> return 3 + , string "Fri" >> return 5 + , char 'S' + >> choice [ string "at" >> return 6 + , string "un" >> return 7 + ] + ] + +longWeekDayName :: Int -> String +longWeekDayName 1 = "Monday" +longWeekDayName 2 = "Tuesday" +longWeekDayName 3 = "Wednesday" +longWeekDayName 4 = "Thursday" +longWeekDayName 5 = "Friday" +longWeekDayName 6 = "Saturday" +longWeekDayName 7 = "Sunday" + +longWeekDayNameP :: Stream s m Char => ParsecT s u m Int +longWeekDayNameP + = choice [ string "Monday" >> return 1 + , char 'T' + >> choice [ string "uesday" >> return 2 + , string "hursday" >> return 4 + ] + , string "Wednesday" >> return 3 + , string "Friday" >> return 5 + , char 'S' + >> choice [ string "aturday" >> return 6 + , string "unday" >> return 7 + ] + ] + +shortMonthName :: Int -> String +shortMonthName 1 = "Jan" +shortMonthName 2 = "Feb" +shortMonthName 3 = "Mar" +shortMonthName 4 = "Apr" +shortMonthName 5 = "May" +shortMonthName 6 = "Jun" +shortMonthName 7 = "Jul" +shortMonthName 8 = "Aug" +shortMonthName 9 = "Sep" +shortMonthName 10 = "Oct" +shortMonthName 11 = "Nov" +shortMonthName 12 = "Dec" +shortMonthName n = error ("shortMonthName: unknown month number: " ++ show n) + +shortMonthNameP :: Stream s m Char => ParsecT s u m Int +shortMonthNameP + = choice [ char 'J' + >> choice [ string "an" >> return 1 + , char 'u' + >> choice [ char 'n' >> return 6 + , char 'l' >> return 7 + ] + ] + , string "Feb" >> return 2 + , string "Ma" + >> choice [ char 'r' >> return 3 + , char 'y' >> return 5 + ] + , char 'A' + >> choice [ string "pr" >> return 4 + , string "ug" >> return 8 + ] + , string "Sep" >> return 9 + , string "Oct" >> return 10 + , string "Nov" >> return 11 + , string "Dec" >> return 12 + ] + +show4 :: Integral i => i -> String +show4 i + | i >= 0 && i < 10 = "000" ++ show i + | i >= 0 && i < 100 = "00" ++ show i + | i >= 0 && i < 1000 = "0" ++ show i + | i >= 0 && i < 10000 = show i + | otherwise = error ("show4: the integer i must satisfy 0 <= i < 10000: " ++ show i) + +show2 :: Integral i => i -> String +show2 i + | i >= 0 && i < 10 = "0" ++ show i + | i >= 0 && i < 100 = show i + | otherwise = error ("show2: the integer i must satisfy 0 <= i < 100: " ++ show i) + +read4 :: (Stream s m Char, Num n) => ParsecT s u m n +read4 = do n1 <- digit' + n2 <- digit' + n3 <- digit' + n4 <- digit' + return (n1 * 1000 + n2 * 100 + n3 * 10 + n4) + +read2 :: (Stream s m Char, Num n) => ParsecT s u m n +read2 = do n1 <- digit' + n2 <- digit' + return (n1 * 10 + n2) + +digit' :: (Stream s m Char, Num n) => ParsecT s u m n +digit' = liftM fromC digit + +fromC :: Num n => Char -> n +fromC '0' = 0 +fromC '1' = 1 +fromC '2' = 2 +fromC '3' = 3 +fromC '4' = 4 +fromC '5' = 5 +fromC '6' = 6 +fromC '7' = 7 +fromC '8' = 8 +fromC '9' = 9 +fromC _ = undefined