Make team names and abbreviations optional.

diff --git a/src/TSN/Team.hs b/src/TSN/Team.hs
index d02252011a8025e743efc755fdc49ff5b18cdd0c..910c67120da44aa0b621f1bf3db87315c94694a2 100644 (file)
--- a/src/TSN/Team.hs
+++ b/src/TSN/Team.hs
@@ -33,8 +33,11 @@ import Database.Groundhog.TH (
 data Team =
   Team {
     team_id :: String, -- ^ Some of them contain characters
-    team_abbreviation :: String,
-    team_name :: String }
+    team_abbreviation :: Maybe String, -- ^ Some teams don't have abbreviations,
+                                       --   or at least, some sample jfilexml
+                                       --   don't have them for some teams.
+    team_name :: Maybe String -- ^ Some teams don't even have names!
+    }
   deriving (Eq, Show)
 
 

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

diff --git a/src/TSN/XML/Odds.hs b/src/TSN/XML/Odds.hs
index 7af360cfb53f6adb3fa421ef18f07e0214fc5134..b76be762dee067d4b2125ad28668b21bfc3ab7eb 100644 (file)
--- a/src/TSN/XML/Odds.hs
+++ b/src/TSN/XML/Odds.hs
@@ -183,8 +183,8 @@ instance FromXml OddsGameHomeTeamXml where
   from_xml OddsGameHomeTeamXml{..} =
     Team {
       team_id   = xml_home_team_id,
-      team_abbreviation      = xml_home_abbr,
-      team_name = xml_home_team_name }
+      team_abbreviation = Just xml_home_abbr,
+      team_name = Just xml_home_team_name }
 
 -- | This allows us to insert the XML representation
 --   'OddsGameHomeTeamXml' directly.
@@ -224,8 +224,8 @@ instance FromXml OddsGameAwayTeamXml where
   --
   from_xml OddsGameAwayTeamXml{..} = Team
                                        xml_away_team_id
-                                       xml_away_abbr
-                                       xml_away_team_name
+                                       (Just xml_away_abbr)
+                                       (Just xml_away_team_name)
 
 -- | This allows us to insert the XML representation
 --   'OddsGameAwayTeamXml' directly.
@@ -729,7 +729,7 @@ odds_tests =
 test_pickle_of_unpickle_is_identity :: TestTree
 test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests"
   [ check "pickle composed with unpickle is the identity"
-         "test/xml/Odds_XML.xml",
+          "test/xml/Odds_XML.xml",
 
     check "pickle composed with unpickle is the identity (non-int team_id)"
           "test/xml/Odds_XML-noninteger-team-id.xml",