From: Michael Orlitzky <michael@orlitzky.com>
Date: Tue, 30 Dec 2014 19:03:26 +0000 (-0500)
Subject: Use Generics.to_tuple in TSN.XML.News.
X-Git-Tag: 0.2.1~49
X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=2fa3100c0dfca8a1a331f318edc84df69bd2254f;p=dead%2Fhtsn-import.git

Use Generics.to_tuple in TSN.XML.News.
---

diff --git a/src/TSN/XML/News.hs b/src/TSN/XML/News.hs
index 0207593..021d49a 100644
--- a/src/TSN/XML/News.hs
+++ b/src/TSN/XML/News.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
@@ -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 (
@@ -65,6 +67,7 @@ import Text.XML.HXT.Core (
   xpWrap )
 
 -- Local imports.
+import Generics ( Generic(..), to_tuple )
 import TSN.Codegen (
   tsn_codegen_config,
   tsn_db_field_namer ) -- Used in a test
@@ -124,7 +127,12 @@ data Message =
     xml_text :: Maybe String,     -- Text and continue seem to show up in pairs,
     xml_continue :: Maybe String, -- either both present or both missing.
     xml_time_stamp :: UTCTime }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic Message
 
 
 -- | The database representation of a news item. We drop several
@@ -181,7 +189,13 @@ instance XmlImport Message
 data NewsTeamXml =
   NewsTeamXml { xml_team_id :: String,
                 xml_team_name :: String }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic NewsTeamXml
+
 
 instance ToDb NewsTeamXml where
   -- | The database representation of 'NewsTeamXml' is 'Team'.
@@ -356,15 +370,11 @@ mkPersist tsn_codegen_config [groundhog|
 pickle_news_team :: PU NewsTeamXml
 pickle_news_team =
   xpElem "team" $
-    xpWrap (from_pair, to_pair) $
+    xpWrap (from_tuple, to_tuple) $
       xpPair (xpAttr "id" xpText)
              xpText -- team name
   where
-    from_pair :: (String, String) -> NewsTeamXml
-    from_pair = uncurry NewsTeamXml
-
-    to_pair :: NewsTeamXml -> (String, String)
-    to_pair (NewsTeamXml x y) = (x,y)
+    from_tuple = uncurry NewsTeamXml
 
 
 -- | Convert a 'MsgId' to/from XML.
@@ -372,11 +382,13 @@ pickle_news_team =
 pickle_msg_id :: PU MsgId
 pickle_msg_id =
   xpElem "msg_id" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, to_tuple') $
     xpPair xpInt (xpAttr "EventId" (xpOption xpInt))
   where
     from_tuple = uncurryN MsgId
-    to_tuple m = (db_msg_id m, db_event_id m)
+
+    -- Avoid unused field warnings.
+    to_tuple' m = (db_msg_id m, db_event_id m)
 
 
 
@@ -401,19 +413,7 @@ pickle_message =
               (xpElem "time_stamp" xp_time_stamp)
   where
     from_tuple = uncurryN Message
-    to_tuple m = (xml_xml_file_id m, -- Verbose,
-                  xml_heading m,     -- but
-                  xml_mid m,         -- eliminates
-                  xml_category m,    -- GHC
-                  xml_sport m,       -- warnings
-                  xml_url m,         -- .
-                  xml_teams m,       -- .
-                  xml_locations m,   -- .
-                  xml_sms m,
-                  xml_editor m,
-                  xml_text m,
-                  xml_continue m,
-                  xml_time_stamp m)
+
 
     -- | We combine all of the \<continue\> elements into one 'String'
     --   while unpickling and do the reverse while pickling.