From: Michael Orlitzky Date: Sat, 28 Jun 2014 01:45:58 +0000 (-0400) Subject: Make team names and abbreviations optional. X-Git-Tag: 0.0.6~59 X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=4f3de61fd6e53c74a8c1a7a6b1d478a5571591d9;p=dead%2Fhtsn-import.git Make team names and abbreviations optional. --- diff --git a/src/TSN/Team.hs b/src/TSN/Team.hs index d022520..910c671 100644 --- 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 5642c89..86565ca 100644 --- 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 7af360c..b76be76 100644 --- 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",