Use Generics.to_tuple in TSN.XML.Injuries.

diff --git a/src/TSN/XML/Injuries.hs b/src/TSN/XML/Injuries.hs
index 3f0fea55e364b066dfe4e95a2979893f4f0e75c0..368f8460c1cb95876eec92c2a6ed22dd663eed47 100644 (file)
--- a/src/TSN/XML/Injuries.hs
+++ b/src/TSN/XML/Injuries.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
@@ -40,6 +41,7 @@ import Database.Groundhog.Generic ( runDbConn )
 import Database.Groundhog.TH (
   groundhog,
   mkPersist )
+import qualified GHC.Generics as GHC ( Generic )
 import Database.Groundhog.Sqlite ( withSqliteConn )
 import Data.Tuple.Curry ( uncurryN )
 import Test.Tasty ( TestTree, testGroup )
@@ -59,6 +61,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 )
 import TSN.Picklers ( xp_time_stamp )
@@ -105,7 +108,13 @@ data InjuriesListingXml =
     xml_teamno :: Maybe String, -- ^ Can contain non-numerics, e.g. \"ZR2\"
     xml_injuries :: String,
     xml_updated :: Maybe Bool }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic InjuriesListingXml
+
 
 -- | Database representation of a 'InjuriesListing'. It possesses a
 --   foreign key to an 'Injuries' object so that we can easily delete
@@ -156,7 +165,13 @@ data Message =
     xml_sport :: String,
     xml_listings :: [InjuriesListingXml],
     xml_time_stamp :: UTCTime }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic Message
+
 
 -- | Database representation of a 'Message'.
 --
@@ -249,12 +264,13 @@ mkPersist tsn_codegen_config [groundhog|
 pickle_injuries_team :: PU InjuriesTeam
 pickle_injuries_team =
   xpElem "team" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, to_tuple') $
     xpPair xpText (xpAttrImplied "league" xpText)
   where
     from_tuple = uncurryN InjuriesTeam
-    to_tuple m = (db_team_name m, db_team_league m)
 
+    -- Pointless, but silences two unused field warnings.
+    to_tuple' InjuriesTeam{..} = (db_team_name, db_team_league)
 
 -- | A pickler for 'InjuriesListingXml's that can convert them to/from
 --   XML.
@@ -269,7 +285,7 @@ pickle_listing =
              (xpOption $ xpElem "updated" xpPrim)
   where
     from_tuple = uncurryN InjuriesListingXml
-    to_tuple l = (xml_team l, xml_teamno l, xml_injuries l, xml_updated l)
+
 
 
 -- | A pickler for 'Message's that can convert them to/from XML.
@@ -286,12 +302,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_listings m,
-                  xml_time_stamp m)
 
 
 --