]> gitweb.michael.orlitzky.com - dead/htsn-import.git/blobdiff - src/TSN/Picklers.hs
Add the 'xp_attr_option' pickler and use it to fix tests broken by HXT.
[dead/htsn-import.git] / src / TSN / Picklers.hs
index 3d7215a07744436055a7eff73a8169201d394301..3135d6ae194d483f3704755d46063cc513393808 100644 (file)
@@ -1,14 +1,18 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
 -- | (Un)picklers for data types present in The Sports Network XML
 --   feed.
 --
 module TSN.Picklers (
   pickler_tests,
   xp_ambiguous_time,
+  xp_attr_option,
   xp_date,
   xp_date_padded,
   xp_datetime,
   xp_early_line_date,
   xp_earnings,
+  xp_fracpart_only_double,
   xp_gamedate,
   xp_tba_time,
   xp_time,
@@ -22,12 +26,13 @@ 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 ( 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,
@@ -148,6 +153,7 @@ format_commas x =
   reverse (intercalate "," $ chunksOf 3 $ reverse $ show x)
 
 
+
 -- | Parse \<Earnings\> from an 'AutoRaceResultsListing'. These are
 --   essentially 'Int's, but they look like,
 --
@@ -185,6 +191,45 @@ xp_earnings =
 
 
 
+-- | Pickle a 'Double' that can be missing its leading zero (for
+--   values less than one). For example, we've seen,
+--
+--   <TrackLength KPH=".805">0.5</TrackLength>
+--
+--   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
 --   \<RaceDate\> elements in an 'AutoRaceResults' message.
 --
@@ -228,8 +273,8 @@ xp_datetime =
 --
 --   >>> import Data.Maybe ( fromJust )
 --   >>> :{
---         let parse_date :: String -> Maybe UTCTime;
---         parse_date = parseTime defaultTimeLocale date_format;
+--         let parse_date :: String -> Maybe UTCTime
+--             parse_date = parseTime defaultTimeLocale date_format
 --       :}
 --
 --   >>> let dates = [ "1/" ++ (d : "/1970") | d <- ['1'..'9'] ]
@@ -412,29 +457,33 @@ xp_tba_time =
 --
 --   \<time_stamp\> January 6, 2014, at 10:11 PM ET \</time_stamp\>
 --
---   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)
-
+    -- | We have to re-pad the time_stamp_format with a leading and
+    --   trailing space; see the documentation of 'time_stamp_format'
+    --   for more information.
     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
@@ -523,6 +572,23 @@ xp_early_line_date =
         fmt = "%A, %B %-d" ++ upper_suffix ++ " (" ++ date_format_padded ++ ")"
 
 
+-- | This is a replacement for @xpOption xpFoo@ within an 'xpAttr'.
+--   There's a bug <https://github.com/UweSchmidt/hxt/issues/39> in
+--   newer versions of HXT that prevents us from using the usual
+--   'xpOption' solution, so this is our stopgap. It should work on
+--   any type that can be unpickled with a plain read/show.
+--
+xp_attr_option ::  forall a. (Read a, Show a) => PU (Maybe a)
+xp_attr_option =
+  (to_a, from_a) `xpWrap` xpText
+  where
+    to_a :: String -> Maybe a
+    to_a = readMaybe
+
+    from_a :: Maybe a -> String
+    from_a Nothing  = ""
+    from_a (Just x) = show x
+
 
 -- | Create an 'XmlTree' containing only the given text. This is
 --   useful for testing (un)picklers, where we don't want to have to