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