1 -- | (Un)picklers for data types present in The Sports Network XML
18 import Data.List ( intercalate )
19 import Data.List.Split ( chunksOf )
20 import Data.String.Utils ( replace )
21 import Data.Time.Clock ( NominalDiffTime, UTCTime, addUTCTime )
22 import Data.Time.Format ( formatTime, parseTime )
23 import System.Locale ( defaultTimeLocale )
24 import Text.XML.HXT.Arrow.Pickle (
28 import Text.XML.HXT.Arrow.Pickle.Xml ( PU )
37 -- | The format string for a base date in m/d/yyyy format. The
38 -- day/month are not padded at all. This will match for example,
45 date_format = "%-m/%-d/%Y"
48 -- | The format string for a base date in mm/dd/yyyy format. The
49 -- day/month are padded to two characters with zeros. This will
56 date_format_padded :: String
57 date_format_padded = "%0m/%0d/%Y"
60 -- | (Un)pickle a UTCTime without the time portion.
64 (to_date, from_date) `xpWrapMaybe` xpText
66 to_date :: String -> Maybe UTCTime
67 to_date = parseTime defaultTimeLocale date_format
69 from_date :: UTCTime -> String
70 from_date = formatTime defaultTimeLocale date_format
73 -- | (Un)pickle a UTCTime without the time portion. The day/month are
74 -- padded to two characters with zeros.
76 xp_date_padded :: PU UTCTime
78 (to_date, from_date) `xpWrapMaybe` xpText
80 to_date :: String -> Maybe UTCTime
81 to_date = parseTime defaultTimeLocale date_format_padded
83 from_date :: UTCTime -> String
84 from_date = formatTime defaultTimeLocale date_format_padded
88 -- | Format a number as a string using a comma as the thousands
93 -- >>> format_commas 0
95 -- >>> format_commas 10
97 -- >>> format_commas 100
99 -- >>> format_commas 1000
101 -- >>> format_commas 10000
103 -- >>> format_commas 100000
105 -- >>> format_commas 1000000
108 format_commas :: Int -> String
110 reverse (intercalate "," $ chunksOf 3 $ reverse $ show x)
112 -- | Parse \<Earnings\> from an 'AutoRaceResultsListing'. These are
113 -- essentially 'Int's, but they look like,
115 -- * \<Earnings\>336,826\</Earnings\>
117 -- * \<Earnings\>1,000,191\</Earnings\>
119 -- * \<Earnings\>TBA\</Earnings\>
121 xp_earnings :: PU (Maybe Int)
123 (to_earnings, from_earnings) `xpWrap` xpText
125 strip_commas :: String -> String
126 strip_commas = replace "," ""
128 to_earnings :: String -> Maybe Int
130 | s == "TBA" = Nothing
131 | otherwise = Just $ (read . strip_commas) s
133 from_earnings :: Maybe Int -> String
134 from_earnings Nothing = "TBA"
135 from_earnings (Just i) = format_commas i
138 -- | (Un)pickle an unpadded 'UTCTime'. Used for example on the
139 -- \<RaceDate\> elements in an 'AutoRaceResults' message.
143 -- * \<RaceDate\>6/1/2014 1:00:00 PM\</RaceDate\>
145 -- * \<RaceDate\>5/24/2014 2:45:00 PM\</RaceDate\>
147 xp_datetime :: PU UTCTime
149 (to_datetime, from_datetime) `xpWrapMaybe` xpText
151 format = date_format ++ " " ++ "%-I:%M:%S %p"
153 to_datetime :: String -> Maybe UTCTime
154 to_datetime = parseTime defaultTimeLocale format
156 from_datetime :: UTCTime -> String
157 from_datetime = formatTime defaultTimeLocale format
160 -- | (Un)pickle a UTCTime from a weather forecast's gamedate. Example
163 -- \<forecast gamedate=\"Monday, December 30th\"\>
165 -- When unpickling we get rid of the suffixes \"st\", \"nd\", \"rd\", and
166 -- \"th\". During pickling, we add them back based on the last digit
169 xp_gamedate :: PU UTCTime
171 (to_gamedate, from_gamedate) `xpWrapMaybe` xpText
173 format = "%A, %B %-d"
175 to_gamedate :: String -> Maybe UTCTime
177 parseTime defaultTimeLocale format s'
179 s' = case (reverse s) of
180 (c2:c1:cs) -> let suffix = [c1,c2]
187 _ -> s -- Unknown suffix, leave it alone.
188 _ -> s -- The String is less than two characters long,
192 from_gamedate :: UTCTime -> String
193 from_gamedate d = s ++ (suffix s)
195 s = formatTime defaultTimeLocale format d
197 suffix :: String -> String
211 -- | (Un)pickle a UTCTime without the date portion.
213 xp_time :: PU UTCTime
215 (to_time, from_time) `xpWrapMaybe` xpText
217 to_time :: String -> Maybe UTCTime
218 to_time = parseTime defaultTimeLocale time_format
220 from_time :: UTCTime -> String
221 from_time = formatTime defaultTimeLocale time_format
224 -- | (Un)pickle a UTCTime without the date portion. This differs from
225 -- 'xp_time' in that it uses periods in the AM/PM part, i.e. \"A.M.\"
226 -- and \"P.M.\" It also doesn't use padding for the \"hours\" part.
230 -- * \<CurrentTimeStamp\>11:30 A.M.\</CurrentTimeStamp\>
232 xp_time_dots :: PU UTCTime
234 (to_time, from_time) `xpWrapMaybe` xpText
236 -- | The hours arent padded with zeros.
237 nopad_time_format :: String
238 nopad_time_format = "%-I:%M %p"
240 to_time :: String -> Maybe UTCTime
241 to_time = (parseTime defaultTimeLocale nopad_time_format) . (replace "." "")
243 from_time :: UTCTime -> String
245 replace "AM" "A.M." (replace "PM" "P.M." s)
247 s = formatTime defaultTimeLocale nopad_time_format t
250 -- | (Un)pickle a UTCTime without the date portion, allowing for a
251 -- value of \"TBA\" (which gets translated to 'Nothing').
253 xp_tba_time :: PU (Maybe UTCTime)
255 (to_time, from_time) `xpWrap` xpText
257 to_time :: String -> Maybe UTCTime
259 | s == "TBA" = Nothing
260 | otherwise = parseTime defaultTimeLocale time_format s
262 from_time :: Maybe UTCTime -> String
263 from_time Nothing = "TBA"
264 from_time (Just t) = formatTime defaultTimeLocale time_format t
268 -- | (Un)pickle the \<time_stamp\> element format to/from a 'UTCTime'.
270 -- Example: \<time_stamp\> January 6, 2014, at 10:11 PM ET \</time_stamp\>
272 -- TSN doesn't provide a proper time zone name, so we assume that
273 -- it's always Eastern Standard Time. EST is UTC-5, so we
274 -- add/subtract 5 hours to convert to/from UTC.
276 xp_time_stamp :: PU UTCTime
278 (parse_time_stamp, from_time_stamp) `xpWrapMaybe` xpText
280 five_hours :: NominalDiffTime
281 five_hours = 5 * 60 * 60
283 subtract_five :: UTCTime -> UTCTime
284 subtract_five = addUTCTime (-1 * five_hours)
286 from_time_stamp :: UTCTime -> String
288 formatTime defaultTimeLocale time_stamp_format . subtract_five
291 -- | (Un)pickle an ambiguous 12-hour AM/PM time, which is ambiguous
292 -- because it's missing the AM/PM part.
296 xp_ambiguous_time :: PU UTCTime
298 (to_time, from_time) `xpWrapMaybe` xpText
300 ambiguous_time_format :: String
301 ambiguous_time_format = "%-I:%M"
303 to_time :: String -> Maybe UTCTime
304 to_time = parseTime defaultTimeLocale ambiguous_time_format
306 from_time :: UTCTime -> String
308 formatTime defaultTimeLocale ambiguous_time_format