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