X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FPicklers.hs;h=4f0020b6ad167123c10a66224a0b5092f09b8489;hb=HEAD;hp=09c3a3b1000ac983251108afb5e570bdb40eb8c5;hpb=6eb1c7477c2d4d3cace6d1b865a5efbec21300a7;p=dead%2Fhtsn-import.git

diff --git a/src/TSN/Picklers.hs b/src/TSN/Picklers.hs
index 09c3a3b..4f0020b 100644
--- a/src/TSN/Picklers.hs
+++ b/src/TSN/Picklers.hs
@@ -1,9 +1,12 @@
+{-# 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,
@@ -11,6 +14,7 @@ module TSN.Picklers (
   xp_earnings,
   xp_fracpart_only_double,
   xp_gamedate,
+  xp_tba_int,
   xp_tba_time,
   xp_time,
   xp_time_dots,
@@ -270,8 +274,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'] ]
@@ -448,6 +452,46 @@ xp_tba_time =
     from_time (Just t) = formatTime defaultTimeLocale time_format t
 
 
+-- | (Un)pickle a 'Int', allowing for a value of \"TBA\" (which gets
+--   translated to 'Nothing').
+--
+--   /Examples/:
+--
+--   A failed parse will return 'Nothing':
+--
+--   >>> let tn = text_node "YO"
+--   >>> unpickleDoc xp_tba_int tn
+--   Just Nothing
+--
+--   And so will parsing a \"TBA\":
+--
+--   >>> let tn = text_node "TBA"
+--   >>> unpickleDoc xp_tba_int tn
+--   Just Nothing
+--
+--   But re-pickling 'Nothing' gives only \"TBA\":
+--
+--   >>> pickleDoc xp_tba_int Nothing
+--   NTree (XTag "/" []) [NTree (XText "TBA") []]
+--
+--   A normal integer is also parsed successfully, of course:
+--
+--   >>> let tn = text_node "110"
+--   >>> unpickleDoc xp_tba_int tn
+--   Just (Just 110)
+--
+xp_tba_int :: PU (Maybe Int)
+xp_tba_int =
+  (to_int, from_int) `xpWrap` xpText
+  where
+    to_int :: String -> Maybe Int
+    to_int = readMaybe
+
+    from_int :: Maybe Int -> String
+    from_int Nothing = "TBA"
+    from_int (Just t) = show t
+
+
 
 -- | (Un)pickle the \<time_stamp\> element format to/from a 'UTCTime'.
 --   The time_stamp elements look something like,
@@ -474,9 +518,12 @@ xp_time_stamp :: PU UTCTime
 xp_time_stamp =
   (parse_time_stamp, from_time_stamp) `xpWrapMaybe` xpText
   where
+    -- | 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
+      formatTime defaultTimeLocale (" " ++ time_stamp_format ++ " ")
 
 
 
@@ -566,6 +613,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