Use the common TSN.Location representation in TSN.XML.Scores.

diff --git a/src/TSN/XML/Scores.hs b/src/TSN/XML/Scores.hs
index 8ae86a8355e3fc24dcb1d208fe66c712b61d7868..d28925801538799e3ea77734c14015a315eb97b3 100644 (file)
--- 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 \<location\>. 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 \<location\>.
---
-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 \<status\>.
 --
@@ -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