{-# 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