src/TSN/Picklers.hs

   1 -- | (Un)picklers for data types present in The Sports Network XML
   2 --   feed.
   3 --
   4 module TSN.Picklers (
   5   xp_ambiguous_time,
   6   xp_date,
   7   xp_date_padded,
   8   xp_datetime,
   9   xp_earnings,
  10   xp_gamedate,
  11   xp_tba_time,
  12   xp_time,
  13   xp_time_dots,
  14   xp_time_stamp )
  15 where
  16
  17 -- System imports.
  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 (
  25   xpText,
  26   xpWrap,
  27   xpWrapMaybe )
  28 import Text.XML.HXT.Arrow.Pickle.Xml ( PU )
  29
  30 -- Local imports.
  31 import TSN.Parse (
  32   parse_time_stamp,
  33   time_format,
  34   time_stamp_format )
  35
  36
  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,
  39 --
  40 --   * 2\/15\/1983
  41 --
  42 --   * 1\/1\/0000
  43 --
  44 date_format :: String
  45 date_format = "%-m/%-d/%Y"
  46
  47
  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
  50 --   match for example,
  51 --
  52 --   * 02\/15\/1983
  53 --
  54 --   * 01\/01\/0000
  55 --
  56 date_format_padded :: String
  57 date_format_padded = "%0m/%0d/%Y"
  58
  59
  60 -- | (Un)pickle a UTCTime without the time portion.
  61 --
  62 xp_date :: PU UTCTime
  63 xp_date =
  64   (to_date, from_date) `xpWrapMaybe` xpText
  65   where
  66     to_date :: String -> Maybe UTCTime
  67     to_date = parseTime defaultTimeLocale date_format
  68
  69     from_date :: UTCTime -> String
  70     from_date = formatTime defaultTimeLocale date_format
  71
  72
  73 -- | (Un)pickle a UTCTime without the time portion. The day/month are
  74 --   padded to two characters with zeros.
  75 --
  76 xp_date_padded :: PU UTCTime
  77 xp_date_padded =
  78   (to_date, from_date) `xpWrapMaybe` xpText
  79   where
  80     to_date :: String -> Maybe UTCTime
  81     to_date = parseTime defaultTimeLocale date_format_padded
  82
  83     from_date :: UTCTime -> String
  84     from_date = formatTime defaultTimeLocale date_format_padded
  85
  86
  87
  88 -- | Format a number as a string using a comma as the thousands
  89 --   separator.
  90 --
  91 --   Examples:
  92 --
  93 --   >>> format_commas 0
  94 --   "0"
  95 --   >>> format_commas 10
  96 --   "10"
  97 --   >>> format_commas 100
  98 --   "100"
  99 --   >>> format_commas 1000
 100 --   "1,000"
 101 --   >>> format_commas 10000
 102 --   "10,000"
 103 --   >>> format_commas 100000
 104 --   "100,000"
 105 --   >>> format_commas 1000000
 106 --   "1,000,000"
 107 --
 108 format_commas :: Int -> String
 109 format_commas x =
 110   reverse (intercalate "," $ chunksOf 3 $ reverse $ show x)
 111
 112 -- | Parse \<Earnings\> from an 'AutoRaceResultsListing'. These are
 113 --   essentially 'Int's, but they look like,
 114 --
 115 --   * \<Earnings\>336,826\</Earnings\>
 116 --
 117 --   * \<Earnings\>1,000,191\</Earnings\>
 118 --
 119 --   * \<Earnings\>TBA\</Earnings\>
 120 --
 121 xp_earnings :: PU (Maybe Int)
 122 xp_earnings =
 123   (to_earnings, from_earnings) `xpWrap` xpText
 124   where
 125     strip_commas :: String -> String
 126     strip_commas = replace "," ""
 127
 128     to_earnings :: String -> Maybe Int
 129     to_earnings s
 130       | s == "TBA" = Nothing
 131       | otherwise = Just  $ (read . strip_commas) s
 132
 133     from_earnings :: Maybe Int -> String
 134     from_earnings Nothing = "TBA"
 135     from_earnings (Just i) = format_commas i
 136
 137
 138 -- | (Un)pickle an unpadded 'UTCTime'. Used for example on the
 139 --   \<RaceDate\> elements in an 'AutoRaceResults' message.
 140 --
 141 --   Examples:
 142 --
 143 --   * \<RaceDate\>6/1/2014 1:00:00 PM\</RaceDate\>
 144 --
 145 --   * \<RaceDate\>5/24/2014 2:45:00 PM\</RaceDate\>
 146 --
 147 xp_datetime :: PU UTCTime
 148 xp_datetime =
 149   (to_datetime, from_datetime) `xpWrapMaybe` xpText
 150   where
 151     format = date_format ++ " " ++ "%-I:%M:%S %p"
 152
 153     to_datetime :: String -> Maybe UTCTime
 154     to_datetime = parseTime defaultTimeLocale format
 155
 156     from_datetime :: UTCTime -> String
 157     from_datetime = formatTime defaultTimeLocale format
 158
 159
 160 -- | (Un)pickle a UTCTime from a weather forecast's gamedate. Example
 161 --   input looks like,
 162 --
 163 --   \<forecast gamedate=\"Monday, December 30th\"\>
 164 --
 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
 167 --   of the date.
 168 --
 169 xp_gamedate :: PU UTCTime
 170 xp_gamedate =
 171   (to_gamedate, from_gamedate) `xpWrapMaybe` xpText
 172   where
 173     format = "%A, %B %-d"
 174
 175     to_gamedate :: String -> Maybe UTCTime
 176     to_gamedate s =
 177       parseTime defaultTimeLocale format s'
 178       where
 179         s' = case (reverse s) of
 180                (c2:c1:cs) -> let suffix = [c1,c2]
 181                              in
 182                                case suffix of
 183                                  "st" -> reverse cs
 184                                  "nd" -> reverse cs
 185                                  "rd" -> reverse cs
 186                                  "th" -> reverse cs
 187                                  _    -> s -- Unknown suffix, leave it alone.
 188                _ -> s -- The String is less than two characters long,
 189                       -- leave it alone.
 190
 191
 192     from_gamedate :: UTCTime -> String
 193     from_gamedate d = s ++ (suffix s)
 194       where
 195         s = formatTime defaultTimeLocale format d
 196
 197         suffix :: String -> String
 198         suffix cs =
 199           case (reverse cs) of
 200             []       -> []
 201             ('1':_) -> "st"
 202             ('2':_) -> "nd"
 203             ('3':_) -> "rd"
 204             _        -> "th"
 205
 206
 207
 208
 209
 210
 211 -- | (Un)pickle a UTCTime without the date portion.
 212 --
 213 xp_time :: PU UTCTime
 214 xp_time =
 215   (to_time, from_time) `xpWrapMaybe` xpText
 216   where
 217     to_time :: String -> Maybe UTCTime
 218     to_time = parseTime defaultTimeLocale time_format
 219
 220     from_time :: UTCTime -> String
 221     from_time = formatTime defaultTimeLocale time_format
 222
 223
 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.
 227 --
 228 --   Examples:
 229 --
 230 --   * \<CurrentTimeStamp\>11:30 A.M.\</CurrentTimeStamp\>
 231 --
 232 xp_time_dots :: PU UTCTime
 233 xp_time_dots =
 234   (to_time, from_time) `xpWrapMaybe` xpText
 235   where
 236     -- | The hours arent padded with zeros.
 237     nopad_time_format :: String
 238     nopad_time_format = "%-I:%M %p"
 239
 240     to_time :: String -> Maybe UTCTime
 241     to_time = (parseTime defaultTimeLocale nopad_time_format) . (replace "." "")
 242
 243     from_time :: UTCTime -> String
 244     from_time t =
 245         replace "AM" "A.M." (replace "PM" "P.M." s)
 246       where
 247         s = formatTime defaultTimeLocale nopad_time_format t
 248
 249
 250 -- | (Un)pickle a UTCTime without the date portion, allowing for a
 251 --   value of \"TBA\" (which gets translated to 'Nothing').
 252 --
 253 xp_tba_time :: PU (Maybe UTCTime)
 254 xp_tba_time =
 255   (to_time, from_time) `xpWrap` xpText
 256   where
 257     to_time :: String -> Maybe UTCTime
 258     to_time s
 259       | s == "TBA" = Nothing
 260       | otherwise = parseTime defaultTimeLocale time_format s
 261
 262     from_time :: Maybe UTCTime -> String
 263     from_time Nothing = "TBA"
 264     from_time (Just t) = formatTime defaultTimeLocale time_format t
 265
 266
 267
 268 -- | (Un)pickle the \<time_stamp\> element format to/from a 'UTCTime'.
 269 --
 270 --   Example:  \<time_stamp\> January 6, 2014, at 10:11 PM ET \</time_stamp\>
 271 --
 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.
 275 --
 276 xp_time_stamp :: PU UTCTime
 277 xp_time_stamp =
 278   (parse_time_stamp, from_time_stamp) `xpWrapMaybe` xpText
 279   where
 280     five_hours :: NominalDiffTime
 281     five_hours = 5 * 60 * 60
 282
 283     subtract_five :: UTCTime -> UTCTime
 284     subtract_five = addUTCTime (-1 * five_hours)
 285
 286     from_time_stamp :: UTCTime -> String
 287     from_time_stamp =
 288       formatTime defaultTimeLocale time_stamp_format . subtract_five
 289
 290
 291 -- | (Un)pickle an ambiguous 12-hour AM/PM time, which is ambiguous
 292 --   because it's missing the AM/PM part.
 293 --
 294 --   Examples:
 295 --
 296 xp_ambiguous_time :: PU UTCTime
 297 xp_ambiguous_time =
 298   (to_time, from_time) `xpWrapMaybe` xpText
 299   where
 300     ambiguous_time_format :: String
 301     ambiguous_time_format = "%-I:%M"
 302
 303     to_time :: String -> Maybe UTCTime
 304     to_time = parseTime defaultTimeLocale ambiguous_time_format
 305
 306     from_time :: UTCTime -> String
 307     from_time =
 308       formatTime defaultTimeLocale ambiguous_time_format