From 346f1940cfb31f88d07e65fc099e793b4fbcce02 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Sat, 5 Jul 2014 22:41:22 -0400 Subject: [PATCH] Use the common TSN.Location representation in TSN.XML.Scores. --- src/TSN/XML/Scores.hs | 95 ++++++++++++++----------------------------- 1 file changed, 30 insertions(+), 65 deletions(-) diff --git a/src/TSN/XML/Scores.hs b/src/TSN/XML/Scores.hs index 8ae86a8..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,9 +60,10 @@ 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 ( @@ -118,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 } @@ -271,53 +271,41 @@ data ScoreGame_ScoreGameTeam = (DefaultKey ScoreGameTeam) -- hteam id --- * ScoreLocation +-- * Score_Location --- | 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) - - --- * Score_ScoreLocation - --- | 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) @@ -344,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] - |] @@ -411,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 |] @@ -464,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 \. -- @@ -611,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 @@ -627,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 -- 2.43.2