X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FPicklers.hs;h=09c3a3b1000ac983251108afb5e570bdb40eb8c5;hb=6eb1c7477c2d4d3cace6d1b865a5efbec21300a7;hp=a64db8a2023760375ac467d888b45f96294d7322;hpb=acd67d75aab3f2350b488fe6402bc0a20e476a18;p=dead%2Fhtsn-import.git diff --git a/src/TSN/Picklers.hs b/src/TSN/Picklers.hs index a64db8a..09c3a3b 100644 --- a/src/TSN/Picklers.hs +++ b/src/TSN/Picklers.hs @@ -7,7 +7,9 @@ module TSN.Picklers ( xp_date, xp_date_padded, xp_datetime, + xp_early_line_date, xp_earnings, + xp_fracpart_only_double, xp_gamedate, xp_tba_time, xp_time, @@ -16,15 +18,18 @@ module TSN.Picklers ( where -- System imports. +import Data.Char ( toUpper ) import Data.List ( intercalate ) import Data.List.Split ( chunksOf ) +import Data.Maybe ( catMaybes, listToMaybe ) import Data.String.Utils ( replace ) -import Data.Time.Clock ( NominalDiffTime, UTCTime, addUTCTime ) +import Data.Time.Clock ( UTCTime ) import Data.Time.Format ( formatTime, parseTime ) import Data.Tree.NTree.TypeDefs ( NTree(..) ) -import System.Locale ( defaultTimeLocale ) +import System.Locale ( TimeLocale( wDays, months ), defaultTimeLocale ) import Test.Tasty ( TestTree, testGroup ) import Test.Tasty.HUnit ( (@?=), testCase ) +import Text.Read ( readMaybe ) import Text.XML.HXT.Arrow.Pickle ( xpText, xpWrap, @@ -104,6 +109,10 @@ xp_date = -- >>> unpickleDoc xp_date_padded tn -- Just 1983-02-15 00:00:00 UTC -- +-- >>> let tn = text_node "06/07/2014" +-- >>> unpickleDoc xp_date_padded tn +-- Just 2014-06-07 00:00:00 UTC +-- xp_date_padded :: PU UTCTime xp_date_padded = (to_date, from_date) `xpWrapMaybe` xpText @@ -141,6 +150,7 @@ format_commas x = reverse (intercalate "," $ chunksOf 3 $ reverse $ show x) + -- | Parse \ from an 'AutoRaceResultsListing'. These are -- essentially 'Int's, but they look like, -- @@ -178,6 +188,45 @@ xp_earnings = +-- | Pickle a 'Double' that can be missing its leading zero (for +-- values less than one). For example, we've seen, +-- +-- 0.5 +-- +-- Which 'xpPrim' can't handle without the leading +-- zero. Unfortunately there's no way pickle/unpickle can be +-- inverses of each other here, since \"0.5\" and \".5\" should +-- unpickle to the same 'Double'. +-- +-- Examples: +-- +-- >>> let tn = text_node "0.5" +-- >>> unpickleDoc xp_fracpart_only_double tn +-- Just 0.5 +-- +-- >>> let tn = text_node ".5" +-- >>> unpickleDoc xp_fracpart_only_double tn +-- Just 0.5 +-- +-- >>> let tn = text_node "foo" +-- >>> unpickleDoc xp_fracpart_only_double tn +-- Nothing +-- +xp_fracpart_only_double :: PU Double +xp_fracpart_only_double = + (to_double, from_double) `xpWrapMaybe` xpText + where + -- | Convert a 'String' to a 'Double', maybe. We always prepend a + -- zero, since it will fix the fraction-only values, and not hurt + -- the ones that already have a leading integer. + to_double :: String -> Maybe Double + to_double s = readMaybe ("0" ++ s) + + from_double :: Double -> String + from_double = show + + + -- | (Un)pickle an unpadded 'UTCTime'. Used for example on the -- \ elements in an 'AutoRaceResults' message. -- @@ -211,6 +260,37 @@ xp_datetime = from_datetime = formatTime defaultTimeLocale format + +-- | Takes a 'UTCTime', and returns the English suffix that would be +-- appropriate after the day of the month. For example, if we have a +-- UTCTime representing Christmas, this would return \"th\" because +-- \"th\" is the right suffix of \"December 25th\". +-- +-- Examples: +-- +-- >>> import Data.Maybe ( fromJust ) +-- >>> :{ +-- let parse_date :: String -> Maybe UTCTime; +-- parse_date = parseTime defaultTimeLocale date_format; +-- :} +-- +-- >>> let dates = [ "1/" ++ (d : "/1970") | d <- ['1'..'9'] ] +-- >>> let suffixes = map (date_suffix . fromJust . parse_date) dates +-- >>> suffixes +-- ["st","nd","rd","th","th","th","th","th","th"] +-- +date_suffix :: UTCTime -> String +date_suffix t = + case (reverse daystr) of + [] -> [] + ('1':_) -> "st" + ('2':_) -> "nd" + ('3':_) -> "rd" + _ -> "th" + where + daystr = formatTime defaultTimeLocale "%d" t + + -- | (Un)pickle a UTCTime from a weather forecast's gamedate. Example -- input looks like, -- @@ -240,29 +320,19 @@ xp_gamedate = 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. + if suffix `elem` ["st","nd","rd","th"] + then reverse cs + else 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) + from_gamedate d = s ++ (date_suffix d) where s = formatTime defaultTimeLocale format d - suffix :: String -> String - suffix cs = - case (reverse cs) of - [] -> [] - ('1':_) -> "st" - ('2':_) -> "nd" - ('3':_) -> "rd" - _ -> "th" @@ -384,29 +454,30 @@ xp_tba_time = -- -- \ 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. +-- TSN doesn't provide a proper time zone name, only \"ET\" for +-- \"Eastern Time\". But \"Eastern Time\" changes throughout the +-- year, depending on one's location, for daylight-savings +-- time. It's really not any more useful to be off by one hour than +-- it is to be off by 5 hours, so rather than guess at EDT/EST, we +-- just store the timestamp as UTC. -- -- Examples: -- -- >>> let tn = text_node " January 6, 2014, at 10:11 PM ET " --- >>> unpickleDoc xp_time_stamp tn --- Just 2014-01-07 03:11:00 UTC +-- >>> let (Just tstamp) = unpickleDoc xp_time_stamp tn +-- >>> tstamp +-- 2014-01-06 22:11:00 UTC +-- >>> pickleDoc xp_time_stamp tstamp +-- NTree (XTag "/" []) [NTree (XText " January 6, 2014, at 10:11 PM ET ") []] -- 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 + formatTime defaultTimeLocale time_stamp_format + -- | (Un)pickle an ambiguous 12-hour AM/PM time, which is ambiguous @@ -433,6 +504,69 @@ xp_ambiguous_time = formatTime defaultTimeLocale ambiguous_time_format +-- | Pickle a date value from a \ element as they appear in the +-- early lines. This is a particularly wacky format, but then so is +-- the associated time (see 'xp_ambiguous_time'). +-- +-- Examples: +-- +-- >>> let tn = text_node "SUNDAY, MAY 25TH (05/25/2014)" +-- >>> let (Just result) = unpickleDoc xp_early_line_date tn +-- >>> result +-- 2014-05-25 00:00:00 UTC +-- >>> pickleDoc xp_early_line_date result +-- NTree (XTag "/" []) [NTree (XText "SUNDAY, MAY 25TH (05/25/2014)") []] +-- +-- >>> let tn = text_node "SATURDAY, JUNE 7TH (06/07/2014)" +-- >>> let (Just result) = unpickleDoc xp_early_line_date tn +-- >>> result +-- 2014-06-07 00:00:00 UTC +-- >>> pickleDoc xp_early_line_date result +-- NTree (XTag "/" []) [NTree (XText "SATURDAY, JUNE 7TH (06/07/2014)") []] +-- +xp_early_line_date :: PU UTCTime +xp_early_line_date = + (to_time, from_time) `xpWrapMaybe` xpText + where + -- | We need to create our own time locale that talks IN ALL CAPS. + -- Actually, 'parseTime' doesn't seem to care about the + -- case. But when we spit it back out again ('formatTime'), + -- we'll want it to be in all caps. + -- + caps_time_locale :: TimeLocale + caps_time_locale = + defaultTimeLocale { wDays = caps_days, months = caps_months } + + caps_days :: [(String,String)] + caps_days = map both_to_upper (wDays defaultTimeLocale) + + caps_months :: [(String,String)] + caps_months = map both_to_upper (months defaultTimeLocale) + + both_to_upper :: (String,String) -> (String,String) + both_to_upper (s1,s2) = (map toUpper s1, map toUpper s2) + + wacko_date_formats :: [String] + wacko_date_formats = + ["%A, %B %-d" ++ suffix ++ " (" ++ date_format_padded ++ ")" | + suffix <- ["ST", "ND", "RD","TH"] ] + + to_time :: String -> Maybe UTCTime + to_time s = + listToMaybe $ catMaybes possible_parses + where + possible_parses = [ parseTime caps_time_locale fmt s | + fmt <- wacko_date_formats ] + + from_time :: UTCTime -> String + from_time t = + formatTime caps_time_locale fmt t + where + upper_suffix = map toUpper (date_suffix t) + fmt = "%A, %B %-d" ++ upper_suffix ++ " (" ++ date_format_padded ++ ")" + + + -- | Create an 'XmlTree' containing only the given text. This is -- useful for testing (un)picklers, where we don't want to have to -- bother to create a dummy XML document.