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_gamedate,
   7   xp_tba_time,
   8   xp_time,
   9   xp_time_stamp )
  10 where
  11
  12 -- System imports.
  13 import Data.Time.Clock ( NominalDiffTime, UTCTime, addUTCTime )
  14 import Data.Time.Format ( formatTime, parseTime )
  15 import System.Locale ( defaultTimeLocale )
  16 import Text.XML.HXT.Arrow.Pickle (
  17   xpText,
  18   xpWrap,
  19   xpWrapMaybe )
  20 import Text.XML.HXT.Arrow.Pickle.Xml ( PU )
  21
  22
  23 -- | (Un)pickle a UTCTime without the time portion.
  24 --
  25 xp_date :: PU UTCTime
  26 xp_date =
  27   (to_date, from_date) `xpWrapMaybe` xpText
  28   where
  29     format = "%-m/%-d/%Y"
  30
  31     to_date :: String -> Maybe UTCTime
  32     to_date = parseTime defaultTimeLocale format
  33
  34     from_date :: UTCTime -> String
  35     from_date = formatTime defaultTimeLocale format
  36
  37
  38 -- | (Un)pickle a UTCTime from a weather forecast's gamedate. Example
  39 --   input looks like,
  40 --
  41 --   \<forecast gamedate=\"Monday, December 30th\"\>
  42 --
  43 --   When unpickling we get rid of the suffixes \"st\", \"nd\", \"rd\", and
  44 --   \"th\". During pickling, we add them back based on the last digit
  45 --   of the date.
  46 --
  47 xp_gamedate :: PU UTCTime
  48 xp_gamedate =
  49   (to_gamedate, from_gamedate) `xpWrapMaybe` xpText
  50   where
  51     format = "%A, %B %-d"
  52
  53     to_gamedate :: String -> Maybe UTCTime
  54     to_gamedate s =
  55       parseTime defaultTimeLocale format s'
  56       where
  57         s' = case (reverse s) of
  58                (c2:c1:cs) -> let suffix = [c1,c2]
  59                              in
  60                                case suffix of
  61                                  "st" -> reverse cs
  62                                  "nd" -> reverse cs
  63                                  "rd" -> reverse cs
  64                                  "th" -> reverse cs
  65                                  _    -> s -- Unknown suffix, leave it alone.
  66                _ -> s -- The String is less than two characters long,
  67                       -- leave it alone.
  68
  69
  70     from_gamedate :: UTCTime -> String
  71     from_gamedate d = s ++ (suffix s)
  72       where
  73         s = formatTime defaultTimeLocale format d
  74
  75         suffix :: String -> String
  76         suffix cs =
  77           case (reverse cs) of
  78             []       -> []
  79             ('1':_) -> "st"
  80             ('2':_) -> "nd"
  81             ('3':_) -> "rd"
  82             _        -> "th"
  83
  84
  85
  86 -- | The time format string used in 'xp_time' and 'xp_time_stamp'.
  87 --
  88 xp_time_format :: String
  89 xp_time_format = "%I:%M %p"
  90
  91
  92 -- | (Un)pickle a UTCTime without the date portion.
  93 --
  94 xp_time :: PU UTCTime
  95 xp_time =
  96   (to_time, from_time) `xpWrapMaybe` xpText
  97   where
  98     to_time :: String -> Maybe UTCTime
  99     to_time = parseTime defaultTimeLocale xp_time_format
 100
 101     from_time :: UTCTime -> String
 102     from_time = formatTime defaultTimeLocale xp_time_format
 103
 104
 105 -- | (Un)pickle a UTCTime without the date portion, allowing for a
 106 --   value of \"TBA\" (which gets translated to 'Nothing').
 107 --
 108 xp_tba_time :: PU (Maybe UTCTime)
 109 xp_tba_time =
 110   (to_time, from_time) `xpWrap` xpText
 111   where
 112     to_time :: String -> Maybe UTCTime
 113     to_time s
 114       | s == "TBA" = Nothing
 115       | otherwise = parseTime defaultTimeLocale xp_time_format s
 116
 117     from_time :: Maybe UTCTime -> String
 118     from_time Nothing = ""
 119     from_time (Just t) = formatTime defaultTimeLocale xp_time_format t
 120
 121
 122 -- | (Un)pickle the \<time_stamp\> element format to/from a 'UTCTime'.
 123 --
 124 --   Example:  \<time_stamp\> January 6, 2014, at 10:11 PM ET \</time_stamp\>
 125 --
 126 --   TSN doesn't provide a proper time zone name, so we assume that
 127 --   it's always Eastern Standard Time. EST is UTC-5, so we
 128 --   add/subtract 5 hours to convert to/from UTC.
 129 --
 130 xp_time_stamp :: PU UTCTime
 131 xp_time_stamp =
 132   (to_time_stamp, from_time_stamp) `xpWrapMaybe` xpText
 133   where
 134     -- This omits the timezone and trailing space.
 135     format = "%B %-d, %Y, at " ++ xp_time_format ++ " ET"
 136
 137     five_hours :: NominalDiffTime
 138     five_hours = 5 * 60 * 60
 139
 140     add_five :: UTCTime -> UTCTime
 141     add_five = addUTCTime five_hours
 142
 143     subtract_five :: UTCTime -> UTCTime
 144     subtract_five = addUTCTime (-1 * five_hours)
 145
 146     to_time_stamp :: String -> Maybe UTCTime
 147     to_time_stamp = fmap add_five . parseTime defaultTimeLocale format
 148
 149     from_time_stamp :: UTCTime -> String
 150     from_time_stamp = formatTime defaultTimeLocale format . subtract_five