X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FScheduleChanges.hs;h=4d7730d5d3efb2625bfb4d678aed33e90d5eb747;hb=5460d19a75535d22579ae3708acf5c39998f49d0;hp=c447f35158a467be32f64c52b46e67f92662a3a9;hpb=36079b940ebe9a85ac2086fe640e39a0d51e756e;p=dead%2Fhtsn-import.git

diff --git a/src/TSN/XML/ScheduleChanges.hs b/src/TSN/XML/ScheduleChanges.hs
index c447f35..4d7730d 100644
--- a/src/TSN/XML/ScheduleChanges.hs
+++ b/src/TSN/XML/ScheduleChanges.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE QuasiQuotes #-}
@@ -38,6 +39,7 @@ import Database.Groundhog.Sqlite ( withSqliteConn )
 import Database.Groundhog.TH (
   groundhog,
   mkPersist )
+import qualified GHC.Generics as GHC ( Generic )
 import Test.Tasty ( TestTree, testGroup )
 import Test.Tasty.HUnit ( (@?=), testCase )
 import Text.XML.HXT.Core (
@@ -54,6 +56,7 @@ import Text.XML.HXT.Core (
   xpWrap )
 
 -- Local imports.
+import Generics ( Generic(..), to_tuple )
 import TSN.Codegen ( tsn_codegen_config )
 import TSN.Database ( insert_or_select )
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
@@ -104,7 +107,12 @@ data ScheduleChangeXml =
   ScheduleChangeXml {
     xml_sc_sport :: String,
     xml_sc_listings :: [ScheduleChangesListingXml] }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic ScheduleChangeXml
 
 
 -- | XML representation of a 'ScheduleChanges'. It has the same
@@ -118,8 +126,12 @@ data Message =
     xml_sport :: String,
     xml_schedule_changes :: [ScheduleChangeXml],
     xml_time_stamp :: UTCTime }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
 
+-- | For 'Generics.to_tuple'.
+--
+instance Generic Message
 
 
 instance ToDb Message where
@@ -164,6 +176,7 @@ data ScheduleChangesListingStatus =
   deriving (Eq, Show)
 
 
+
 -- | Database representation of a \<SC_Listing\> contained within a
 --   \<Schedule_Change\>, within a \<message\>. During the transition
 --   to the database, we drop the intermediate \<Schedule_Change\>
@@ -206,7 +219,12 @@ data ScheduleChangesListingXml =
     xml_hscore :: Int,
     xml_listing_status :: ScheduleChangesListingStatus,
     xml_notes :: Maybe String }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic ScheduleChangesListingXml
 
 
 instance ToDb ScheduleChangesListingXml where
@@ -303,7 +321,7 @@ mkPersist tsn_codegen_config [groundhog|
           # Prevent multiple imports of the same message.
           fields: [db_xml_file_id]
 
-# Note: we drop the "sc" prefix from the db_sc_sport field.
+  # Note: we drop the "sc" prefix from the db_sc_sport field.
 - entity: ScheduleChangesListing
   dbName: schedule_changes_listings
   constructors:
@@ -345,12 +363,12 @@ mkPersist tsn_codegen_config [groundhog|
 pickle_away_team :: PU VTeam
 pickle_away_team =
   xpElem "Away_Team" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, to_tuple') $
     xpPair (xpAttr "AT_ID" xpText)
            (xpOption xpText)
   where
     from_tuple (x,y) = VTeam (Team x Nothing y)
-    to_tuple (VTeam t) = (team_id t, name t)
+    to_tuple' (VTeam t) = (team_id t, name t)
 
 
 -- | An (un)pickler for the \<Away_Team\> elements.
@@ -358,12 +376,12 @@ pickle_away_team =
 pickle_home_team :: PU HTeam
 pickle_home_team =
   xpElem "Home_Team" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, to_tuple') $
     xpPair (xpAttr "HT_ID" xpText)
            (xpOption xpText)
   where
     from_tuple (x,y) = HTeam (Team x Nothing y)
-    to_tuple (HTeam t) = (team_id t, name t)
+    to_tuple' (HTeam t) = (team_id t, name t)
 
 
 -- | An (un)pickler for the \<status\> elements.
@@ -371,14 +389,15 @@ pickle_home_team =
 pickle_status :: PU ScheduleChangesListingStatus
 pickle_status =
   xpElem "status" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, to_tuple') $
     xpPair (xpAttr "numeral" xpInt)
            (xpOption xpText)
   where
     from_tuple = uncurry ScheduleChangesListingStatus
-    to_tuple s = (db_status_numeral s,
-                  db_status s)
 
+    -- Avouid unused field warnings.
+    to_tuple' ScheduleChangesListingStatus{..} =
+      (db_status_numeral, db_status)
 
 -- | An (un)pickler for the \<SC_Listing\> elements.
 --
@@ -399,17 +418,6 @@ pickle_listing =
               (xpElem "notes" (xpOption xpText))
   where
     from_tuple = uncurryN ScheduleChangesListingXml
-    to_tuple l = (xml_type l,
-                  xml_schedule_id l,
-                  xml_game_date l,
-                  xml_game_time l,
-                  xml_location l,
-                  xml_away_team l,
-                  xml_home_team l,
-                  xml_vscore l,
-                  xml_hscore l,
-                  xml_listing_status l,
-                  xml_notes l)
 
 
 -- | An (un)pickler for the \<Schedule_Change\> elements.
@@ -422,8 +430,6 @@ pickle_schedule_change =
            (xpList pickle_listing)
   where
     from_tuple = uncurry ScheduleChangeXml
-    to_tuple sc = (xml_sc_sport sc,
-                   xml_sc_listings sc)
 
 
 -- | Pickler for the top-level 'Message'.
@@ -440,12 +446,6 @@ pickle_message =
              (xpElem "time_stamp" xp_time_stamp)
   where
     from_tuple = uncurryN Message
-    to_tuple m = (xml_xml_file_id m,
-                  xml_heading m,
-                  xml_category m,
-                  xml_sport m,
-                  xml_schedule_changes m,
-                  xml_time_stamp m)