Data/Time/HTTP/Common.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 module Data.Time.HTTP.Common
   3     ( shortWeekDayName
   4     , shortWeekDayNameP
   5
   6     , longWeekDayName
   7     , longWeekDayNameP
   8
   9     , shortMonthName
  10     , shortMonthNameP
  11
  12     , show2
  13     , show4
  14
  15     , read2
  16     , read4
  17     )
  18     where
  19
  20 import Control.Monad
  21 import Text.Parsec
  22
  23 shortWeekDayName :: Int -> String
  24 shortWeekDayName 1 = "Mon"
  25 shortWeekDayName 2 = "Tue"
  26 shortWeekDayName 3 = "Wed"
  27 shortWeekDayName 4 = "Thu"
  28 shortWeekDayName 5 = "Fri"
  29 shortWeekDayName 6 = "Sat"
  30 shortWeekDayName 7 = "Sun"
  31 shortWeekDayName n = error ("shortWeekDayName: unknown day number: " ++ show n)
  32
  33 shortWeekDayNameP :: Stream s m Char => ParsecT s u m Int
  34 shortWeekDayNameP
  35     = choice [ string "Mon" >> return 1
  36              , char 'T'
  37                >> choice [ string "ue" >> return 2
  38                          , string "hu" >> return 4
  39                          ]
  40              , string "Wed" >> return 3
  41              , string "Fri" >> return 5
  42              , char 'S'
  43                >> choice [ string "at" >> return 6
  44                          , string "un" >> return 7
  45                          ]
  46              ]
  47
  48 longWeekDayName :: Int -> String
  49 longWeekDayName 1 = "Monday"
  50 longWeekDayName 2 = "Tuesday"
  51 longWeekDayName 3 = "Wednesday"
  52 longWeekDayName 4 = "Thursday"
  53 longWeekDayName 5 = "Friday"
  54 longWeekDayName 6 = "Saturday"
  55 longWeekDayName 7 = "Sunday"
  56
  57 longWeekDayNameP :: Stream s m Char => ParsecT s u m Int
  58 longWeekDayNameP
  59     = choice [ string "Monday" >> return 1
  60              , char 'T'
  61                >> choice [ string "uesday"  >> return 2
  62                          , string "hursday" >> return 4
  63                          ]
  64              , string "Wednesday" >> return 3
  65              , string "Friday"    >> return 5
  66              , char 'S'
  67                >> choice [ string "aturday" >> return 6
  68                          , string "unday"   >> return 7
  69                          ]
  70              ]
  71
  72 shortMonthName :: Int -> String
  73 shortMonthName  1 = "Jan"
  74 shortMonthName  2 = "Feb"
  75 shortMonthName  3 = "Mar"
  76 shortMonthName  4 = "Apr"
  77 shortMonthName  5 = "May"
  78 shortMonthName  6 = "Jun"
  79 shortMonthName  7 = "Jul"
  80 shortMonthName  8 = "Aug"
  81 shortMonthName  9 = "Sep"
  82 shortMonthName 10 = "Oct"
  83 shortMonthName 11 = "Nov"
  84 shortMonthName 12 = "Dec"
  85 shortMonthName  n = error ("shortMonthName: unknown month number: " ++ show n)
  86
  87 shortMonthNameP :: Stream s m Char => ParsecT s u m Int
  88 shortMonthNameP
  89     = choice [ char 'J'
  90                >> choice [ string "an" >> return 1
  91                          , char 'u'
  92                            >> choice [ char 'n' >> return 6
  93                                      , char 'l' >> return 7
  94                                      ]
  95                          ]
  96              , string "Feb" >> return 2
  97              , string "Ma"
  98                >> choice [ char 'r' >> return 3
  99                          , char 'y' >> return 5
 100                          ]
 101              , char 'A'
 102                >> choice [ string "pr" >> return 4
 103                          , string "ug" >> return 8
 104                          ]
 105              , string "Sep" >> return 9
 106              , string "Oct" >> return 10
 107              , string "Nov" >> return 11
 108              , string "Dec" >> return 12
 109              ]
 110
 111 show4 :: Integral i => i -> String
 112 show4 i
 113     | i >= 0 && i < 10    = "000" ++ show i
 114     | i >= 0 && i < 100   = "00"  ++ show i
 115     | i >= 0 && i < 1000  = "0"   ++ show i
 116     | i >= 0 && i < 10000 = show i
 117     | otherwise          = error ("show4: the integer i must satisfy 0 <= i < 10000: " ++ show i)
 118
 119 show2 :: Integral i => i -> String
 120 show2 i
 121     | i >= 0 && i < 10  = "0" ++ show i
 122     | i >= 0 && i < 100 = show i
 123     | otherwise         = error ("show2: the integer i must satisfy 0 <= i < 100: " ++ show i)
 124
 125 read4 :: (Stream s m Char, Num n) => ParsecT s u m n
 126 read4 = do n1 <- digit'
 127            n2 <- digit'
 128            n3 <- digit'
 129            n4 <- digit'
 130            return (n1 * 1000 + n2 * 100 + n3 * 10 + n4)
 131
 132 read2 :: (Stream s m Char, Num n) => ParsecT s u m n
 133 read2 = do n1 <- digit'
 134            n2 <- digit'
 135            return (n1 * 10 + n2)
 136
 137 digit' :: (Stream s m Char, Num n) => ParsecT s u m n
 138 digit' = liftM fromC digit
 139
 140 fromC :: Num n => Char -> n
 141 fromC '0' = 0
 142 fromC '1' = 1
 143 fromC '2' = 2
 144 fromC '3' = 3
 145 fromC '4' = 4
 146 fromC '5' = 5
 147 fromC '6' = 6
 148 fromC '7' = 7
 149 fromC '8' = 8
 150 fromC '9' = 9
 151 fromC _   = undefined