From 2d8d3c2d84e6880c679c6346802f5a688d047e97 Mon Sep 17 00:00:00 2001
From: Michael Orlitzky <michael@orlitzky.com>
Date: Tue, 30 Dec 2014 14:14:51 -0500
Subject: [PATCH] Use Generics.to_tuple in TSN.XML.ScheduleChanges.

---
 src/TSN/XML/ScheduleChanges.hs | 57 +++++++++++++++++-----------------
 1 file changed, 28 insertions(+), 29 deletions(-)

diff --git a/src/TSN/XML/ScheduleChanges.hs b/src/TSN/XML/ScheduleChanges.hs
index 151b615..a1812da 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,11 @@ 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,9 +125,13 @@ 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
   -- | The database analogue of a 'Message' is a 'ScheduleChanges'.
@@ -164,6 +175,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 +218,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
@@ -345,12 +362,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 +375,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 +388,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 +417,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 +429,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 +445,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)
 
 
 
-- 
2.43.2