]> gitweb.michael.orlitzky.com - dead/htsn-import.git/commitdiff
Update TSN.XML.Odds to use the new TSN.Team type.
authorMichael Orlitzky <michael@orlitzky.com>
Tue, 24 Jun 2014 21:05:30 +0000 (17:05 -0400)
committerMichael Orlitzky <michael@orlitzky.com>
Tue, 24 Jun 2014 21:05:30 +0000 (17:05 -0400)
doc/dbschema/Odds_XML.png
src/TSN/XML/Odds.hs

index 323894cd5ad5f40f48dc8d6e0ce22a93fe679abb..7f28a550e888c61a661ed8e034b336402ae18461 100644 (file)
Binary files a/doc/dbschema/Odds_XML.png and b/doc/dbschema/Odds_XML.png differ
index 6b7d4ab9d831d7fd10dd16d6ca252c0fa1d0d142..7af360cfb53f6adb3fa421ef18f07e0214fc5134 100644 (file)
@@ -11,9 +11,6 @@
 --   other... disorganized... information.
 --
 module TSN.XML.Odds (
-  OddsGameAwayTeamXml(..), -- Used in TSN.XML.JFile
-  OddsGameHomeTeamXml(..), -- Used in TSN.XML.JFile
-  OddsGameTeam(..),        -- Used in TSN.XML.JFile
   dtd,
   pickle_message,
   -- * Tests
@@ -21,10 +18,9 @@ module TSN.XML.Odds (
   -- * WARNING: these are private but exported to silence warnings
   OddsCasinoConstructor(..),
   OddsConstructor(..),
-  OddsGame_OddsGameTeamConstructor(..),
+  OddsGame_TeamConstructor(..),
   OddsGameConstructor(..),
-  OddsGameLineConstructor(..),
-  OddsGameTeamConstructor(..) )
+  OddsGameLineConstructor(..) )
 where
 
 -- System imports.
