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

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

diff --git a/src/TSN/XML/JFile.hs b/src/TSN/XML/JFile.hs
index 84e6b66..b3b3280 100644
--- a/src/TSN/XML/JFile.hs
+++ b/src/TSN/XML/JFile.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE QuasiQuotes #-}
@@ -39,6 +40,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 (
@@ -60,6 +62,7 @@ import Text.XML.HXT.Core (
 
 
 -- 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 )
@@ -121,7 +124,12 @@ data Message =
     xml_sport :: String,
     xml_gamelist :: JFileGameListXml,
     xml_time_stamp :: UTCTime }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic Message
 
 
 instance ToDb Message where
@@ -199,6 +207,7 @@ data JFileGameStatus =
   deriving (Eq, Show)
 
 
+
 -- | Database representation of a \<game\> contained within a
 --   \<message\>, and, implicitly, a \<gamelist\>.
 --
@@ -245,7 +254,12 @@ data JFileGameXml =
     xml_hscore :: Int,
     xml_time_remaining :: Maybe String,
     xml_game_status :: JFileGameStatus }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic JFileGameXml
 
 
 -- * JFileGameListXml
@@ -430,12 +444,7 @@ 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_gamelist m,
-                  xml_time_stamp m)
+
 
 pickle_gamelist :: PU JFileGameListXml
 pickle_gamelist =
@@ -468,25 +477,12 @@ pickle_game =
               pickle_status
   where
     from_tuple = uncurryN JFileGameXml
-    to_tuple m = (xml_game_id m,
-                  xml_schedule_id m,
-                  xml_odds_info m,
-                  xml_season_type m,
-                  xml_game_date m,
-                  xml_game_time m,
-                  xml_vteam m,
-                  xml_vleague m,
-                  xml_hteam m,
-                  xml_hleague m,
-                  xml_vscore m,
-                  xml_hscore m,
-                  xml_time_remaining m,
-                  xml_game_status m)
+
 
 pickle_odds_info :: PU JFileGameOddsInfo
 pickle_odds_info =
   xpElem "Odds_Info" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, to_tuple') $
     xp19Tuple (xpElem "ListDate" (xpOption xp_date))
               (xpElem "HomeTeamID" (xpOption xpText))
               (xpElem "AwayTeamID" (xpOption xpText))
@@ -512,21 +508,21 @@ pickle_odds_info =
       where
         notes = intercalate "\n" [n1,n2,n3,n4,n5]
 
-    to_tuple o = (db_list_date o,
-                  db_info_home_team_id o,
-                  db_info_away_team_id o,
-                  db_home_abbr o,
-                  db_away_abbr o,
-                  db_home_team_name o,
-                  db_away_team_name o,
-                  db_home_starter o,
-                  db_away_starter o,
-                  db_game_date o,
-                  db_home_game_key o,
-                  db_away_game_key o,
-                  db_current_timestamp o,
-                  db_live o,
-                  n1,n2,n3,n4,n5)
+    to_tuple' o = (db_list_date o,
+                   db_info_home_team_id o,
+                   db_info_away_team_id o,
+                   db_home_abbr o,
+                   db_away_abbr o,
+                   db_home_team_name o,
+                   db_away_team_name o,
+                   db_home_starter o,
+                   db_away_starter o,
+                   db_game_date o,
+                   db_home_game_key o,
+                   db_away_game_key o,
+                   db_current_timestamp o,
+                   db_live o,
+                   n1,n2,n3,n4,n5)
       where
         note_lines = split "\n" (db_notes o)
         n1 = case note_lines of
@@ -551,15 +547,13 @@ pickle_odds_info =
 pickle_home_team :: PU HTeam
 pickle_home_team =
   xpElem "hteam" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, to_tuple') $
     xpTriple (xpAttr "teamid" xpText) -- Yeah, they're text.
              (xpAttr "abbr" (xpOption xpText)) -- Some are blank
              (xpOption xpText) -- Yup, some are nameless
   where
     from_tuple = HTeam . (uncurryN Team)
-    to_tuple (HTeam t) = (team_id t,
-                          abbreviation t,
-                          name t)
+    to_tuple' (HTeam t) = to_tuple t
 
 
 -- | (Un)pickle an away team to/from the dual XML/DB representation
@@ -568,28 +562,26 @@ pickle_home_team =
 pickle_away_team :: PU VTeam
 pickle_away_team =
   xpElem "vteam" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, to_tuple') $
     xpTriple (xpAttr "teamid" xpText) -- Yeah, they're text.
              (xpAttr "abbr" (xpOption xpText)) -- Some are blank
              (xpOption xpText) -- Yup, some are nameless
   where
     from_tuple = VTeam . (uncurryN Team)
-    to_tuple (VTeam t) = (team_id t,
-                          abbreviation t,
-                          name t)
+    to_tuple' (VTeam t) = to_tuple t
 
 
 pickle_status :: PU JFileGameStatus
 pickle_status =
   xpElem "status" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, to_tuple') $
     xpPair (xpAttr "numeral" xpInt)
            (xpOption xpText)
   where
     from_tuple = uncurry JFileGameStatus
-    to_tuple s = (db_status_numeral s,
-                  db_status s)
 
+    -- Avoid unused field warnings.
+    to_tuple' JFileGameStatus{..} = (db_status_numeral, db_status)
 
 
 --