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