From 5a8806defa5e0fb3a99ae5316d6eeceb74dda3a3 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Tue, 24 Jun 2014 17:26:21 -0400 Subject: [PATCH] Use the TSN.Team type in TSN.XML.JFile. Add team pickling to TSN.XML.JFile. --- src/TSN/XML/JFile.hs | 209 ++++++++++++++++++++++++++++++++++--------- 1 file changed, 165 insertions(+), 44 deletions(-) diff --git a/src/TSN/XML/JFile.hs b/src/TSN/XML/JFile.hs index a327460..2eed37f 100644 --- a/src/TSN/XML/JFile.hs +++ b/src/TSN/XML/JFile.hs @@ -25,15 +25,18 @@ import Database.Groundhog.TH ( mkPersist ) import Text.XML.HXT.Core ( PU, + xpTriple, xp6Tuple, xp7Tuple, xp8Tuple, xp10Tuple, xp14Tuple, + xpAttr, xpElem, xpInt, xpList, xpOption, + xpPair, xpText, xpWrap ) @@ -42,10 +45,7 @@ import Text.XML.HXT.Core ( 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.XML.Odds ( - OddsGameAwayTeamXml(..), - OddsGameHomeTeamXml(..), - OddsGameTeam(..) ) +import TSN.Team ( Team(..) ) import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) ) @@ -121,6 +121,70 @@ 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 :: String, + away_team_name :: 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 :: String, + home_team_name :: 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 + -- | This is an embedded type within each JFileGame. It has its own -- element, \, but there's only one of them per game. So -- essentially all of these fields belong to a 'JFileGame'. Aaaannnd @@ -128,15 +192,15 @@ instance XmlImport Message -- measure, but in the conversion to the database type, we can drop -- all of the redundant information. -- -data OddsInfo = - OddsInfo { +data JFileGameOddsInfo = + JFileGameOddsInfo { db_list_date :: UTCTime, - db_home_team_id :: Int, -- redundant (OddsGameTeam) - db_away_team_id :: Int, -- redundant (OddsGameTeam) - db_home_abbr :: String, -- redundant (OddsGameTeam) - db_away_abbr :: String, -- redundant (OddsGameTeam) - db_home_team_name :: String, -- redundant (OddsGameTeam) - db_away_team_name :: String, -- redundant (OddsGameTeam) + db_home_team_id :: String, -- redundant (Team) + db_away_team_id :: String, -- redundant (Team) + db_home_abbr :: String, -- redundant (Team) + db_away_abbr :: String, -- redundant (Team) + db_home_team_name :: String, -- redundant (Team) + db_away_team_name :: String, -- redundant (Team) db_home_starter :: String, db_away_starter :: String, db_game_date :: UTCTime, -- redundant (JFileGame) @@ -148,8 +212,16 @@ data OddsInfo = deriving (Eq, Show) +-- | Another embedded type within 'JFileGame'. These look like, +-- \FINAL\ within the XML, but +-- they're in one-to-one correspondence with the games. +-- +data JFileGameStatus = + JFileGameStatus { + db_status_numeral :: Int, + db_status :: String } + deriving (Eq, Show) --- * JFileGame/JFileGameXml -- | Database representation of a \ contained within a -- \, and, implicitly, a \. @@ -162,7 +234,7 @@ data JFileGame = db_jfile_id :: DefaultKey JFile, db_game_id :: Int, db_schedule_id :: Int, - db_odds_info :: OddsInfo, + db_odds_info :: JFileGameOddsInfo, db_season_type :: String, db_game_time :: UTCTime, db_vleague :: Maybe String, @@ -170,31 +242,31 @@ data JFileGame = db_vscore :: Int, db_hscore :: Int, db_time_remaining :: Maybe String, - db_status :: String } + db_game_status :: JFileGameStatus } -- | XML representation of a \ contained within a \, --- and a \. The Away/Home teams seem to --- coincide with those of 'OddsGame', so we're reusing those for --- now. In the future it may make sense to separate them out into --- just \"Teams\". Note however that they require different picklers! +-- and a \. The Away/Home teams seem to coincide with +-- those of 'OddsGame', so we're reusing the DB type via the common +-- 'TSN.Team' structure. But the XML types are different, because +-- they have different picklers! -- data JFileGameXml = JFileGameXml { xml_game_id :: Int, xml_schedule_id :: Int, - xml_odds_info :: OddsInfo, + xml_odds_info :: JFileGameOddsInfo, xml_season_type :: String, xml_game_date :: UTCTime, xml_game_time :: UTCTime, - xml_vteam :: OddsGameAwayTeamXml, + xml_vteam :: JFileGameAwayTeamXml, xml_vleague :: Maybe String, - xml_hteam :: OddsGameHomeTeamXml, + xml_hteam :: JFileGameHomeTeamXml, xml_hleague :: Maybe String, xml_vscore :: Int, xml_hscore :: Int, xml_time_remaining :: Maybe String, - xml_status :: String } + xml_game_status :: JFileGameStatus } deriving (Eq, Show) @@ -240,7 +312,7 @@ instance FromXmlFk JFileGameXml where db_vscore = xml_vscore, db_hscore = xml_hscore, db_time_remaining = xml_time_remaining, - db_status = xml_status } + db_game_status = xml_game_status } where -- | Make the database \"game time\" from the XML -- date/time. Simply take the day part from one and the time @@ -256,15 +328,15 @@ instance FromXmlFk JFileGameXml where instance XmlImportFk JFileGameXml --- * JFileGame_OddsGameTeam +-- * JFileGame_Team -- | Database mapping between games and their home/away teams. -- -data JFileGame_OddsGameTeam = - JFileGame_OddsGameTeam { - jgogt_jfile_games_id :: DefaultKey JFileGame, - jgogt_away_team_id :: DefaultKey OddsGameTeam, - jgogt_home_team_id :: DefaultKey OddsGameTeam } +data JFileGame_Team = + JFileGame_Team { + jgt_jfile_games_id :: DefaultKey JFileGame, + jgt_away_team_id :: DefaultKey Team, + jgt_home_team_id :: DefaultKey Team } --- @@ -274,10 +346,10 @@ data JFileGame_OddsGameTeam = instance DbImport Message where dbmigrate _ = run_dbmigrate $ do + migrate (undefined :: Team) migrate (undefined :: JFile) migrate (undefined :: JFileGame) - migrate (undefined :: OddsGameTeam) - migrate (undefined :: JFileGame_OddsGameTeam) + migrate (undefined :: JFileGame_Team) dbimport m = return ImportSucceeded @@ -293,8 +365,16 @@ mkPersist tsn_codegen_config [groundhog| # Prevent multiple imports of the same message. fields: [db_xml_file_id] -# Many of the OddsInfo fields are redundant and have been left out. -- embedded: OddsInfo +- embedded: JFileGameStatus + fields: + - name: db_status_numeral + dbName: status_numeral + - name: db_status + dbName: status + +# Many of the JFileGameOddsInfo fields are redundant and have +# been left out. +- embedded: JFileGameOddsInfo fields: - name: db_list_date dbName: list_date @@ -329,19 +409,23 @@ mkPersist tsn_codegen_config [groundhog| - {name: current_timestamp, dbName: current_timestamp} - {name: live, dbName: live} - {name: notes, dbName: notes} + - name: db_game_status + embeddedType: + - {name: status_numeral, dbName: status_numeral} + - {name: status, dbName: status} -- entity: JFileGame_OddsGameTeam - dbName: jfile_games__odds_games_teams +- entity: JFileGame_Team + dbName: jfile_games__teams constructors: - - name: JFileGame_OddsGameTeam + - name: JFileGame_Team fields: - - name: jgogt_jfile_games_id + - name: jgt_jfile_games_id reference: onDelete: cascade - - name: jgogt_away_team_id + - name: jgt_away_team_id reference: onDelete: cascade - - name: jgogt_home_team_id + - name: jgt_home_team_id reference: onDelete: cascade |] @@ -417,9 +501,46 @@ pickle_game = xml_vscore m, xml_hscore m, xml_time_remaining m, - xml_status m) + xml_game_status m) pickle_odds_info = undefined -pickle_home_team = undefined -pickle_away_team = undefined -pickle_status = undefined + + +pickle_home_team :: PU JFileGameHomeTeamXml +pickle_home_team = + xpElem "hteam" $ + xpWrap (from_tuple, to_tuple) $ + xpTriple (xpAttr "teamid" xpText) -- Yeah, they're text. + (xpAttr "abbr" xpText) + xpText + where + from_tuple = uncurryN JFileGameHomeTeamXml + to_tuple t = (home_team_id t, + home_team_abbreviation t, + home_team_name t) + + +pickle_away_team :: PU JFileGameAwayTeamXml +pickle_away_team = + xpElem "vteam" $ + xpWrap (from_tuple, to_tuple) $ + xpTriple (xpAttr "teamid" xpText) -- Yeah, they're text. + (xpAttr "abbr" xpText) + xpText + where + from_tuple = uncurryN JFileGameAwayTeamXml + to_tuple t = (away_team_id t, + away_team_abbreviation t, + away_team_name t) + + +pickle_status :: PU JFileGameStatus +pickle_status = + xpElem "status" $ + xpWrap (from_tuple, to_tuple) $ + xpPair (xpAttr "numeral" xpInt) + xpText + where + from_tuple = uncurry JFileGameStatus + to_tuple s = (db_status_numeral s, + db_status s) -- 2.44.2