X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FScores.hs;h=8ae86a8355e3fc24dcb1d208fe66c712b61d7868;hb=83bad08d7f28143cdaae42156d951b421fa15a8a;hp=403727e5cfd7e7a11dd917524fe891146abd39d9;hpb=8c7f33d76981a27a4fde6271dc71105b23adc5a1;p=dead%2Fhtsn-import.git diff --git a/src/TSN/XML/Scores.hs b/src/TSN/XML/Scores.hs index 403727e..8ae86a8 100644 --- a/src/TSN/XML/Scores.hs +++ b/src/TSN/XML/Scores.hs @@ -30,7 +30,7 @@ import Data.Tuple.Curry ( uncurryN ) import Data.Typeable ( Typeable ) import Database.Groundhog ( countAll, - executeRaw, + deleteAll, insert, insert_, migrate, @@ -67,6 +67,7 @@ import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate ) import TSN.Picklers ( xp_time_stamp ) import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) ) import Xml ( + Child(..), FromXml(..), FromXmlFk(..), ToDb(..), @@ -128,6 +129,9 @@ instance ToDb Message where type Db Message = Score instance FromXml Message where + -- | When converting from the XML representation to the database + -- one, we drop the list of locations which will be foreign-keyed to + -- us instead. from_xml Message{..} = Score { db_xml_file_id = xml_xml_file_id, @@ -202,12 +206,15 @@ instance ToDb ScoreGameXml where -- type Db ScoreGameXml = ScoreGame -instance FromXmlFk ScoreGameXml where + +instance Child ScoreGameXml where -- | Each 'ScoreGameXml' is contained in (i.e. has a foreign key to) -- a 'Score'. -- type Parent ScoreGameXml = Score + +instance FromXmlFk ScoreGameXml where from_xml_fk fk ScoreGameXml{..} = ScoreGame { db_scores_id = fk, @@ -253,13 +260,15 @@ newtype ScoreGameHTeam = -- * ScoreGame_ScoreGameTeam -- | Join a 'ScoreGame' with its home/away teams. Database-only. We --- use a join table because the teams are kept unique. +-- use a join table because the teams are kept unique. The first +-- argument is the game id, the second argument is the visiting team +-- (vteam) id, and the last argument is the home team (hteam) id. -- data ScoreGame_ScoreGameTeam = ScoreGame_ScoreGameTeam - (DefaultKey ScoreGame) -- ^ game id - (DefaultKey ScoreGameTeam) -- ^ vteam id - (DefaultKey ScoreGameTeam) -- ^ hteam id + (DefaultKey ScoreGame) -- game id + (DefaultKey ScoreGameTeam) -- vteam id + (DefaultKey ScoreGameTeam) -- hteam id -- * ScoreLocation @@ -385,7 +394,7 @@ mkPersist tsn_codegen_config [groundhog| - { name: status_text, dbName: status_text } - entity: ScoreGame_ScoreGameTeam - dbName: scores__scores_games_teams + dbName: scores_games__scores_games_teams constructors: - name: ScoreGame_ScoreGameTeam fields: @@ -618,7 +627,7 @@ test_on_delete_cascade = testGroup "cascading delete tests" migrate f _ <- dbimport score -- No idea how 'delete' works, so do this instead. - executeRaw False "DELETE FROM scores;" [] + deleteAll a count_a <- countAll a count_b <- countAll b count_c <- countAll c