]> gitweb.michael.orlitzky.com - dead/htsn-import.git/blob - Picklers.hs
dc3ed9a05cb452fbba1ad884593fc5ace02967c9
[dead/htsn-import.git] / Picklers.hs
1 -- | (Un)picklers for data types present in The Sports Network XML
2 -- feed.
3 --
4 module TSN.Picklers (
5 xp_date,
6 xp_date_padded,
7 xp_gamedate,
8 xp_racedate,
9 xp_tba_time,
10 xp_time,
11 xp_time_stamp )
12 where
13
14 -- System imports.
15 import Data.Time.Clock ( NominalDiffTime, UTCTime, addUTCTime )
16 import Data.Time.Format ( formatTime, parseTime )
17 import System.Locale ( defaultTimeLocale )
18 import Text.XML.HXT.Arrow.Pickle (
19 xpText,
20 xpWrap,
21 xpWrapMaybe )
22 import Text.XML.HXT.Arrow.Pickle.Xml ( PU )
23
24 -- Local imports.
25 import TSN.Parse (
26 parse_time_stamp,
27 time_format,
28 time_stamp_format )
29
30
31 -- | The format string for a base date in m/d/yyyy format. The
32 -- day/month are not padded at all. This will match for example,
33 --
34 -- * 2/15/1983
35 -- * 1/1/0000
36 --
37 date_format :: String
38 date_format = "%-m/%-d/%Y"
39
40
41 -- | The format string for a base date in mm/dd/yyyy format. The
42 -- day/month are padded to two characters with zeros. This will
43 -- match for example,
44 --
45 -- * 02/15/1983
46 -- * 01/01/0000
47 --
48 date_format_padded :: String
49 date_format_padded = "%0m/%0d/%Y"
50
51
52 -- | (Un)pickle a UTCTime without the time portion.
53 --
54 xp_date :: PU UTCTime
55 xp_date =
56 (to_date, from_date) `xpWrapMaybe` xpText
57 where
58 to_date :: String -> Maybe UTCTime
59 to_date = parseTime defaultTimeLocale date_format
60
61 from_date :: UTCTime -> String
62 from_date = formatTime defaultTimeLocale date_format
63
64
65 -- | (Un)pickle a UTCTime without the time portion. The day/month are
66 -- padded to two characters with zeros.
67 --
68 xp_date_padded :: PU UTCTime
69 xp_date_padded =
70 (to_date, from_date) `xpWrapMaybe` xpText
71 where
72 to_date :: String -> Maybe UTCTime
73 to_date = parseTime defaultTimeLocale date_format_padded
74
75 from_date :: UTCTime -> String
76 from_date = formatTime defaultTimeLocale date_format_padded
77
78
79 -- | (Un)pickle a 'UTCTime' from a \<RaceDate\> element in an
80 -- 'AutoRaceResults' message.
81 --
82 -- Example:
83 --
84 -- <RaceDate>6/1/2014 1:00:00 PM</RaceDate>
85 -- <RaceDate>5/24/2014 2:45:00 PM</RaceDate>
86 --
87 xp_racedate :: PU UTCTime
88 xp_racedate =
89 (to_racedate, from_racedate) `xpWrapMaybe` xpText
90 where
91 format = date_format ++ " " ++ "%-I:%M:%S %p"
92
93 to_racedate :: String -> Maybe UTCTime
94 to_racedate = parseTime defaultTimeLocale format
95
96 from_racedate :: UTCTime -> String
97 from_racedate = formatTime defaultTimeLocale format
98
99
100 -- | (Un)pickle a UTCTime from a weather forecast's gamedate. Example
101 -- input looks like,
102 --
103 -- \<forecast gamedate=\"Monday, December 30th\"\>
104 --
105 -- When unpickling we get rid of the suffixes \"st\", \"nd\", \"rd\", and
106 -- \"th\". During pickling, we add them back based on the last digit
107 -- of the date.
108 --
109 xp_gamedate :: PU UTCTime
110 xp_gamedate =
111 (to_gamedate, from_gamedate) `xpWrapMaybe` xpText
112 where
113 format = "%A, %B %-d"
114
115 to_gamedate :: String -> Maybe UTCTime
116 to_gamedate s =
117 parseTime defaultTimeLocale format s'
118 where
119 s' = case (reverse s) of
120 (c2:c1:cs) -> let suffix = [c1,c2]
121 in
122 case suffix of
123 "st" -> reverse cs
124 "nd" -> reverse cs
125 "rd" -> reverse cs
126 "th" -> reverse cs
127 _ -> s -- Unknown suffix, leave it alone.
128 _ -> s -- The String is less than two characters long,
129 -- leave it alone.
130
131
132 from_gamedate :: UTCTime -> String
133 from_gamedate d = s ++ (suffix s)
134 where
135 s = formatTime defaultTimeLocale format d
136
137 suffix :: String -> String
138 suffix cs =
139 case (reverse cs) of
140 [] -> []
141 ('1':_) -> "st"
142 ('2':_) -> "nd"
143 ('3':_) -> "rd"
144 _ -> "th"
145
146
147
148
149
150
151 -- | (Un)pickle a UTCTime without the date portion.
152 --
153 xp_time :: PU UTCTime
154 xp_time =
155 (to_time, from_time) `xpWrapMaybe` xpText
156 where
157 to_time :: String -> Maybe UTCTime
158 to_time = parseTime defaultTimeLocale time_format
159
160 from_time :: UTCTime -> String
161 from_time = formatTime defaultTimeLocale time_format
162
163
164 -- | (Un)pickle a UTCTime without the date portion, allowing for a
165 -- value of \"TBA\" (which gets translated to 'Nothing').
166 --
167 xp_tba_time :: PU (Maybe UTCTime)
168 xp_tba_time =
169 (to_time, from_time) `xpWrap` xpText
170 where
171 to_time :: String -> Maybe UTCTime
172 to_time s
173 | s == "TBA" = Nothing
174 | otherwise = parseTime defaultTimeLocale time_format s
175
176 from_time :: Maybe UTCTime -> String
177 from_time Nothing = ""
178 from_time (Just t) = formatTime defaultTimeLocale time_format t
179
180
181
182 -- | (Un)pickle the \<time_stamp\> element format to/from a 'UTCTime'.
183 --
184 -- Example: \<time_stamp\> January 6, 2014, at 10:11 PM ET \</time_stamp\>
185 --
186 -- TSN doesn't provide a proper time zone name, so we assume that
187 -- it's always Eastern Standard Time. EST is UTC-5, so we
188 -- add/subtract 5 hours to convert to/from UTC.
189 --
190 xp_time_stamp :: PU UTCTime
191 xp_time_stamp =
192 (parse_time_stamp, from_time_stamp) `xpWrapMaybe` xpText
193 where
194 five_hours :: NominalDiffTime
195 five_hours = 5 * 60 * 60
196
197 subtract_five :: UTCTime -> UTCTime
198 subtract_five = addUTCTime (-1 * five_hours)
199
200 from_time_stamp :: UTCTime -> String
201 from_time_stamp =
202 formatTime defaultTimeLocale time_stamp_format . subtract_five