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_date,
   6   xp_date_padded,
   7   xp_earnings,
   8   xp_gamedate,
   9   xp_racedate,
  10   xp_tba_time,
  11   xp_time,
  12   xp_time_stamp )
  13 where
  14
  15 -- System imports.
  16 import Data.List ( intercalate )
  17 import Data.List.Split ( chunksOf )
  18 import Data.String.Utils ( replace )
  19 import Data.Time.Clock ( NominalDiffTime, UTCTime, addUTCTime )
  20 import Data.Time.Format ( formatTime, parseTime )
  21 import System.Locale ( defaultTimeLocale )
  22 import Text.XML.HXT.Arrow.Pickle (
  23   xpText,
  24   xpWrap,
  25   xpWrapMaybe )
  26 import Text.XML.HXT.Arrow.Pickle.Xml ( PU )
  27
  28 -- Local imports.
  29 import TSN.Parse (
  30   parse_time_stamp,
  31   time_format,
  32   time_stamp_format )
  33
  34
  35 -- | The format string for a base date in m/d/yyyy format. The
  36 --   day/month are not padded at all. This will match for example,
  37 --
  38 --   * 2\/15\/1983
  39 --
  40 --   * 1\/1\/0000
  41 --
  42 date_format :: String
  43 date_format = "%-m/%-d/%Y"
  44
  45
  46 -- | The format string for a base date in mm/dd/yyyy format. The
  47 --   day/month are padded to two characters with zeros. This will
  48 --   match for example,
  49 --
  50 --   * 02\/15\/1983
  51 --
  52 --   * 01\/01\/0000
  53 --
  54 date_format_padded :: String
  55 date_format_padded = "%0m/%0d/%Y"
  56
  57
  58 -- | (Un)pickle a UTCTime without the time portion.
  59 --
  60 xp_date :: PU UTCTime
  61 xp_date =
  62   (to_date, from_date) `xpWrapMaybe` xpText
  63   where
  64     to_date :: String -> Maybe UTCTime
  65     to_date = parseTime defaultTimeLocale date_format
  66
  67     from_date :: UTCTime -> String
  68     from_date = formatTime defaultTimeLocale date_format
  69
  70
  71 -- | (Un)pickle a UTCTime without the time portion. The day/month are
  72 --   padded to two characters with zeros.
  73 --
  74 xp_date_padded :: PU UTCTime
  75 xp_date_padded =
  76   (to_date, from_date) `xpWrapMaybe` xpText
  77   where
  78     to_date :: String -> Maybe UTCTime
  79     to_date = parseTime defaultTimeLocale date_format_padded
  80
  81     from_date :: UTCTime -> String
  82     from_date = formatTime defaultTimeLocale date_format_padded
  83
  84
  85
  86 -- | Format a number as a string using a comma as the thousands
  87 --   separator.
  88 --
  89 --   Examples:
  90 --
  91 --   >>> format_commas 0
  92 --   "0"
  93 --   >>> format_commas 10
  94 --   "10"
  95 --   >>> format_commas 100
  96 --   "100"
  97 --   >>> format_commas 1000
  98 --   "1,000"
  99 --   >>> format_commas 10000
 100 --   "10,000"
 101 --   >>> format_commas 100000
 102 --   "100,000"
 103 --   >>> format_commas 1000000
 104 --   "1,000,000"
 105 --
 106 format_commas :: Int -> String
 107 format_commas x =
 108   reverse (intercalate "," $ chunksOf 3 $ reverse $ show x)
 109
 110 -- | Parse \<Earnings\> from an 'AutoRaceResultsListing'. These are
 111 --   essentially 'Int's, but they look like,
 112 --
 113 --   * \<Earnings\>336,826\</Earnings\>
 114 --
 115 --   * \<Earnings\>1,000,191\</Earnings\>
 116 --
 117 --   * \<Earnings\>TBA\</Earnings\>
 118 --
 119 xp_earnings :: PU (Maybe Int)
 120 xp_earnings =
 121   (to_earnings, from_earnings) `xpWrap` xpText
 122   where
 123     strip_commas :: String -> String
 124     strip_commas = replace "," ""
 125
 126     to_earnings :: String -> Maybe Int
 127     to_earnings s
 128       | s == "TBA" = Nothing
 129       | otherwise = Just  $ (read . strip_commas) s
 130
 131     from_earnings :: Maybe Int -> String
 132     from_earnings Nothing = "TBA"
 133     from_earnings (Just i) = format_commas i
 134
 135
 136 -- | (Un)pickle a 'UTCTime' from a \<RaceDate\> element in an
 137 --   'AutoRaceResults' message.
 138 --
 139 --   Examples:
 140 --
 141 --   * \<RaceDate\>6/1/2014 1:00:00 PM\</RaceDate\>
 142 --
 143 --   * \<RaceDate\>5/24/2014 2:45:00 PM\</RaceDate\>
 144 --
 145 xp_racedate :: PU UTCTime
 146 xp_racedate =
 147   (to_racedate, from_racedate) `xpWrapMaybe` xpText
 148   where
 149     format = date_format ++ " " ++ "%-I:%M:%S %p"
 150
 151     to_racedate :: String -> Maybe UTCTime
 152     to_racedate = parseTime defaultTimeLocale format
 153
 154     from_racedate :: UTCTime -> String
 155     from_racedate = formatTime defaultTimeLocale format
 156
 157
 158 -- | (Un)pickle a UTCTime from a weather forecast's gamedate. Example
 159 --   input looks like,
 160 --
 161 --   \<forecast gamedate=\"Monday, December 30th\"\>
 162 --
 163 --   When unpickling we get rid of the suffixes \"st\", \"nd\", \"rd\", and
 164 --   \"th\". During pickling, we add them back based on the last digit
 165 --   of the date.
 166 --
 167 xp_gamedate :: PU UTCTime
 168 xp_gamedate =
 169   (to_gamedate, from_gamedate) `xpWrapMaybe` xpText
 170   where
 171     format = "%A, %B %-d"
 172
 173     to_gamedate :: String -> Maybe UTCTime
 174     to_gamedate s =
 175       parseTime defaultTimeLocale format s'
 176       where
 177         s' = case (reverse s) of
 178                (c2:c1:cs) -> let suffix = [c1,c2]
 179                              in
 180                                case suffix of
 181                                  "st" -> reverse cs
 182                                  "nd" -> reverse cs
 183                                  "rd" -> reverse cs
 184                                  "th" -> reverse cs
 185                                  _    -> s -- Unknown suffix, leave it alone.
 186                _ -> s -- The String is less than two characters long,
 187                       -- leave it alone.
 188
 189
 190     from_gamedate :: UTCTime -> String
 191     from_gamedate d = s ++ (suffix s)
 192       where
 193         s = formatTime defaultTimeLocale format d
 194
 195         suffix :: String -> String
 196         suffix cs =
 197           case (reverse cs) of
 198             []       -> []
 199             ('1':_) -> "st"
 200             ('2':_) -> "nd"
 201             ('3':_) -> "rd"
 202             _        -> "th"
 203
 204
 205
 206
 207
 208
 209 -- | (Un)pickle a UTCTime without the date portion.
 210 --
 211 xp_time :: PU UTCTime
 212 xp_time =
 213   (to_time, from_time) `xpWrapMaybe` xpText
 214   where
 215     to_time :: String -> Maybe UTCTime
 216     to_time = parseTime defaultTimeLocale time_format
 217
 218     from_time :: UTCTime -> String
 219     from_time = formatTime defaultTimeLocale time_format
 220
 221
 222 -- | (Un)pickle a UTCTime without the date portion, allowing for a
 223 --   value of \"TBA\" (which gets translated to 'Nothing').
 224 --
 225 xp_tba_time :: PU (Maybe UTCTime)
 226 xp_tba_time =
 227   (to_time, from_time) `xpWrap` xpText
 228   where
 229     to_time :: String -> Maybe UTCTime
 230     to_time s
 231       | s == "TBA" = Nothing
 232       | otherwise = parseTime defaultTimeLocale time_format s
 233
 234     from_time :: Maybe UTCTime -> String
 235     from_time Nothing = "TBA"
 236     from_time (Just t) = formatTime defaultTimeLocale time_format t
 237
 238
 239
 240 -- | (Un)pickle the \<time_stamp\> element format to/from a 'UTCTime'.
 241 --
 242 --   Example:  \<time_stamp\> January 6, 2014, at 10:11 PM ET \</time_stamp\>
 243 --
 244 --   TSN doesn't provide a proper time zone name, so we assume that
 245 --   it's always Eastern Standard Time. EST is UTC-5, so we
 246 --   add/subtract 5 hours to convert to/from UTC.
 247 --
 248 xp_time_stamp :: PU UTCTime
 249 xp_time_stamp =
 250   (parse_time_stamp, from_time_stamp) `xpWrapMaybe` xpText
 251   where
 252     five_hours :: NominalDiffTime
 253     five_hours = 5 * 60 * 60
 254
 255     subtract_five :: UTCTime -> UTCTime
 256     subtract_five = addUTCTime (-1 * five_hours)
 257
 258     from_time_stamp :: UTCTime -> String
 259     from_time_stamp =
 260       formatTime defaultTimeLocale time_stamp_format . subtract_five