X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FPicklers.hs;h=3863017c090018268dc67f93c8e34c3583667543;hb=e3ebe2e3e72155cd0e526386ac4eb970152255d7;hp=e188953eb952ced6840d67ab892b0400482f02c8;hpb=4f5008904b96579e6653e19ddaccc5d53824ab04;p=dead%2Fhtsn-import.git diff --git a/src/TSN/Picklers.hs b/src/TSN/Picklers.hs index e188953..3863017 100644 --- a/src/TSN/Picklers.hs +++ b/src/TSN/Picklers.hs @@ -2,14 +2,22 @@ -- feed. -- module TSN.Picklers ( + xp_ambiguous_time, xp_date, + xp_date_padded, + xp_datetime, + xp_earnings, xp_gamedate, xp_tba_time, xp_time, + xp_time_dots, 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 +27,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 +63,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 an unpadded 'UTCTime'. Used for example on the +-- \ elements in an 'AutoRaceResults' message. +-- +-- Examples: +-- +-- * \6/1/2014 1:00:00 PM\ +-- +-- * \5/24/2014 2:45:00 PM\ +-- +xp_datetime :: PU UTCTime +xp_datetime = + (to_datetime, from_datetime) `xpWrapMaybe` xpText + where + format = date_format ++ " " ++ "%-I:%M:%S %p" + + to_datetime :: String -> Maybe UTCTime + to_datetime = parseTime defaultTimeLocale format + + from_datetime :: UTCTime -> String + from_datetime = formatTime defaultTimeLocale format -- | (Un)pickle a UTCTime from a weather forecast's gamedate. Example @@ -83,10 +205,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 +215,36 @@ 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. This differs from +-- 'xp_time' in that it uses periods in the AM/PM part, i.e. \"A.M.\" +-- and \"P.M.\" It also doesn't use padding for the \"hours\" part. +-- +-- Examples: +-- +-- * \11:30 A.M.\ +-- +xp_time_dots :: PU UTCTime +xp_time_dots = + (to_time, from_time) `xpWrapMaybe` xpText + where + -- | The hours arent padded with zeros. + nopad_time_format :: String + nopad_time_format = "%-I:%M %p" + + to_time :: String -> Maybe UTCTime + to_time = (parseTime defaultTimeLocale nopad_time_format) . (replace "." "") + + from_time :: UTCTime -> String + from_time t = + replace "AM" "A.M." (replace "PM" "P.M." s) + where + s = formatTime defaultTimeLocale nopad_time_format t -- | (Un)pickle a UTCTime without the date portion, allowing for a @@ -112,11 +257,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 +275,34 @@ 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 + + +-- | (Un)pickle an ambiguous 12-hour AM/PM time, which is ambiguous +-- because it's missing the AM/PM part. +-- +-- Examples: +-- +xp_ambiguous_time :: PU UTCTime +xp_ambiguous_time = + (to_time, from_time) `xpWrapMaybe` xpText + where + ambiguous_time_format :: String + ambiguous_time_format = "%-I:%M" + + to_time :: String -> Maybe UTCTime + to_time = parseTime defaultTimeLocale ambiguous_time_format + + from_time :: UTCTime -> String + from_time = + formatTime defaultTimeLocale ambiguous_time_format