From f0425854304197ab5ad47293b27b2e0b188cb844 Mon Sep 17 00:00:00 2001
From: Michael Orlitzky <michael@orlitzky.com>
Date: Mon, 23 Feb 2015 10:25:56 -0500
Subject: [PATCH] Add the 'xp_attr_option' pickler and use it to fix tests
 broken by HXT.

---
 src/TSN/Picklers.hs      | 20 ++++++++++++++++++++
 src/TSN/XML/EarlyLine.hs |  3 ++-
 src/TSN/XML/News.hs      |  4 ++--
 src/TSN/XML/Odds.hs      |  8 ++++++--
 src/TSN/XML/Scores.hs    |  4 ++--
 5 files changed, 32 insertions(+), 7 deletions(-)

diff --git a/src/TSN/Picklers.hs b/src/TSN/Picklers.hs
index 5e62069..3135d6a 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,
@@ -569,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
diff --git a/src/TSN/XML/EarlyLine.hs b/src/TSN/XML/EarlyLine.hs
index 796418f..7f5a890 100644
--- a/src/TSN/XML/EarlyLine.hs
+++ b/src/TSN/XML/EarlyLine.hs
@@ -71,6 +71,7 @@ import TSN.Codegen ( tsn_codegen_config )
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
 import TSN.Picklers (
   xp_ambiguous_time,
+  xp_attr_option,
   xp_early_line_date,
   xp_time_stamp )
 import TSN.XmlImport ( XmlImport(..) )
@@ -559,7 +560,7 @@ pickle_home_team = xpElem "teamH" pickle_team
 pickle_team :: PU EarlyLineGameTeamXml
 pickle_team =
   xpWrap (from_tuple, to_tuple') $
-  xp6Tuple (xpAttr "rotation" (xpOption xpInt))
+  xp6Tuple (xpAttr "rotation" xp_attr_option)
            (xpOption $ xpAttr "line" (xpOption xpText))
            (xpOption $ xpAttr "name" xpText)
            (xpOption xpText)
diff --git a/src/TSN/XML/News.hs b/src/TSN/XML/News.hs
index 77dc74a..54169b9 100644
--- a/src/TSN/XML/News.hs
+++ b/src/TSN/XML/News.hs
@@ -72,7 +72,7 @@ import TSN.Codegen (
 import TSN.Database ( insert_or_select )
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
 import TSN.Location ( Location(..), pickle_location )
-import TSN.Picklers ( xp_time_stamp )
+import TSN.Picklers ( xp_attr_option, xp_time_stamp )
 import TSN.Team ( Team(..) )
 import TSN.XmlImport ( XmlImport(..) )
 import Xml (
@@ -389,7 +389,7 @@ pickle_msg_id :: PU MsgId
 pickle_msg_id =
   xpElem "msg_id" $
     xpWrap (from_tuple, H.convert) $
-    xpPair xpInt (xpAttr "EventId" (xpOption xpInt))
+    xpPair xpInt (xpAttr "EventId" xp_attr_option)
   where
     from_tuple = uncurryN MsgId
 
diff --git a/src/TSN/XML/Odds.hs b/src/TSN/XML/Odds.hs
index bedb688..95aecbe 100644
--- a/src/TSN/XML/Odds.hs
+++ b/src/TSN/XML/Odds.hs
@@ -66,7 +66,11 @@ import Text.XML.HXT.Core (
 import TSN.Codegen ( tsn_codegen_config )
 import TSN.Database ( insert_or_select )
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
-import TSN.Picklers ( xp_date_padded, xp_tba_time, xp_time_stamp )
+import TSN.Picklers (
+  xp_attr_option,
+  xp_date_padded,
+  xp_tba_time,
+  xp_time_stamp )
 import TSN.Team ( FromXmlFkTeams(..), Team(..) )
 import TSN.XmlImport ( XmlImport(..), XmlImportFkTeams(..) )
 import Xml (
@@ -648,7 +652,7 @@ pickle_casino =
   xpElem "Casino" $
   xpWrap (from_tuple, H.convert) $
   xpTriple
-    (xpAttr "ClientID" $ xpOption xpInt)
+    (xpAttr "ClientID" $ xp_attr_option)
     (xpAttr "Name" $ xpOption xpText)
     (xpOption xpText)
   where
diff --git a/src/TSN/XML/Scores.hs b/src/TSN/XML/Scores.hs
index 76bf563..aa847a8 100644
--- a/src/TSN/XML/Scores.hs
+++ b/src/TSN/XML/Scores.hs
@@ -61,7 +61,7 @@ import TSN.Codegen ( tsn_codegen_config )
 import TSN.Database ( insert_or_select )
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
 import TSN.Location ( Location(..), pickle_location )
-import TSN.Picklers ( xp_time_stamp )
+import TSN.Picklers ( xp_attr_option, xp_time_stamp )
 import TSN.Team (
   FromXmlFkTeams(..),
   HTeam(..),
@@ -444,7 +444,7 @@ pickle_status :: PU ScoreGameStatus
 pickle_status =
   xpElem "status" $
     xpWrap (from_tuple, to_tuple') $
-      xpTriple (xpAttr "numeral" $ xpOption xpInt)
+      xpTriple (xpAttr "numeral" $ xp_attr_option)
                (xpOption $ xpAttr "type" $ xpOption xpText)
                xpText
   where
-- 
2.43.2