X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FScores.hs;h=d28925801538799e3ea77734c14015a315eb97b3;hb=346f1940cfb31f88d07e65fc099e793b4fbcce02;hp=571f6b383833da7c5edba1f146b25cb6fe7e15f0;hpb=fa27649ae583f6bdc20c54db4fc8f38a382a536c;p=dead%2Fhtsn-import.git diff --git a/src/TSN/XML/Scores.hs b/src/TSN/XML/Scores.hs index 571f6b3..d289258 100644 --- a/src/TSN/XML/Scores.hs +++ b/src/TSN/XML/Scores.hs @@ -15,11 +15,10 @@ module TSN.XML.Scores ( -- * Tests scores_tests, -- * WARNING: these are private but exported to silence warnings - Score_ScoreLocationConstructor(..), + Score_LocationConstructor(..), ScoreConstructor(..), ScoreGameConstructor(..), ScoreGameTeamConstructor(..), - ScoreLocationConstructor(..), ScoreGame_ScoreGameTeamConstructor(..) ) where @@ -61,12 +60,14 @@ import Text.XML.HXT.Core ( xpWrap ) -- Local imports. -import TSN.Codegen ( - tsn_codegen_config ) +import TSN.Codegen ( tsn_codegen_config ) +import TSN.Database ( insert_or_select ) import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate ) +import TSN.Location ( Location(..), pickle_location ) import TSN.Picklers ( xp_time_stamp ) import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) ) import Xml ( + Child(..), FromXml(..), FromXmlFk(..), ToDb(..), @@ -117,7 +118,7 @@ data Message = xml_tsnupdate :: Maybe Bool, xml_category :: String, xml_sport :: String, - xml_locations :: [ScoreLocation], + xml_locations :: [Location], xml_season_type :: String, xml_game :: ScoreGameXml, xml_time_stamp :: UTCTime } @@ -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,62 +260,52 @@ 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 - - --- * ScoreLocation - --- | Database and XML representation of a \. This is almost --- identical to 'TSN.XML.NewsLocation', but the city/state have not --- appeared optional here so far. --- -data ScoreLocation = - ScoreLocation { - city :: String, - state :: String, - country :: String } - deriving (Eq, Show) + (DefaultKey ScoreGame) -- game id + (DefaultKey ScoreGameTeam) -- vteam id + (DefaultKey ScoreGameTeam) -- hteam id --- * Score_ScoreLocation +-- * Score_Location --- | Join each 'Score' with its 'ScoreLocation's. Database-only. We +-- | Join each 'Score' with its 'Location's. Database-only. We -- use a join table because the locations are kept unique. -- -data Score_ScoreLocation = - Score_ScoreLocation +data Score_Location = + Score_Location (DefaultKey Score) - (DefaultKey ScoreLocation) + (DefaultKey Location) instance DbImport Message where dbmigrate _ = run_dbmigrate $ do + migrate (undefined :: Location) migrate (undefined :: Score) migrate (undefined :: ScoreGame) migrate (undefined :: ScoreGameTeam) migrate (undefined :: ScoreGame_ScoreGameTeam) - migrate (undefined :: ScoreLocation) - migrate (undefined :: Score_ScoreLocation) + migrate (undefined :: Score_Location) dbimport m = do -- Insert the message and get its ID. msg_id <- insert_xml m -- Insert all of the locations contained within this message and - -- collect their IDs in a list. - location_ids <- mapM insert (xml_locations m) + -- collect their IDs in a list. We use insert_or_select because + -- most of the locations will already exist, and we just want to + -- get the ID of the existing location when there's a collision. + location_ids <- mapM insert_or_select (xml_locations m) -- Now use that list to construct 'Score_ScoreLocation' objects, -- and insert them. - mapM_ (insert_ . Score_ScoreLocation msg_id) location_ids + mapM_ (insert_ . Score_Location msg_id) location_ids -- Insert the game and its hteam/vteam, noting the IDs. game_id <- insert_xml_fk msg_id (xml_game m) @@ -335,15 +332,6 @@ mkPersist defaultCodegenConfig [groundhog| type: constraint fields: [team_id] -- entity: ScoreLocation - dbName: scores_locations - constructors: - - name: ScoreLocation - uniques: - - name: unique_scores_location - type: constraint - fields: [city, state, country] - |] @@ -402,17 +390,17 @@ mkPersist tsn_codegen_config [groundhog| reference: onDelete: cascade -- entity: Score_ScoreLocation - dbName: scores__scores_locations +- entity: Score_Location + dbName: scores__locations constructors: - - name: Score_ScoreLocation + - name: Score_Location fields: - - name: score_ScoreLocation0 # Default created by mkNormalFieldName + - name: score_Location0 # Default created by mkNormalFieldName dbName: scores_id reference: onDelete: cascade - - name: score_ScoreLocation1 # Default created by mkNormalFieldName - dbName: scores_locations_id + - name: score_Location1 # Default created by mkNormalFieldName + dbName: locations_id reference: onDelete: cascade |] @@ -455,20 +443,6 @@ pickle_message = --- | Convert a 'ScoreLocation' to/from \. --- -pickle_location :: PU ScoreLocation -pickle_location = - xpElem "location" $ - xpWrap (from_tuple, to_tuple) $ - xpTriple (xpElem "city" xpText) - (xpElem "state" xpText) - (xpElem "country" xpText) - where - from_tuple = - uncurryN ScoreLocation - to_tuple l = (city l, state l, country l) - -- | Convert a 'ScoreGameStatus' to/from \. -- @@ -602,12 +576,12 @@ test_on_delete_cascade = testGroup "cascading delete tests" where check desc path expected = testCase desc $ do score <- unsafe_unpickle path pickle_message - let a = undefined :: Score - let b = undefined :: ScoreGame - let c = undefined :: ScoreGameTeam - let d = undefined :: ScoreGame_ScoreGameTeam - let e = undefined :: ScoreLocation - let f = undefined :: Score_ScoreLocation + let a = undefined :: Location + let b = undefined :: Score + let c = undefined :: ScoreGame + let d = undefined :: ScoreGameTeam + let e = undefined :: ScoreGame_ScoreGameTeam + let f = undefined :: Score_Location actual <- withSqliteConn ":memory:" $ runDbConn $ do runMigration silentMigrationLogger $ do migrate a @@ -618,7 +592,7 @@ test_on_delete_cascade = testGroup "cascading delete tests" migrate f _ <- dbimport score -- No idea how 'delete' works, so do this instead. - deleteAll a + deleteAll b count_a <- countAll a count_b <- countAll b count_c <- countAll c