@@ -70,6 +66,7 @@ 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.Team ( Team(..) )
 import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) )
 import Xml (
   FromXml(..),
@@ -150,28 +147,11 @@ instance FromXml OddsGameCasinoXml where
 instance XmlImport OddsGameCasinoXml
 
 
--- * OddsGameTeam
-
-
--- | The database representation of teams as they appear in odds
---   games.
---
-data OddsGameTeam =
-  OddsGameTeam {
-    db_team_id         :: String, -- ^ The home/away team IDs are
-                                  --   three characters but Postgres
-                                  --   imposes no performance penalty
-                                  --   on lengthless text fields, so
-                                  --   we ignore the probable upper
-                                  --   bound of three characters.
-    db_abbr            :: String,
-    db_team_name       :: String }
-  deriving (Eq, Show)
-
-
--- * OddsGameHomeTeam/OddsGameHomeTeamXml
+-- * OddsGameHomeTeamXml / OddsGameAwayTeamXml
 
 -- | The XML representation of a \<HomeTeam\>, as found in \<Game\>s.
+--   This is basically the same as 'OddsGameAwayTeamXml', but the two
+--   types have different picklers.
 --
 data OddsGameHomeTeamXml =
   OddsGameHomeTeamXml {
@@ -193,7 +173,7 @@ instance ToDb OddsGameHomeTeamXml where
   -- | The database representation of an 'OddsGameHomeTeamXml' is an
   --   'OddsGameTeam'.
   --
-  type Db OddsGameHomeTeamXml = OddsGameTeam
+  type Db OddsGameHomeTeamXml = Team
 
 instance FromXml OddsGameHomeTeamXml where
   -- | We convert from XML to the database by dropping the lines and
@@ -201,10 +181,10 @@ instance FromXml OddsGameHomeTeamXml where
   --   themselves).
   --
   from_xml OddsGameHomeTeamXml{..} =
-    OddsGameTeam {
-      db_team_id   = xml_home_team_id,
-      db_abbr      = xml_home_abbr,
-      db_team_name = xml_home_team_name }
+    Team {
+      team_id   = xml_home_team_id,
+      team_abbreviation      = xml_home_abbr,
+      team_name = xml_home_team_name }
 
 -- | This allows us to insert the XML representation
 --   'OddsGameHomeTeamXml' directly.
@@ -212,9 +192,10 @@ instance FromXml OddsGameHomeTeamXml where
 instance XmlImport OddsGameHomeTeamXml where
 
 
--- * OddsGameAwayTeam/OddsGameAwayTeamXml
 
 -- | The XML representation of a \<AwayTeam\>, as found in \<Game\>s.
+--   This is basically the same as 'OddsGameHomeTeamXml', but the two
+--   types have different picklers.
 --
 data OddsGameAwayTeamXml =
   OddsGameAwayTeamXml {
@@ -231,17 +212,17 @@ data OddsGameAwayTeamXml =
   deriving (Eq, Show)
 
 instance ToDb OddsGameAwayTeamXml where
-  -- | The database representation of an 'OddsGameAwayTeamXml' is an
-  --   'OddsGameTeam'.
+  -- | The database representation of an 'OddsGameAwayTeamXml' is a
+  --   'Team'.
   --
-  type Db OddsGameAwayTeamXml = OddsGameTeam
+  type Db OddsGameAwayTeamXml = Team
 
 instance FromXml OddsGameAwayTeamXml where
   -- | We convert from XML to the database by dropping the lines and
   --   rotation number (which are specific to the games, not the teams
   --   themselves).
   --
-  from_xml OddsGameAwayTeamXml{..} = OddsGameTeam
+  from_xml OddsGameAwayTeamXml{..} = Team
                                        xml_away_team_id
                                        xml_away_abbr
                                        xml_away_team_name
@@ -256,11 +237,11 @@ instance XmlImport OddsGameAwayTeamXml where
 
 -- | Database mapping between games and their home/away teams.
 --
-data OddsGame_OddsGameTeam =
-  OddsGame_OddsGameTeam {
-    ogogt_odds_games_id :: DefaultKey OddsGame,
-    ogogt_away_team_id  :: DefaultKey OddsGameTeam,
-    ogogt_home_team_id  :: DefaultKey OddsGameTeam }
+data OddsGame_Team =
+  OddsGame_Team {
+    ogt_odds_games_id :: DefaultKey OddsGame,
+    ogt_away_team_id  :: DefaultKey Team,
+    ogt_home_team_id  :: DefaultKey Team }
 
 
 -- * OddsGameOverUnderXml
@@ -471,16 +452,6 @@ mkPersist tsn_codegen_config [groundhog|
           type: constraint
           fields: [casino_client_id]
 
-- entity: OddsGameTeam
-  dbName: odds_games_teams
-  constructors:
-    - name: OddsGameTeam
-      uniques:
-        - name: unique_odds_games_team
-          type: constraint
-          fields: [db_team_id]
-
-
 - entity: OddsGame
   dbName: odds_games
   constructors:
@@ -502,18 +473,18 @@ mkPersist tsn_codegen_config [groundhog|
           reference:
             onDelete: cascade
 
-- entity: OddsGame_OddsGameTeam
-  dbName: odds_games__odds_games_teams
+- entity: OddsGame_Team
+  dbName: odds_games__teams
   constructors:
-    - name: OddsGame_OddsGameTeam
+    - name: OddsGame_Team
       fields:
-        - name: ogogt_odds_games_id
+        - name: ogt_odds_games_id
           reference:
             onDelete: cascade
-        - name: ogogt_away_team_id
+        - name: ogt_away_team_id
           reference:
             onDelete: cascade
-        - name: ogogt_home_team_id
+        - name: ogt_home_team_id
           reference:
             onDelete: cascade
 |]
@@ -521,11 +492,11 @@ mkPersist tsn_codegen_config [groundhog|
 instance DbImport Message where
   dbmigrate _=
     run_dbmigrate $ do
+      migrate (undefined :: Team)
       migrate (undefined :: Odds)
       migrate (undefined :: OddsCasino)
-      migrate (undefined :: OddsGameTeam)
       migrate (undefined :: OddsGame)
-      migrate (undefined :: OddsGame_OddsGameTeam)
+      migrate (undefined :: OddsGame_Team)
       migrate (undefined :: OddsGameLine)
 
   dbimport m = do
@@ -535,21 +506,20 @@ instance DbImport Message where
     forM_ (xml_games m) $ \g -> do
       -- Next, we insert the home and away teams. We do this before
       -- inserting the game itself because the game has two foreign keys
-      -- pointing to odds_games_teams.
-      -- Next to insert the home and away teams.
+      -- pointing to "teams".
       away_team_id <- insert_xml_or_select (xml_game_away_team g)
       home_team_id <- insert_xml_or_select (xml_game_home_team g)
 
       -- Now insert the game, keyed to the "odds",
       game_id <- insert_xml_fk odds_id g
 
-      -- Insert a record into odds_games__odds_games_teams mapping the
+      -- Insert a record into odds_games__teams mapping the
       -- home/away teams to this game. Use the full record syntax
       -- because the types would let us mix up the home/away teams.
-      insert_ OddsGame_OddsGameTeam {
-                ogogt_odds_games_id = game_id,
-                ogogt_away_team_id = away_team_id,
-                ogogt_home_team_id = home_team_id }
+      insert_ OddsGame_Team {
+                ogt_odds_games_id = game_id,
+                ogt_away_team_id = away_team_id,
+                ogt_home_team_id = home_team_id }
 
       -- Finaly, we insert the lines. The over/under entries for this
       -- game and the lines for the casinos all wind up in the same
@@ -798,7 +768,7 @@ test_unpickle_succeeds = testGroup "unpickle tests"
 
 
 -- | Make sure everything gets deleted when we delete the top-level
---   record.
+--   record. The casinos and teams should be left behind.
 --
 test_on_delete_cascade :: TestTree
 test_on_delete_cascade = testGroup "cascading delete tests"
@@ -824,11 +794,11 @@ test_on_delete_cascade = testGroup "cascading delete tests"
   where
     check desc path expected = testCase desc $ do
       odds <- unsafe_unpickle path pickle_message
-      let a = undefined :: Odds
-      let b = undefined :: OddsCasino
-      let c = undefined :: OddsGameTeam
+      let a = undefined :: Team
+      let b = undefined :: Odds
+      let c = undefined :: OddsCasino
       let d = undefined :: OddsGame
-      let e = undefined :: OddsGame_OddsGameTeam
+      let e = undefined :: OddsGame_Team
       let f = undefined :: OddsGameLine
       actual <- withSqliteConn ":memory:" $ runDbConn $ do
                   runMigration silentMigrationLogger $ do
@@ -839,7 +809,7 @@ test_on_delete_cascade = testGroup "cascading delete tests"
                     migrate e
                     migrate f
                   _ <- dbimport odds
-                  deleteAll a
+                  deleteAll b
                   count_a <- countAll a
                   count_b <- countAll b
                   count_c <- countAll c