Add the 'xp_attr_option' pickler and use it to fix tests broken by HXT.

diff --git a/src/TSN/Picklers.hs b/src/TSN/Picklers.hs
index 5e620699bbfdc43e53181511493be47f433349ba..3135d6ae194d483f3704755d46063cc513393808 100644 (file)
--- 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 796418f716b865c66afa38b1ab6b38e4f1bbf2bc..7f5a89048d93afb202237aa03f746e0d41cfaa82 100644 (file)
--- 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 77dc74a7f880e4d84e7602a91a4a05d2716f8d06..54169b982b00d278717d89e2a1042bde14cc6faf 100644 (file)
--- 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 bedb6882b55d3581c8b8651f110a1b9fe335aa2c..95aecbed22767a28fb03a071e94790ff2e7003b7 100644 (file)
--- 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 76bf563b09a8ae78be8418c8d79232ab5e5ffa82..aa847a837ee1d9dc68a47c01c10db2668506da43 100644 (file)
--- 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