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