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 where
   9
  10 -- System imports.
  11 import Data.Time.Clock ( UTCTime )
  12 import Data.Time.Format ( formatTime, parseTime )
  13 import System.Locale ( defaultTimeLocale )
  14 import Text.XML.HXT.Arrow.Pickle (
  15   xpText,
  16   xpWrapMaybe )
  17 import Text.XML.HXT.Arrow.Pickle.Xml ( PU )
  18
  19
  20 -- | (Un)pickle a UTCTime without the time portion.
  21 --
  22 xp_date :: PU UTCTime
  23 xp_date =
  24   (to_date, from_date) `xpWrapMaybe` xpText
  25   where
  26     format = "%-m/%-d/%Y"
  27
  28     to_date :: String -> Maybe UTCTime
  29     to_date = parseTime defaultTimeLocale format
  30
  31     from_date :: UTCTime -> String
  32     from_date = formatTime defaultTimeLocale format
  33
  34
  35 -- | (Un)pickle a UTCTime from a weather forecast's gamedate. Example
  36 --   input looks like,
  37 --
  38 --   \<forecast gamedate=\"Monday, December 30th\"\>
  39 --
  40 --   When unpickling we get rid of the suffixes \"st\", \"nd\", \"rd\", and
  41 --   \"th\". During pickling, we add them back based on the last digit
  42 --   of the date.
  43 --
  44 xp_gamedate :: PU UTCTime
  45 xp_gamedate =
  46   (to_gamedate, from_gamedate) `xpWrapMaybe` xpText
  47   where
  48     format = "%A, %B %-d"
  49
  50     to_gamedate :: String -> Maybe UTCTime
  51     to_gamedate s =
  52       parseTime defaultTimeLocale format s'
  53       where
  54         s' = case (reverse s) of
  55                (c2:c1:cs) -> let suffix = [c1,c2]
  56                              in
  57                                case suffix of
  58                                  "st" -> reverse cs
  59                                  "nd" -> reverse cs
  60                                  "rd" -> reverse cs
  61                                  "th" -> reverse cs
  62                                  _    -> s -- Unknown suffix, leave it alone.
  63                _ -> s -- The String is less than two characters long,
  64                       -- leave it alone.
  65
  66
  67     from_gamedate :: UTCTime -> String
  68     from_gamedate d = s ++ (suffix s)
  69       where
  70         s = formatTime defaultTimeLocale format d
  71
  72         suffix :: String -> String
  73         suffix cs =
  74           case (reverse cs) of
  75             []       -> []
  76             ('1':_) -> "st"
  77             ('2':_) -> "nd"
  78             ('3':_) -> "rd"
  79             _        -> "th"
  80
  81
  82 -- | (Un)pickle a UTCTime without the date portion.
  83 --
  84 xp_time :: PU UTCTime
  85 xp_time =
  86   (to_time, from_time) `xpWrapMaybe` xpText
  87   where
  88     format = "%I:%M %p"
  89
  90     to_time :: String -> Maybe UTCTime
  91     to_time = parseTime defaultTimeLocale format
  92
  93     from_time :: UTCTime -> String
  94     from_time = formatTime defaultTimeLocale format
  95