From: Michael Orlitzky Date: Fri, 4 Jul 2014 06:47:29 +0000 (-0400) Subject: Update JFile to have a direct relationship between the games/teams. X-Git-Tag: 0.0.6~41 X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=b3f2573796d736bf0aec8c7ae5ec45fa72eefe98;p=dead%2Fhtsn-import.git Update JFile to have a direct relationship between the games/teams. Add the jfilexml dbschema diagram. --- diff --git a/doc/dbschema/jfilexml.png b/doc/dbschema/jfilexml.png new file mode 100644 index 0000000..06a31d1 Binary files /dev/null and b/doc/dbschema/jfilexml.png differ diff --git a/src/TSN/XML/JFile.hs b/src/TSN/XML/JFile.hs index fa37e7c..a0fa432 100644 --- a/src/TSN/XML/JFile.hs +++ b/src/TSN/XML/JFile.hs @@ -18,8 +18,7 @@ module TSN.XML.JFile ( jfile_tests, -- * WARNING: these are private but exported to silence warnings JFileConstructor(..), - JFileGameConstructor(..), - JFileGame_TeamConstructor(..) ) + JFileGameConstructor(..) ) where -- System imports @@ -31,7 +30,6 @@ import Data.Tuple.Curry ( uncurryN ) import Database.Groundhog ( countAll, deleteAll, - insert_, migrate, runMigration, silentMigrationLogger ) @@ -74,10 +72,11 @@ import TSN.Picklers ( import TSN.Team ( Team(..) ) import TSN.XmlImport ( XmlImport(..), - XmlImportFk(..) ) + XmlImportFkTeams(..) ) import Xml ( + Child(..), FromXml(..), - FromXmlFk(..), + FromXmlFkTeams(..), ToDb(..), pickle_unpickle, unpickleable, @@ -223,11 +222,14 @@ instance XmlImport JFileGameHomeTeamXml -- All of these are optional because TSN does actually leave the -- whole thing empty from time to time. -- +-- We stick \"info\" on the home/away team ids to avoid a name clash +-- with the game itself. +-- data JFileGameOddsInfo = JFileGameOddsInfo { db_list_date :: Maybe UTCTime, - db_home_team_id :: Maybe String, -- redundant (Team) - db_away_team_id :: Maybe String, -- redundant (Team) + db_info_home_team_id :: Maybe String, -- redundant (Team) + db_info_away_team_id :: Maybe String, -- redundant (Team) db_home_abbr :: Maybe String, -- redundant (Team) db_away_abbr :: Maybe String, -- redundant (Team) db_home_team_name :: Maybe String, -- redundant (Team) @@ -263,6 +265,8 @@ data JFileGameStatus = data JFileGame = JFileGame { db_jfile_id :: DefaultKey JFile, + db_away_team_id :: DefaultKey Team, + db_home_team_id :: DefaultKey Team, db_game_id :: Int, db_schedule_id :: Int, db_odds_info :: JFileGameOddsInfo, @@ -320,19 +324,24 @@ instance ToDb JFileGameXml where -- type Db JFileGameXml = JFileGame -instance FromXmlFk JFileGameXml where + +instance Child JFileGameXml where -- | Each 'JFileGameXml' is contained in (i.e. has a foreign key to) -- a 'JFile'. -- type Parent JFileGameXml = JFile + +instance FromXmlFkTeams JFileGameXml where -- | To convert an 'JFileGameXml' to an 'JFileGame', we add the - -- foreign key and drop the 'xml_vteam'/'xml_hteam'. We also mash + -- foreign keys for JFile and the home/away teams. We also mash -- the date/time together into one field. -- - from_xml_fk fk JFileGameXml{..} = + from_xml_fk_teams fk fk_away fk_home JFileGameXml{..} = JFileGame { db_jfile_id = fk, + db_away_team_id = fk_away, + db_home_team_id = fk_home, db_game_id = xml_game_id, db_schedule_id = xml_schedule_id, db_odds_info = xml_odds_info, @@ -355,18 +364,7 @@ instance FromXmlFk JFileGameXml where -- | This allows us to insert the XML representation -- 'JFileGameXml' directly. -- -instance XmlImportFk JFileGameXml - - --- * JFileGame_Team - --- | Database mapping between games and their home/away teams. --- -data JFileGame_Team = - JFileGame_Team { - jgt_jfile_games_id :: DefaultKey JFileGame, - jgt_away_team_id :: DefaultKey Team, - jgt_home_team_id :: DefaultKey Team } +instance XmlImportFkTeams JFileGameXml --- @@ -379,7 +377,6 @@ instance DbImport Message where migrate (undefined :: Team) migrate (undefined :: JFile) migrate (undefined :: JFileGame) - migrate (undefined :: JFileGame_Team) dbimport m = do -- Insert the top-level message @@ -387,20 +384,12 @@ instance DbImport Message where -- Now loop through the message's games forM_ (xml_games $ xml_gamelist m) $ \game -> do - -- First insert the game, keyed to the "jfile", - game_id <- insert_xml_fk msg_id game - - -- Next, we insert the home and away teams. + -- First we insert the home and away teams. away_team_id <- insert_xml_or_select (xml_vteam game) home_team_id <- insert_xml_or_select (xml_hteam game) - -- Insert a record into jfile_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_ JFileGame_Team { - jgt_jfile_games_id = game_id, - jgt_away_team_id = away_team_id, - jgt_home_team_id = home_team_id } + -- First insert the game, keyed to the "jfile", + insert_xml_fk_teams_ msg_id away_team_id home_team_id game return ImportSucceeded @@ -451,6 +440,12 @@ mkPersist tsn_codegen_config [groundhog| - name: db_jfile_id reference: onDelete: cascade + - name: db_away_team_id + reference: + onDelete: cascade + - name: db_home_team_id + reference: + onDelete: cascade - name: db_odds_info embeddedType: - {name: list_date, dbName: list_date} @@ -466,20 +461,6 @@ mkPersist tsn_codegen_config [groundhog| - {name: status_numeral, dbName: status_numeral} - {name: status, dbName: status} -- entity: JFileGame_Team - dbName: jfile_games__teams - constructors: - - name: JFileGame_Team - fields: - - name: jgt_jfile_games_id - reference: - onDelete: cascade - - name: jgt_away_team_id - reference: - onDelete: cascade - - name: jgt_home_team_id - reference: - onDelete: cascade |] @@ -585,8 +566,8 @@ pickle_odds_info = notes = intercalate "\n" [n1,n2,n3,n4,n5] to_tuple o = (db_list_date o, - db_home_team_id o, - db_away_team_id o, + db_info_home_team_id o, + db_info_away_team_id o, db_home_abbr o, db_away_abbr o, db_home_team_name o, @@ -723,19 +704,16 @@ test_on_delete_cascade = testGroup "cascading delete tests" 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] + return $ sum [count_a, count_b, count_c] actual @?= expected