Make team names and abbreviations optional.

[dead/htsn-import.git] / src / TSN / XML / JFile.hs

diff --git a/src/TSN/XML/JFile.hs b/src/TSN/XML/JFile.hs
index 5642c8957dc8b566902c15b09b3875d3f8959e1f..86565ca59153541a9796aaabe2a2231c0c7f271e 100644 (file)
--- a/src/TSN/XML/JFile.hs
+++ b/src/TSN/XML/JFile.hs
@@ -157,8 +157,8 @@ instance XmlImport Message
 data JFileGameAwayTeamXml =
   JFileGameAwayTeamXml {
     away_team_id :: String,
-    away_team_abbreviation :: String,
-    away_team_name :: String }
+    away_team_abbreviation :: Maybe String,
+    away_team_name :: Maybe String }
   deriving (Eq, Show)
 
 instance ToDb JFileGameAwayTeamXml where
@@ -187,8 +187,8 @@ instance XmlImport JFileGameAwayTeamXml
 data JFileGameHomeTeamXml =
   JFileGameHomeTeamXml {
     home_team_id :: String,
-    home_team_abbreviation :: String,
-    home_team_name :: String }
+    home_team_abbreviation :: Maybe String,
+    home_team_name :: Maybe String }
   deriving (Eq, Show)
 
 instance ToDb JFileGameHomeTeamXml where
@@ -624,8 +624,8 @@ pickle_home_team =
   xpElem "hteam" $
     xpWrap (from_tuple, to_tuple) $
     xpTriple (xpAttr "teamid" xpText) -- Yeah, they're text.
-             (xpAttr "abbr" xpText)
-             xpText
+             (xpAttr "abbr" (xpOption xpText)) -- Some are blank
+             (xpOption xpText) -- Yup, some are nameless
   where
     from_tuple = uncurryN JFileGameHomeTeamXml
     to_tuple t = (home_team_id t,
@@ -638,8 +638,8 @@ pickle_away_team =
   xpElem "vteam" $
     xpWrap (from_tuple, to_tuple) $
     xpTriple (xpAttr "teamid" xpText) -- Yeah, they're text.
-             (xpAttr "abbr" xpText)
-             xpText
+             (xpAttr "abbr" (xpOption xpText)) -- Some are blank
+             (xpOption xpText) -- Yup, some are nameless
   where
     from_tuple = uncurryN JFileGameAwayTeamXml
     to_tuple t = (away_team_id t,
@@ -680,20 +680,27 @@ jfile_tests =
 --   test does not mean that unpickling succeeded.
 --
 test_pickle_of_unpickle_is_identity :: TestTree
-test_pickle_of_unpickle_is_identity =
-  testCase "pickle composed with unpickle is the identity" $ do
-    let path = "test/xml/jfilexml.xml"
-    (expected, actual) <- pickle_unpickle pickle_message path
-    actual @?= expected
+test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests"
+  [ check "pickle composed with unpickle is the identity"
+          "test/xml/jfilexml.xml",
+    check "pickle composed with unpickle is the identity (missing fields)"
+          "test/xml/jfilexml-missing-fields.xml" ]
+  where
+    check desc path = testCase desc $ do
+      (expected, actual) <- pickle_unpickle pickle_message path
+      actual @?= expected
 
 
 
 -- | Make sure we can actually unpickle these things.
 --
 test_unpickle_succeeds :: TestTree
-test_unpickle_succeeds =
-  testCase "unpickling succeeds" $ do
-    let path = "test/xml/jfilexml.xml"
+test_unpickle_succeeds = testGroup "unpickle tests"
+  [ check "unpickling succeeds" "test/xml/jfilexml.xml",
+    check "unpickling succeeds (missing fields)"
+          "test/xml/jfilexml-missing-fields.xml" ]
+  where
+    check desc path = testCase desc $ do
     actual <- unpickleable path pickle_message
 
     let expected = True
@@ -705,27 +712,32 @@ test_unpickle_succeeds =
 --   record.
 --
 test_on_delete_cascade :: TestTree
-test_on_delete_cascade =
-  testCase "deleting auto_racing_results deletes its children" $ do
-    let path = "test/xml/jfilexml.xml"
-    results <- unsafe_unpickle path pickle_message
-    let a = undefined :: Team
-    let b = undefined :: JFile
-    let c = undefined :: JFileGame
-    let d = undefined :: JFileGame_Team
-
-    actual <- withSqliteConn ":memory:" $ runDbConn $ do
-                runMigration silentMigrationLogger $ do
-                  migrate a
-                  migrate b
-                  migrate c
-                  migrate d
-                _ <- dbimport results
-                deleteAll b
-                count_a <- countAll a
-                count_b <- countAll b
-                count_c <- countAll c
-                count_d <- countAll d
-                return $ sum [count_a, count_b, count_c, count_d]
-    let expected = 20 -- Twenty teams should be left over
-    actual @?= expected
+test_on_delete_cascade = testGroup "cascading delete tests"
+  [ check "deleting auto_racing_results deletes its children"
+          "test/xml/jfilexml.xml"
+          20,
+    check "deleting auto_racing_results deletes its children (missing fields)"
+          "test/xml/jfilexml-missing-fields.xml"
+          44 ]
+  where
+    check desc path expected = testCase desc $ do
+      results <- unsafe_unpickle path pickle_message
+      let a = undefined :: Team
+      let b = undefined :: JFile
+      let c = undefined :: JFileGame
+      let d = undefined :: JFileGame_Team
+
+      actual <- withSqliteConn ":memory:" $ runDbConn $ do
+                  runMigration silentMigrationLogger $ do
+                    migrate a
+                    migrate b
+                    migrate c
+                    migrate d
+                  _ <- dbimport results
+                  deleteAll b
+                  count_a <- countAll a
+                  count_b <- countAll b
+                  count_c <- countAll c
+                  count_d <- countAll d
+                  return $ sum [count_a, count_b, count_c, count_d]
+      actual @?= expected