From: Michael Orlitzky Date: Tue, 24 Jun 2014 21:05:30 +0000 (-0400) Subject: Update TSN.XML.Odds to use the new TSN.Team type. X-Git-Tag: 0.0.6~67 X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=ad3eed23aaf35aaa89058ff95935dc714142c343;p=dead%2Fhtsn-import.git Update TSN.XML.Odds to use the new TSN.Team type. --- diff --git a/doc/dbschema/Odds_XML.png b/doc/dbschema/Odds_XML.png index 323894c..7f28a55 100644 Binary files a/doc/dbschema/Odds_XML.png and b/doc/dbschema/Odds_XML.png differ diff --git a/src/TSN/XML/Odds.hs b/src/TSN/XML/Odds.hs index 6b7d4ab..7af360c 100644 --- a/src/TSN/XML/Odds.hs +++ b/src/TSN/XML/Odds.hs @@ -11,9 +11,6 @@ -- other... disorganized... information. -- module TSN.XML.Odds ( - OddsGameAwayTeamXml(..), -- Used in TSN.XML.JFile - OddsGameHomeTeamXml(..), -- Used in TSN.XML.JFile - OddsGameTeam(..), -- Used in TSN.XML.JFile dtd, pickle_message, -- * Tests @@ -21,10 +18,9 @@ module TSN.XML.Odds ( -- * WARNING: these are private but exported to silence warnings OddsCasinoConstructor(..), OddsConstructor(..), - OddsGame_OddsGameTeamConstructor(..), + OddsGame_TeamConstructor(..), OddsGameConstructor(..), - OddsGameLineConstructor(..), - OddsGameTeamConstructor(..) ) + OddsGameLineConstructor(..) ) where -- System imports. @@ -70,6 +66,7 @@ import TSN.Codegen ( tsn_codegen_config ) import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate ) import TSN.Picklers ( xp_date_padded, xp_time, xp_time_stamp ) +import TSN.Team ( Team(..) ) import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) ) import Xml ( FromXml(..), @@ -150,28 +147,11 @@ instance FromXml OddsGameCasinoXml where instance XmlImport OddsGameCasinoXml --- * OddsGameTeam - - --- | The database representation of teams as they appear in odds --- games. --- -data OddsGameTeam = - OddsGameTeam { - db_team_id :: String, -- ^ The home/away team IDs are - -- three characters but Postgres - -- imposes no performance penalty - -- on lengthless text fields, so - -- we ignore the probable upper - -- bound of three characters. - db_abbr :: String, - db_team_name :: String } - deriving (Eq, Show) - - --- * OddsGameHomeTeam/OddsGameHomeTeamXml +-- * OddsGameHomeTeamXml / OddsGameAwayTeamXml -- | The XML representation of a \, as found in \s. +-- This is basically the same as 'OddsGameAwayTeamXml', but the two +-- types have different picklers. -- data OddsGameHomeTeamXml = OddsGameHomeTeamXml { @@ -193,7 +173,7 @@ instance ToDb OddsGameHomeTeamXml where -- | The database representation of an 'OddsGameHomeTeamXml' is an -- 'OddsGameTeam'. -- - type Db OddsGameHomeTeamXml = OddsGameTeam + type Db OddsGameHomeTeamXml = Team instance FromXml OddsGameHomeTeamXml where -- | We convert from XML to the database by dropping the lines and @@ -201,10 +181,10 @@ instance FromXml OddsGameHomeTeamXml where -- themselves). -- from_xml OddsGameHomeTeamXml{..} = - OddsGameTeam { - db_team_id = xml_home_team_id, - db_abbr = xml_home_abbr, - db_team_name = xml_home_team_name } + Team { + team_id = xml_home_team_id, + team_abbreviation = xml_home_abbr, + team_name = xml_home_team_name } -- | This allows us to insert the XML representation -- 'OddsGameHomeTeamXml' directly. @@ -212,9 +192,10 @@ instance FromXml OddsGameHomeTeamXml where instance XmlImport OddsGameHomeTeamXml where --- * OddsGameAwayTeam/OddsGameAwayTeamXml -- | The XML representation of a \, as found in \s. +-- This is basically the same as 'OddsGameHomeTeamXml', but the two +-- types have different picklers. -- data OddsGameAwayTeamXml = OddsGameAwayTeamXml { @@ -231,17 +212,17 @@ data OddsGameAwayTeamXml = deriving (Eq, Show) instance ToDb OddsGameAwayTeamXml where - -- | The database representation of an 'OddsGameAwayTeamXml' is an - -- 'OddsGameTeam'. + -- | The database representation of an 'OddsGameAwayTeamXml' is a + -- 'Team'. -- - type Db OddsGameAwayTeamXml = OddsGameTeam + type Db OddsGameAwayTeamXml = Team instance FromXml OddsGameAwayTeamXml where -- | We convert from XML to the database by dropping the lines and -- rotation number (which are specific to the games, not the teams -- themselves). -- - from_xml OddsGameAwayTeamXml{..} = OddsGameTeam + from_xml OddsGameAwayTeamXml{..} = Team xml_away_team_id xml_away_abbr xml_away_team_name @@ -256,11 +237,11 @@ instance XmlImport OddsGameAwayTeamXml where -- | Database mapping between games and their home/away teams. -- -data OddsGame_OddsGameTeam = - OddsGame_OddsGameTeam { - ogogt_odds_games_id :: DefaultKey OddsGame, - ogogt_away_team_id :: DefaultKey OddsGameTeam, - ogogt_home_team_id :: DefaultKey OddsGameTeam } +data OddsGame_Team = + OddsGame_Team { + ogt_odds_games_id :: DefaultKey OddsGame, + ogt_away_team_id :: DefaultKey Team, + ogt_home_team_id :: DefaultKey Team } -- * OddsGameOverUnderXml @@ -471,16 +452,6 @@ mkPersist tsn_codegen_config [groundhog| type: constraint fields: [casino_client_id] -- entity: OddsGameTeam - dbName: odds_games_teams - constructors: - - name: OddsGameTeam - uniques: - - name: unique_odds_games_team - type: constraint - fields: [db_team_id] - - - entity: OddsGame dbName: odds_games constructors: @@ -502,18 +473,18 @@ mkPersist tsn_codegen_config [groundhog| reference: onDelete: cascade -- entity: OddsGame_OddsGameTeam - dbName: odds_games__odds_games_teams +- entity: OddsGame_Team + dbName: odds_games__teams constructors: - - name: OddsGame_OddsGameTeam + - name: OddsGame_Team fields: - - name: ogogt_odds_games_id + - name: ogt_odds_games_id reference: onDelete: cascade - - name: ogogt_away_team_id + - name: ogt_away_team_id reference: onDelete: cascade - - name: ogogt_home_team_id + - name: ogt_home_team_id reference: onDelete: cascade |] @@ -521,11 +492,11 @@ mkPersist tsn_codegen_config [groundhog| instance DbImport Message where dbmigrate _= run_dbmigrate $ do + migrate (undefined :: Team) migrate (undefined :: Odds) migrate (undefined :: OddsCasino) - migrate (undefined :: OddsGameTeam) migrate (undefined :: OddsGame) - migrate (undefined :: OddsGame_OddsGameTeam) + migrate (undefined :: OddsGame_Team) migrate (undefined :: OddsGameLine) dbimport m = do @@ -535,21 +506,20 @@ instance DbImport Message where forM_ (xml_games m) $ \g -> do -- Next, we insert the home and away teams. We do this before -- inserting the game itself because the game has two foreign keys - -- pointing to odds_games_teams. - -- Next to insert the home and away teams. + -- pointing to "teams". away_team_id <- insert_xml_or_select (xml_game_away_team g) home_team_id <- insert_xml_or_select (xml_game_home_team g) -- Now insert the game, keyed to the "odds", game_id <- insert_xml_fk odds_id g - -- Insert a record into odds_games__odds_games_teams mapping the + -- Insert a record into odds_games__teams mapping the -- home/away teams to this game. Use the full record syntax -- because the types would let us mix up the home/away teams. - insert_ OddsGame_OddsGameTeam { - ogogt_odds_games_id = game_id, - ogogt_away_team_id = away_team_id, - ogogt_home_team_id = home_team_id } + insert_ OddsGame_Team { + ogt_odds_games_id = game_id, + ogt_away_team_id = away_team_id, + ogt_home_team_id = home_team_id } -- Finaly, we insert the lines. The over/under entries for this -- game and the lines for the casinos all wind up in the same @@ -798,7 +768,7 @@ test_unpickle_succeeds = testGroup "unpickle tests" -- | Make sure everything gets deleted when we delete the top-level --- record. +-- record. The casinos and teams should be left behind. -- test_on_delete_cascade :: TestTree test_on_delete_cascade = testGroup "cascading delete tests" @@ -824,11 +794,11 @@ test_on_delete_cascade = testGroup "cascading delete tests" where check desc path expected = testCase desc $ do odds <- unsafe_unpickle path pickle_message - let a = undefined :: Odds - let b = undefined :: OddsCasino - let c = undefined :: OddsGameTeam + let a = undefined :: Team + let b = undefined :: Odds + let c = undefined :: OddsCasino let d = undefined :: OddsGame - let e = undefined :: OddsGame_OddsGameTeam + let e = undefined :: OddsGame_Team let f = undefined :: OddsGameLine actual <- withSqliteConn ":memory:" $ runDbConn $ do runMigration silentMigrationLogger $ do @@ -839,7 +809,7 @@ test_on_delete_cascade = testGroup "cascading delete tests" migrate e migrate f _ <- dbimport odds - deleteAll a + deleteAll b count_a <- countAll a count_b <- countAll b count_c <- countAll c