1 -- | (Un)picklers for data types present in The Sports Network XML
17 import Data.List ( intercalate )
18 import Data.List.Split ( chunksOf )
19 import Data.String.Utils ( replace )
20 import Data.Time.Clock ( NominalDiffTime, UTCTime, addUTCTime )
21 import Data.Time.Format ( formatTime, parseTime )
22 import System.Locale ( defaultTimeLocale )
23 import Text.XML.HXT.Arrow.Pickle (
27 import Text.XML.HXT.Arrow.Pickle.Xml ( PU )
36 -- | The format string for a base date in m/d/yyyy format. The
37 -- day/month are not padded at all. This will match for example,
44 date_format = "%-m/%-d/%Y"
47 -- | The format string for a base date in mm/dd/yyyy format. The
48 -- day/month are padded to two characters with zeros. This will
55 date_format_padded :: String
56 date_format_padded = "%0m/%0d/%Y"
59 -- | (Un)pickle a UTCTime without the time portion.
63 (to_date, from_date) `xpWrapMaybe` xpText
65 to_date :: String -> Maybe UTCTime
66 to_date = parseTime defaultTimeLocale date_format
68 from_date :: UTCTime -> String
69 from_date = formatTime defaultTimeLocale date_format
72 -- | (Un)pickle a UTCTime without the time portion. The day/month are
73 -- padded to two characters with zeros.
75 xp_date_padded :: PU UTCTime
77 (to_date, from_date) `xpWrapMaybe` xpText
79 to_date :: String -> Maybe UTCTime
80 to_date = parseTime defaultTimeLocale date_format_padded
82 from_date :: UTCTime -> String
83 from_date = formatTime defaultTimeLocale date_format_padded
87 -- | Format a number as a string using a comma as the thousands
92 -- >>> format_commas 0
94 -- >>> format_commas 10
96 -- >>> format_commas 100
98 -- >>> format_commas 1000
100 -- >>> format_commas 10000
102 -- >>> format_commas 100000
104 -- >>> format_commas 1000000
107 format_commas :: Int -> String
109 reverse (intercalate "," $ chunksOf 3 $ reverse $ show x)
111 -- | Parse \<Earnings\> from an 'AutoRaceResultsListing'. These are
112 -- essentially 'Int's, but they look like,
114 -- * \<Earnings\>336,826\</Earnings\>
116 -- * \<Earnings\>1,000,191\</Earnings\>
118 -- * \<Earnings\>TBA\</Earnings\>
120 xp_earnings :: PU (Maybe Int)
122 (to_earnings, from_earnings) `xpWrap` xpText
124 strip_commas :: String -> String
125 strip_commas = replace "," ""
127 to_earnings :: String -> Maybe Int
129 | s == "TBA" = Nothing
130 | otherwise = Just $ (read . strip_commas) s
132 from_earnings :: Maybe Int -> String
133 from_earnings Nothing = "TBA"
134 from_earnings (Just i) = format_commas i
137 -- | (Un)pickle an unpadded 'UTCTime'. Used for example on the
138 -- \<RaceDate\> elements in an 'AutoRaceResults' message.
142 -- * \<RaceDate\>6/1/2014 1:00:00 PM\</RaceDate\>
144 -- * \<RaceDate\>5/24/2014 2:45:00 PM\</RaceDate\>
146 xp_datetime :: PU UTCTime
148 (to_datetime, from_datetime) `xpWrapMaybe` xpText
150 format = date_format ++ " " ++ "%-I:%M:%S %p"
152 to_datetime :: String -> Maybe UTCTime
153 to_datetime = parseTime defaultTimeLocale format
155 from_datetime :: UTCTime -> String
156 from_datetime = formatTime defaultTimeLocale format
159 -- | (Un)pickle a UTCTime from a weather forecast's gamedate. Example
162 -- \<forecast gamedate=\"Monday, December 30th\"\>
164 -- When unpickling we get rid of the suffixes \"st\", \"nd\", \"rd\", and
165 -- \"th\". During pickling, we add them back based on the last digit
168 xp_gamedate :: PU UTCTime
170 (to_gamedate, from_gamedate) `xpWrapMaybe` xpText
172 format = "%A, %B %-d"
174 to_gamedate :: String -> Maybe UTCTime
176 parseTime defaultTimeLocale format s'
178 s' = case (reverse s) of
179 (c2:c1:cs) -> let suffix = [c1,c2]
186 _ -> s -- Unknown suffix, leave it alone.
187 _ -> s -- The String is less than two characters long,
191 from_gamedate :: UTCTime -> String
192 from_gamedate d = s ++ (suffix s)
194 s = formatTime defaultTimeLocale format d
196 suffix :: String -> String
210 -- | (Un)pickle a UTCTime without the date portion.
212 xp_time :: PU UTCTime
214 (to_time, from_time) `xpWrapMaybe` xpText
216 to_time :: String -> Maybe UTCTime
217 to_time = parseTime defaultTimeLocale time_format
219 from_time :: UTCTime -> String
220 from_time = formatTime defaultTimeLocale time_format
223 -- | (Un)pickle a UTCTime without the date portion. This differs from
224 -- 'xp_time' in that it uses periods in the AM/PM part, i.e. \"A.M.\"
225 -- and \"P.M.\" It also doesn't use padding for the \"hours\" part.
229 -- * \<CurrentTimeStamp\>11:30 A.M.\</CurrentTimeStamp\>
231 xp_time_dots :: PU UTCTime
233 (to_time, from_time) `xpWrapMaybe` xpText
235 -- | The hours arent padded with zeros.
236 nopad_time_format :: String
237 nopad_time_format = "%-I:%M %p"
239 to_time :: String -> Maybe UTCTime
240 to_time = (parseTime defaultTimeLocale nopad_time_format) . (replace "." "")
242 from_time :: UTCTime -> String
244 replace "AM" "A.M." (replace "PM" "P.M." s)
246 s = formatTime defaultTimeLocale nopad_time_format t
249 -- | (Un)pickle a UTCTime without the date portion, allowing for a
250 -- value of \"TBA\" (which gets translated to 'Nothing').
252 xp_tba_time :: PU (Maybe UTCTime)
254 (to_time, from_time) `xpWrap` xpText
256 to_time :: String -> Maybe UTCTime
258 | s == "TBA" = Nothing
259 | otherwise = parseTime defaultTimeLocale time_format s
261 from_time :: Maybe UTCTime -> String
262 from_time Nothing = "TBA"
263 from_time (Just t) = formatTime defaultTimeLocale time_format t
267 -- | (Un)pickle the \<time_stamp\> element format to/from a 'UTCTime'.
269 -- Example: \<time_stamp\> January 6, 2014, at 10:11 PM ET \</time_stamp\>
271 -- TSN doesn't provide a proper time zone name, so we assume that
272 -- it's always Eastern Standard Time. EST is UTC-5, so we
273 -- add/subtract 5 hours to convert to/from UTC.
275 xp_time_stamp :: PU UTCTime
277 (parse_time_stamp, from_time_stamp) `xpWrapMaybe` xpText
279 five_hours :: NominalDiffTime
280 five_hours = 5 * 60 * 60
282 subtract_five :: UTCTime -> UTCTime
283 subtract_five = addUTCTime (-1 * five_hours)
285 from_time_stamp :: UTCTime -> String
287 formatTime defaultTimeLocale time_stamp_format . subtract_five