X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FJFile.hs;h=84b28b10260a3a9e532c12fd97b088857a99bdbd;hb=ad771d25d2b1d4366f446234c3968a5dab1d52aa;hp=d2ac6f4db7b35f5793f0c3f946622cee5785d824;hpb=9f8805d6aa95283e9e2d99259a17cb8c72f6ca62;p=dead%2Fhtsn-import.git diff --git a/src/TSN/XML/JFile.hs b/src/TSN/XML/JFile.hs index d2ac6f4..84b28b1 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, @@ -174,8 +173,8 @@ instance FromXml JFileGameAwayTeamXml where from_xml JFileGameAwayTeamXml{..} = Team { team_id = away_team_id, - team_abbreviation = away_team_abbreviation, - team_name = away_team_name } + abbreviation = away_team_abbreviation, + name = away_team_name } -- | Allow us to import JFileGameAwayTeamXml directly. instance XmlImport JFileGameAwayTeamXml @@ -204,8 +203,8 @@ instance FromXml JFileGameHomeTeamXml where from_xml JFileGameHomeTeamXml{..} = Team { team_id = home_team_id, - team_abbreviation = home_team_abbreviation, - team_name = home_team_name } + abbreviation = home_team_abbreviation, + name = home_team_name } -- | Allow us to import JFileGameHomeTeamXml directly. instance XmlImport JFileGameHomeTeamXml @@ -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 } + -- Now insert the game keyed to the "jfile" and its teams. + 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