Make the Scores status numeral optional.

Enable parsing of present-but-empty Scores status type.

diff --git a/src/TSN/XML/Scores.hs b/src/TSN/XML/Scores.hs
index 372f1be9f7e6c47b4f5322d71fdaf48874cc22c3..8bfb19669f501d99925548522b8247c4bdfb1be6 100644 (file)
--- a/src/TSN/XML/Scores.hs
+++ b/src/TSN/XML/Scores.hs
@@ -159,7 +159,7 @@ instance XmlImport Message
 --
 data ScoreGameStatus =
   ScoreGameStatus {
-    db_status_numeral :: Int,
+    db_status_numeral :: Maybe Int,
     db_status_type :: Maybe String, -- ^ These are probably only one-character,
                                     --   long, but they all take the same
                                     --    amount of space in Postgres.
@@ -431,20 +431,26 @@ pickle_message =
 
 
 
--- | Convert a 'ScoreGameStatus' to/from \<status\>.
+-- | Convert a 'ScoreGameStatus' to/from \<status\>. The \"type\"
+--   attribute can be either missing or empty, so we're really parsing
+--   a double-Maybe here. We use the monad join to collapse it into
+--   one. See also: the hteam/vteam picklers.
 --
 pickle_status :: PU ScoreGameStatus
 pickle_status =
   xpElem "status" $
     xpWrap (from_tuple, to_tuple) $
-      xpTriple (xpAttr "numeral" xpInt)
-               (xpOption $ xpAttr "type" xpText)
+      xpTriple (xpAttr "numeral" $ xpOption xpInt)
+               (xpOption $ xpAttr "type" $ xpOption xpText)
                xpText
   where
-    from_tuple = uncurryN ScoreGameStatus
-    to_tuple ScoreGameStatus{..} = (db_status_numeral,
-                                    db_status_type,
-                                    db_status_text)
+    from_tuple (x,y,z) = ScoreGameStatus x (join y) z
+    to_tuple ScoreGameStatus{..} =
+      (db_status_numeral, s, db_status_text)
+      where
+      s = case db_status_type of
+            Nothing -> Nothing
+            Just _  -> Just db_status_type
 
 
 -- | Convert a 'ScoreGameXml' to/from \<game\>.
@@ -552,7 +558,13 @@ test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests"
           "test/xml/scoresxml-no-locations.xml",
 
     check "pickle composed with unpickle is the identity (pitcher, no type)"
-          "test/xml/scoresxml-pitcher-no-type.xml"]
+          "test/xml/scoresxml-pitcher-no-type.xml",
+
+    check "pickle composed with unpickle is the identity (empty numeral)"
+          "test/xml/scoresxml-empty-numeral.xml",
+
+    check "pickle composed with unpickle is the identity (empty type)"
+          "test/xml/scoresxml-empty-type.xml" ]
   where
     check desc path = testCase desc $ do
       (expected, actual) <- pickle_unpickle pickle_message path
@@ -570,7 +582,13 @@ test_unpickle_succeeds = testGroup "unpickle tests"
           "test/xml/scoresxml-no-locations.xml",
 
     check "unpickling succeeds (pitcher, no type)"
-          "test/xml/scoresxml-pitcher-no-type.xml" ]
+          "test/xml/scoresxml-pitcher-no-type.xml",
+
+    check "unpickling succeeds (empty numeral)"
+          "test/xml/scoresxml-empty-numeral.xml",
+
+    check "unpickling succeeds (empty type)"
+          "test/xml/scoresxml-empty-type.xml" ]
   where
     check desc path = testCase desc $ do
       actual <- unpickleable path pickle_message
@@ -593,7 +611,15 @@ test_on_delete_cascade = testGroup "cascading delete tests"
 
     check "unpickling succeeds (pitcher, no type)"
           "test/xml/scoresxml-pitcher-no-type.xml"
-          3 -- 2 teams, 1 location
+          3, -- 2 teams, 1 location
+
+    check "unpickling succeeds (empty numeral)"
+          "test/xml/scoresxml-empty-numeral.xml"
+          3, -- 2 teams, 1 location
+
+    check "unpickling succeeds (empty type)"
+          "test/xml/scoresxml-empty-type.xml"
+          4 -- 2 teams, 2 locations
   ]
   where
     check desc path expected = testCase desc $ do