X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FJFile.hs;h=35768163cbe21eef1a5fbb01e98b973abc605d81;hb=9e66d3ffc3ff1141c97911a6a58fc804cf16f423;hp=86565ca59153541a9796aaabe2a2231c0c7f271e;hpb=4f3de61fd6e53c74a8c1a7a6b1d478a5571591d9;p=dead%2Fhtsn-import.git diff --git a/src/TSN/XML/JFile.hs b/src/TSN/XML/JFile.hs index 86565ca..3576816 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 ) @@ -63,6 +61,7 @@ import Text.XML.HXT.Core ( -- Local imports import TSN.Codegen ( tsn_codegen_config ) +import TSN.Database ( insert_or_select ) import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate ) import TSN.Picklers ( xp_date, @@ -71,13 +70,14 @@ import TSN.Picklers ( xp_time, xp_time_dots, xp_time_stamp ) -import TSN.Team ( Team(..) ) +import TSN.Team ( Team(..), HTeam(..), VTeam(..) ) import TSN.XmlImport ( XmlImport(..), - XmlImportFk(..) ) + XmlImportFkTeams(..) ) import Xml ( + Child(..), FromXml(..), - FromXmlFk(..), + FromXmlFkTeams(..), ToDb(..), pickle_unpickle, unpickleable, @@ -149,67 +149,6 @@ instance FromXml Message where instance XmlImport Message --- * JFileGameAwayTeamXml / JFileGameHomeTeamXml - --- | The XML representation of a JFile away team. Its corresponding --- database representation (along with that of the home team) is a --- TSN.Team, but their XML representations are different. -data JFileGameAwayTeamXml = - JFileGameAwayTeamXml { - away_team_id :: String, - away_team_abbreviation :: Maybe String, - away_team_name :: Maybe String } - deriving (Eq, Show) - -instance ToDb JFileGameAwayTeamXml where - -- | The database analogue of an 'JFileGameAwayTeamXml' is - -- a 'Team'. - -- - type Db JFileGameAwayTeamXml = Team - -instance FromXml JFileGameAwayTeamXml where - -- | To convert a 'JFileGameAwayTeamXml' to a 'Team', we do just - -- about nothing. - -- - from_xml JFileGameAwayTeamXml{..} = - Team { - team_id = away_team_id, - team_abbreviation = away_team_abbreviation, - team_name = away_team_name } - --- | Allow us to import JFileGameAwayTeamXml directly. -instance XmlImport JFileGameAwayTeamXml - - --- | The XML representation of a JFile home team. Its corresponding --- database representation (along with that of the away team) is a --- TSN.Team, but their XML representations are different. -data JFileGameHomeTeamXml = - JFileGameHomeTeamXml { - home_team_id :: String, - home_team_abbreviation :: Maybe String, - home_team_name :: Maybe String } - deriving (Eq, Show) - -instance ToDb JFileGameHomeTeamXml where - -- | The database analogue of an 'JFileGameHomeTeamXml' is - -- a 'Team'. - -- - type Db JFileGameHomeTeamXml = Team - -instance FromXml JFileGameHomeTeamXml where - -- | To convert a 'JFileGameHomeTeamXml' to a 'Team', we do just - -- about nothing. - -- - from_xml JFileGameHomeTeamXml{..} = - Team { - team_id = home_team_id, - team_abbreviation = home_team_abbreviation, - team_name = home_team_name } - --- | Allow us to import JFileGameHomeTeamXml directly. -instance XmlImport JFileGameHomeTeamXml - -- * JFileGame/JFileGameXml @@ -223,11 +162,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 +205,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, @@ -290,9 +234,9 @@ data JFileGameXml = xml_season_type :: Maybe String, xml_game_date :: UTCTime, xml_game_time :: UTCTime, - xml_vteam :: JFileGameAwayTeamXml, + xml_vteam :: VTeam, xml_vleague :: Maybe String, - xml_hteam :: JFileGameHomeTeamXml, + xml_hteam :: HTeam, xml_hleague :: Maybe String, xml_vscore :: Int, xml_hscore :: Int, @@ -320,19 +264,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 +304,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 +317,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,22 +324,12 @@ instance DbImport Message where -- Now loop through the message's games forM_ (xml_games $ xml_gamelist m) $ \game -> do + -- First we insert the home and away teams. + away_team_id <- insert_or_select (vteam $ xml_vteam game) + home_team_id <- insert_or_select (hteam $ xml_hteam game) - -- 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 "teams". - away_team_id <- insert_xml_or_select (xml_vteam game) - home_team_id <- insert_xml_or_select (xml_hteam game) - - game_id <- insert_xml_fk msg_id 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 @@ -453,6 +380,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} @@ -468,20 +401,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 |] @@ -587,8 +506,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, @@ -619,7 +538,10 @@ pickle_odds_info = (_:_:_:_:notes5:_) -> notes5 _ -> "" -pickle_home_team :: PU JFileGameHomeTeamXml +-- | (Un)pickle a home team to/from the dual XML/DB representation +-- 'Team'. +-- +pickle_home_team :: PU HTeam pickle_home_team = xpElem "hteam" $ xpWrap (from_tuple, to_tuple) $ @@ -627,13 +549,16 @@ pickle_home_team = (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, - home_team_abbreviation t, - home_team_name t) + from_tuple = HTeam . (uncurryN Team) + to_tuple (HTeam t) = (team_id t, + abbreviation t, + name t) -pickle_away_team :: PU JFileGameAwayTeamXml +-- | (Un)pickle an away team to/from the dual XML/DB representation +-- 'Team'. +-- +pickle_away_team :: PU VTeam pickle_away_team = xpElem "vteam" $ xpWrap (from_tuple, to_tuple) $ @@ -641,10 +566,10 @@ pickle_away_team = (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, - away_team_abbreviation t, - away_team_name t) + from_tuple = VTeam . (uncurryN Team) + to_tuple (VTeam t) = (team_id t, + abbreviation t, + name t) pickle_status :: PU JFileGameStatus @@ -725,19 +650,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