X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FPicklers.hs;h=ea335c81f2894e8de38a44bddea3c5b2938f82c4;hb=d7e4dbd6211fa1f869d22892747db424ea103577;hp=e188953eb952ced6840d67ab892b0400482f02c8;hpb=4f5008904b96579e6653e19ddaccc5d53824ab04;p=dead%2Fhtsn-import.git diff --git a/src/TSN/Picklers.hs b/src/TSN/Picklers.hs index e188953..ea335c8 100644 --- a/src/TSN/Picklers.hs +++ b/src/TSN/Picklers.hs @@ -3,13 +3,19 @@ -- module TSN.Picklers ( xp_date, + xp_date_padded, + xp_earnings, xp_gamedate, + xp_racedate, xp_tba_time, xp_time, xp_time_stamp ) where -- System imports. +import Data.List ( intercalate ) +import Data.List.Split ( chunksOf ) +import Data.String.Utils ( replace ) import Data.Time.Clock ( NominalDiffTime, UTCTime, addUTCTime ) import Data.Time.Format ( formatTime, parseTime ) import System.Locale ( defaultTimeLocale ) @@ -19,6 +25,35 @@ import Text.XML.HXT.Arrow.Pickle ( xpWrapMaybe ) import Text.XML.HXT.Arrow.Pickle.Xml ( PU ) +-- Local imports. +import TSN.Parse ( + parse_time_stamp, + time_format, + time_stamp_format ) + + +-- | 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. -- @@ -26,13 +61,98 @@ 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 + + + +-- | Format a number as a string using a comma as the thousands +-- separator. +-- +-- Examples: +-- +-- >>> format_commas 0 +-- "0" +-- >>> format_commas 10 +-- "10" +-- >>> format_commas 100 +-- "100" +-- >>> format_commas 1000 +-- "1,000" +-- >>> format_commas 10000 +-- "10,000" +-- >>> format_commas 100000 +-- "100,000" +-- >>> format_commas 1000000 +-- "1,000,000" +-- +format_commas :: Int -> String +format_commas x = + reverse (intercalate "," $ chunksOf 3 $ reverse $ show x) + +-- | 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 = Just $ (read . strip_commas) s + + from_earnings :: Maybe Int -> String + from_earnings Nothing = "TBA" + from_earnings (Just i) = format_commas i + + +-- | (Un)pickle a 'UTCTime' from a \ element in an +-- 'AutoRaceResults' message. +-- +-- Examples: +-- +-- * \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 @@ -83,10 +203,7 @@ xp_gamedate = --- | The time format string used in 'xp_time' and 'xp_time_stamp'. --- -xp_time_format :: String -xp_time_format = "%I:%M %p" + -- | (Un)pickle a UTCTime without the date portion. @@ -96,10 +213,10 @@ xp_time = (to_time, from_time) `xpWrapMaybe` xpText where to_time :: String -> Maybe UTCTime - to_time = parseTime defaultTimeLocale xp_time_format + to_time = parseTime defaultTimeLocale time_format from_time :: UTCTime -> String - from_time = formatTime defaultTimeLocale xp_time_format + from_time = formatTime defaultTimeLocale time_format -- | (Un)pickle a UTCTime without the date portion, allowing for a @@ -112,11 +229,12 @@ xp_tba_time = to_time :: String -> Maybe UTCTime to_time s | s == "TBA" = Nothing - | otherwise = parseTime defaultTimeLocale xp_time_format s + | otherwise = parseTime defaultTimeLocale time_format s from_time :: Maybe UTCTime -> String - from_time Nothing = "" - from_time (Just t) = formatTime defaultTimeLocale xp_time_format t + from_time Nothing = "TBA" + from_time (Just t) = formatTime defaultTimeLocale time_format t + -- | (Un)pickle the \ element format to/from a 'UTCTime'. @@ -129,22 +247,14 @@ xp_tba_time = -- xp_time_stamp :: PU UTCTime xp_time_stamp = - (to_time_stamp, from_time_stamp) `xpWrapMaybe` xpText + (parse_time_stamp, from_time_stamp) `xpWrapMaybe` xpText where - -- This omits the timezone and trailing space. - format = "%B %-d, %Y, at " ++ xp_time_format ++ " ET" - five_hours :: NominalDiffTime five_hours = 5 * 60 * 60 - add_five :: UTCTime -> UTCTime - add_five = addUTCTime five_hours - subtract_five :: UTCTime -> UTCTime subtract_five = addUTCTime (-1 * five_hours) - to_time_stamp :: String -> Maybe UTCTime - to_time_stamp = fmap add_five . parseTime defaultTimeLocale format - from_time_stamp :: UTCTime -> String - from_time_stamp = formatTime defaultTimeLocale format . subtract_five + from_time_stamp = + formatTime defaultTimeLocale time_stamp_format . subtract_five