]> gitweb @ CieloNegro.org - time-http.git/blob - Data/Time/HTTP/Common.hs
Data.Time.RFC822 now fully works
[time-http.git] / 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