From 819ac1c4b1f16bde572728d76bfd72282d0605ec Mon Sep 17 00:00:00 2001
From: Michael Orlitzky <michael@orlitzky.com>
Date: Tue, 30 Dec 2014 15:13:00 -0500
Subject: [PATCH] Use Generics.to_tuple in TSN.XML.Weather.

---
 src/TSN/XML/Weather.hs | 82 +++++++++++++++++++++++++-----------------
 1 file changed, 50 insertions(+), 32 deletions(-)

diff --git a/src/TSN/XML/Weather.hs b/src/TSN/XML/Weather.hs
index e7c0e3c..1d17fb0 100644
--- a/src/TSN/XML/Weather.hs
+++ b/src/TSN/XML/Weather.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE QuasiQuotes #-}
@@ -40,6 +41,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 (
@@ -67,6 +69,7 @@ import Text.XML.HXT.Core (
   xpWrap )
 
 -- Local imports.
+import Generics ( Generic(..), to_tuple )
 import TSN.Codegen (
   tsn_codegen_config )
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
@@ -102,7 +105,12 @@ data WeatherForecastListingXml =
   WeatherForecastListingXml {
     xml_teams :: String,
     xml_weather :: Maybe String }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic WeatherForecastListingXml
 
 
 -- | Database representation of a weather forecast listing. The
@@ -167,7 +175,12 @@ data WeatherForecastXml =
   WeatherForecastXml {
     xml_game_date :: UTCTime,
     xml_leagues :: [WeatherLeague] }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic WeatherForecastXml
 
 
 instance ToDb WeatherForecastXml where
@@ -222,11 +235,26 @@ data WeatherDetailedWeatherXml =
 --   present in each \<Item\>s.
 --
 data WeatherDetailedWeatherListingXml =
-  WeatherDetailedWeatherListingXml {
-    xml_dtl_listing_sport :: String,
-    xml_dtl_listing_sport_code :: String,
-    xml_items :: [WeatherDetailedWeatherListingItemXml] }
-  deriving (Eq, Show)
+  WeatherDetailedWeatherListingXml
+    String -- xml_dtl_listing_sport, unused
+    String -- xml_dtl_listing_sport_code, unused
+    [WeatherDetailedWeatherListingItemXml] -- xml_items
+  deriving (Eq, GHC.Generic, Show)
+
+
+-- | Accessor for the third field of WeatherDetailedWeatherListingXml.
+--   We don't use field names to avoid the unused field warnings that
+--   we'd otherwise get for the first two fields.
+--
+xml_items :: WeatherDetailedWeatherListingXml
+          -> [WeatherDetailedWeatherListingItemXml]
+xml_items (WeatherDetailedWeatherListingXml _ _ items) = items
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic WeatherDetailedWeatherListingXml
+
 
 -- * WeatherDetailedWeatherListingItem / WeatherDetailedWeatherListingItemXml
 
@@ -266,9 +294,13 @@ data WeatherDetailedWeatherListingItemXml =
     xml_description :: Maybe String,
     xml_temp_adjust :: Maybe String,
     xml_temperature :: Int }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
 
 
+-- | For 'Generics.to_tuple'.
+--
+instance Generic WeatherDetailedWeatherListingItemXml
+
 instance ToDb WeatherDetailedWeatherListingItemXml where
   -- | Our database analogue is a 'WeatherDetailedWeatherListingItem'.
   type Db WeatherDetailedWeatherListingItemXml =
@@ -326,7 +358,13 @@ data Message =
     xml_forecasts :: [WeatherForecastXml],
     xml_detailed_weather :: Maybe WeatherDetailedWeatherXml,
     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 representation of 'Message' is 'Weather'.
@@ -503,14 +541,13 @@ instance DbImport Message where
 pickle_listing :: PU WeatherForecastListingXml
 pickle_listing =
   xpElem "listing" $
-    xpWrap (from_pair, to_pair) $
+    xpWrap (from_pair, to_tuple) $
       xpPair
         (xpElem "teams" xpText)
         (xpElem "weather" (xpOption xpText))
   where
---    from_pair (ts, Nothing) = WeatherForecastListingXml ts (Just "")
     from_pair = uncurry WeatherForecastListingXml
-    to_pair WeatherForecastListingXml{..} = (xml_teams, xml_weather)
+
 
 
 -- | Pickler to convert a 'WeatherLeague' to/from XML.
@@ -560,15 +597,7 @@ pickle_item =
              (xpElem "Temperature" xpInt)
   where
     from_tuple = uncurryN WeatherDetailedWeatherListingItemXml
-    to_tuple w = (xml_sport_code w,
-                  xml_game_id w,
-                  xml_dtl_game_date w,
-                  xml_away_team w,
-                  xml_home_team w,
-                  xml_weather_type w,
-                  xml_description w,
-                  xml_temp_adjust w,
-                  xml_temperature w)
+
 
 
 -- | (Un)pickle a 'WeatherDetailedWeatherListingXml'.
@@ -582,9 +611,6 @@ pickle_dw_listing =
              (xpList pickle_item)
   where
     from_tuple = uncurryN WeatherDetailedWeatherListingXml
-    to_tuple w = (xml_dtl_listing_sport w,
-                  xml_dtl_listing_sport_code w,
-                  xml_items w)
 
 
 -- | (Un)pickle a 'WeatherDetailedWeatherXml'
@@ -613,14 +639,6 @@ pickle_message =
         (xpElem "time_stamp" xp_time_stamp)
   where
     from_tuple = uncurryN Message
-    to_tuple Message{..} = (xml_xml_file_id,
-                            xml_heading,
-                            xml_category,
-                            xml_sport,
-                            xml_title,
-                            xml_forecasts,
-                            xml_detailed_weather,
-                            xml_time_stamp)
 
 
 --
-- 
2.43.2