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