X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FPicklers.hs;h=387f4cf4fe4926d0c436678ca0e2ed509b075049;hb=8c663269b4a2981fd35b60dcaad8ba2de9915dc2;hp=5c31198779c29ec377b44d30de99395b6f4a77a6;hpb=dd4d3adf452823702f3376d1869b07e39f03bff2;p=dead%2Fhtsn-import.git diff --git a/src/TSN/Picklers.hs b/src/TSN/Picklers.hs index 5c31198..387f4cf 100644 --- a/src/TSN/Picklers.hs +++ b/src/TSN/Picklers.hs @@ -2,28 +2,53 @@ -- feed. -- module TSN.Picklers ( - xp_date ) + xp_date, + xp_date_padded, + xp_earnings, + xp_gamedate, + xp_racedate, + xp_tba_time, + xp_time, + xp_time_stamp ) where -import Data.Time.Clock ( UTCTime ) +-- System imports. +import Data.String.Utils ( replace ) +import Data.Time.Clock ( NominalDiffTime, UTCTime, addUTCTime ) import Data.Time.Format ( formatTime, parseTime ) import System.Locale ( defaultTimeLocale ) -import Text.Read ( readMaybe ) import Text.XML.HXT.Arrow.Pickle ( - XmlPickler(..), xpText, + xpWrap, xpWrapMaybe ) import Text.XML.HXT.Arrow.Pickle.Xml ( PU ) -instance XmlPickler Bool where - xpickle = - (to_bool, from_bool) `xpWrapMaybe` xpText - where - to_bool :: String -> Maybe Bool - to_bool = readMaybe +-- Local imports. +import TSN.Parse ( + parse_time_stamp, + time_format, + time_stamp_format ) - from_bool :: Bool -> String - from_bool = show + +-- | The format string for a base date in m/d/yyyy format. The +-- day/month are not padded at all. This will match for example, +-- +-- * 2/15/1983 +-- * 1/1/0000 +-- +date_format :: String +date_format = "%-m/%-d/%Y" + + +-- | The format string for a base date in mm/dd/yyyy format. The +-- day/month are padded to two characters with zeros. This will +-- match for example, +-- +-- * 02/15/1983 +-- * 01/01/0000 +-- +date_format_padded :: String +date_format_padded = "%0m/%0d/%Y" -- | (Un)pickle a UTCTime without the time portion. @@ -32,10 +57,172 @@ xp_date :: PU UTCTime xp_date = (to_date, from_date) `xpWrapMaybe` xpText where - format = "%-m/%-d/%Y" + to_date :: String -> Maybe UTCTime + to_date = parseTime defaultTimeLocale date_format + from_date :: UTCTime -> String + from_date = formatTime defaultTimeLocale date_format + + +-- | (Un)pickle a UTCTime without the time portion. The day/month are +-- padded to two characters with zeros. +-- +xp_date_padded :: PU UTCTime +xp_date_padded = + (to_date, from_date) `xpWrapMaybe` xpText + where to_date :: String -> Maybe UTCTime - to_date = parseTime defaultTimeLocale format + to_date = parseTime defaultTimeLocale date_format_padded from_date :: UTCTime -> String - from_date = formatTime defaultTimeLocale format + from_date = formatTime defaultTimeLocale date_format_padded + + +-- | Parse \ from an 'AutoRaceResultsListing'. These are +-- essentially 'Int's, but they look like, +-- +-- * 336,826 +-- * 1,000,191 +-- * TBA +-- +xp_earnings :: PU (Maybe Int) +xp_earnings = + (to_earnings, from_earnings) `xpWrap` xpText + where + strip_commas :: String -> String + strip_commas = replace "," "" + + to_earnings :: String -> Maybe Int + to_earnings s + | s == "TBA" = Nothing + | otherwise = (read . strip_commas . show) s + + from_earnings :: Maybe Int -> String + from_earnings Nothing = "" + from_earnings (Just i) = show i + + +-- | (Un)pickle a 'UTCTime' from a \ element in an +-- 'AutoRaceResults' message. +-- +-- Example: +-- +-- 6/1/2014 1:00:00 PM +-- 5/24/2014 2:45:00 PM +-- +xp_racedate :: PU UTCTime +xp_racedate = + (to_racedate, from_racedate) `xpWrapMaybe` xpText + where + format = date_format ++ " " ++ "%-I:%M:%S %p" + + to_racedate :: String -> Maybe UTCTime + to_racedate = parseTime defaultTimeLocale format + + from_racedate :: UTCTime -> String + from_racedate = formatTime defaultTimeLocale format + + +-- | (Un)pickle a UTCTime from a weather forecast's gamedate. Example +-- input looks like, +-- +-- \ +-- +-- When unpickling we get rid of the suffixes \"st\", \"nd\", \"rd\", and +-- \"th\". During pickling, we add them back based on the last digit +-- of the date. +-- +xp_gamedate :: PU UTCTime +xp_gamedate = + (to_gamedate, from_gamedate) `xpWrapMaybe` xpText + where + format = "%A, %B %-d" + + to_gamedate :: String -> Maybe UTCTime + to_gamedate s = + parseTime defaultTimeLocale format s' + where + s' = case (reverse s) of + (c2:c1:cs) -> let suffix = [c1,c2] + in + case suffix of + "st" -> reverse cs + "nd" -> reverse cs + "rd" -> reverse cs + "th" -> reverse cs + _ -> s -- Unknown suffix, leave it alone. + _ -> s -- The String is less than two characters long, + -- leave it alone. + + + from_gamedate :: UTCTime -> String + from_gamedate d = s ++ (suffix s) + where + s = formatTime defaultTimeLocale format d + + suffix :: String -> String + suffix cs = + case (reverse cs) of + [] -> [] + ('1':_) -> "st" + ('2':_) -> "nd" + ('3':_) -> "rd" + _ -> "th" + + + + + + +-- | (Un)pickle a UTCTime without the date portion. +-- +xp_time :: PU UTCTime +xp_time = + (to_time, from_time) `xpWrapMaybe` xpText + where + to_time :: String -> Maybe UTCTime + to_time = parseTime defaultTimeLocale time_format + + from_time :: UTCTime -> String + from_time = formatTime defaultTimeLocale time_format + + +-- | (Un)pickle a UTCTime without the date portion, allowing for a +-- value of \"TBA\" (which gets translated to 'Nothing'). +-- +xp_tba_time :: PU (Maybe UTCTime) +xp_tba_time = + (to_time, from_time) `xpWrap` xpText + where + to_time :: String -> Maybe UTCTime + to_time s + | s == "TBA" = Nothing + | otherwise = parseTime defaultTimeLocale time_format s + + from_time :: Maybe UTCTime -> String + from_time Nothing = "" + from_time (Just t) = formatTime defaultTimeLocale time_format t + + + +-- | (Un)pickle the \ element format to/from a 'UTCTime'. +-- +-- Example: \ January 6, 2014, at 10:11 PM ET \ +-- +-- TSN doesn't provide a proper time zone name, so we assume that +-- it's always Eastern Standard Time. EST is UTC-5, so we +-- add/subtract 5 hours to convert to/from UTC. +-- +xp_time_stamp :: PU UTCTime +xp_time_stamp = + (parse_time_stamp, from_time_stamp) `xpWrapMaybe` xpText + where + five_hours :: NominalDiffTime + five_hours = 5 * 60 * 60 + + subtract_five :: UTCTime -> UTCTime + subtract_five = addUTCTime (-1 * five_hours) + + from_time_stamp :: UTCTime -> String + from_time_stamp = + formatTime defaultTimeLocale time_stamp_format . subtract_five