From: Michael Orlitzky <michael@orlitzky.com>
Date: Sun, 6 Jul 2014 03:20:45 +0000 (-0400)
Subject: Use HTeam/VTeam wrappers in TSN.XML.ScheduleChanges.
X-Git-Tag: 0.0.6~15
X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhtsn-import.git;a=commitdiff_plain;h=36079b940ebe9a85ac2086fe640e39a0d51e756e

Use HTeam/VTeam wrappers in TSN.XML.ScheduleChanges.
Eliminate redundant Team XML representation in TSN.XML.ScheduleChanges.
---

diff --git a/src/TSN/XML/ScheduleChanges.hs b/src/TSN/XML/ScheduleChanges.hs
index 5dc6872..c447f35 100644
--- a/src/TSN/XML/ScheduleChanges.hs
+++ b/src/TSN/XML/ScheduleChanges.hs
@@ -54,11 +54,11 @@ 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.Picklers ( xp_date_padded, xp_tba_time, xp_time_stamp )
-import TSN.Team ( Team(..) )
+import TSN.Team ( Team(..), HTeam(..), VTeam(..) )
 import TSN.XmlImport ( XmlImport(..) )
 import Xml (
   FromXml(..),
@@ -200,8 +200,8 @@ data ScheduleChangesListingXml =
     xml_game_date :: UTCTime,
     xml_game_time :: Maybe UTCTime,
     xml_location :: Maybe String,
-    xml_away_team :: ScheduleChangesListingTeamXml,
-    xml_home_team :: ScheduleChangesListingTeamXml,
+    xml_away_team :: VTeam,
+    xml_home_team :: HTeam,
     xml_vscore :: Int,
     xml_hscore :: Int,
     xml_listing_status :: ScheduleChangesListingStatus,
@@ -256,43 +256,6 @@ from_xml_fk_sport fk sport fk_away fk_home ScheduleChangesListingXml{..} =
 
 
 
--- * ScheduleChangesListingTeamXml
-
--- | The XML representation of a 'ScheduleChangesListing'
---   team. Its corresponding database representation (along with that
---   of the home team) is a "TSN.Team", but their XML representations
---   are slightly different.
---
-data ScheduleChangesListingTeamXml =
-  ScheduleChangesListingTeamXml {
-    xml_team_id :: String,
-    xml_team_name :: Maybe String }
-  deriving (Eq, Show)
-
-
-instance ToDb ScheduleChangesListingTeamXml where
-  -- | The database analogue of an 'ScheduleChangesListingTeamXml' is
-  --   a 'Team'.
-  --
-  type Db ScheduleChangesListingTeamXml = Team
-
-
-instance FromXml ScheduleChangesListingTeamXml where
-  -- | To convert a 'ScheduleChangesListingTeamXml' to a 'Team',
-  --   we set the non-existent abbreviation to \"Nothing\".
-  --
-  from_xml ScheduleChangesListingTeamXml{..} =
-    Team {
-      team_id = xml_team_id,
-      abbreviation = Nothing,
-      name  = xml_team_name }
-
--- | Allow us to import ScheduleChangesListingTeamXml directly.
---
-instance XmlImport ScheduleChangesListingTeamXml
-
-
-
 --
 -- * Database stuff.
 --
@@ -317,8 +280,8 @@ instance DbImport Message where
       -- Now loop through the listings so that we can handle the teams
       -- one listing at a time.
       forM_ (xml_sc_listings sc) $ \listing -> do
-        away_team_id <- insert_xml_or_select (xml_away_team listing)
-        home_team_id <- insert_xml_or_select (xml_home_team listing)
+        away_team_id <- insert_or_select (vteam $ xml_away_team listing)
+        home_team_id <- insert_or_select (hteam $ xml_home_team listing)
 
         -- Finish constructing the xml -> db function.
         let listing_xml_to_db' = listing_xml_to_db away_team_id home_team_id
@@ -379,30 +342,28 @@ mkPersist tsn_codegen_config [groundhog|
 
 -- | An (un)pickler for the \<Away_Team\> elements.
 --
-pickle_away_team :: PU ScheduleChangesListingTeamXml
+pickle_away_team :: PU VTeam
 pickle_away_team =
   xpElem "Away_Team" $
     xpWrap (from_tuple, to_tuple) $
     xpPair (xpAttr "AT_ID" xpText)
            (xpOption xpText)
   where
-    from_tuple = uncurry ScheduleChangesListingTeamXml
-    to_tuple t = (xml_team_id t,
-                  xml_team_name t)
+    from_tuple (x,y) = VTeam (Team x Nothing y)
+    to_tuple (VTeam t) = (team_id t, name t)
 
 
 -- | An (un)pickler for the \<Away_Team\> elements.
 --
-pickle_home_team :: PU ScheduleChangesListingTeamXml
+pickle_home_team :: PU HTeam
 pickle_home_team =
   xpElem "Home_Team" $
     xpWrap (from_tuple, to_tuple) $
     xpPair (xpAttr "HT_ID" xpText)
            (xpOption xpText)
   where
-    from_tuple = uncurry ScheduleChangesListingTeamXml
-    to_tuple t = (xml_team_id t,
-                  xml_team_name t)
+    from_tuple (x,y) = HTeam (Team x Nothing y)
+    to_tuple (HTeam t) = (team_id t, name t)
 
 
 -- | An (un)pickler for the \<status\> elements.