Use Generics.to_tuple in TSN.XML.Odds.

diff --git a/src/TSN/XML/Odds.hs b/src/TSN/XML/Odds.hs
index 128b5b455160778ef09b1333fb7b24460729fb18..c3bd6c487532926d499a883c7549580dd9123914 100644 (file)
--- a/src/TSN/XML/Odds.hs
+++ b/src/TSN/XML/Odds.hs
@@ -1,6 +1,8 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternGuards #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -43,6 +45,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.Read ( readMaybe )
@@ -61,6 +64,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 )
@@ -121,7 +125,12 @@ data OddsGameCasinoXml =
     xml_casino_client_id :: Maybe Int,
     xml_casino_name      :: Maybe String,
     xml_casino_line      :: Maybe String }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic OddsGameCasinoXml
 
 
 -- | Try to get a 'Double' out of the 'xml_casino_line' which is a
@@ -167,7 +176,12 @@ data OddsGameTeamStarterXml =
   OddsGameTeamStarterXml {
     xml_starter_id :: Int,
     xml_starter_name :: Maybe String }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic OddsGameTeamStarterXml
 
 
 -- | The XML representation of a \<HomeTeam\> or \<AwayTeam\>, as
@@ -189,7 +203,13 @@ data OddsGameTeamXml =
     xml_team_name            :: String,
     xml_team_starter         :: Maybe OddsGameTeamStarterXml,
     xml_team_casinos         :: [OddsGameCasinoXml] }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic OddsGameTeamXml
+
 
 instance ToDb OddsGameTeamXml where
   -- | The database representation of an 'OddsGameTeamXml' is an
@@ -279,7 +299,13 @@ data OddsGameXml =
     xml_away_team  :: OddsGameTeamXml,
     xml_home_team  :: OddsGameTeamXml,
     xml_over_under :: OddsGameOverUnderXml }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic OddsGameXml
+
 
 -- | Pseudo-field that lets us get the 'OddsGameCasinoXml's out of
 --   xml_over_under.
@@ -414,7 +440,12 @@ data Message =
     xml_line_time :: String,
     xml_games_with_notes :: [OddsGameWithNotes],
     xml_time_stamp :: UTCTime }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic Message
+
 
 -- | Pseudo-field that lets us get the 'OddsGame's out of
 --   'xml_games_with_notes'.
@@ -589,9 +620,10 @@ instance DbImport Message where
 
     where
       nonempty_casino :: OddsGameCasinoXml -> Bool
-      nonempty_casino (OddsGameCasinoXml Nothing _ _) = False
-      nonempty_casino (OddsGameCasinoXml _ Nothing _) = False
-      nonempty_casino _ = True
+      nonempty_casino OddsGameCasinoXml{..}
+        | Nothing <- xml_casino_client_id = False
+        | Nothing <- xml_casino_name = False
+        | otherwise = True
 
 --
 -- Pickling
@@ -623,10 +655,6 @@ pickle_casino =
     (xpOption xpText)
   where
     from_tuple = uncurryN OddsGameCasinoXml
-    -- Use record wildcards to avoid unused field warnings.
-    to_tuple OddsGameCasinoXml{..} = (xml_casino_client_id,
-                                      xml_casino_name,
-                                      xml_casino_line)
 
 
 -- | Pickler for an 'OddsGameTeamXml'.
@@ -645,13 +673,6 @@ pickle_home_team =
   where
     from_tuple = uncurryN OddsGameTeamXml
 
-    -- Use record wildcards to avoid unused field warnings.
-    to_tuple OddsGameTeamXml{..} = (xml_team_id,
-                                    xml_team_rotation_number,
-                                    xml_team_abbr,
-                                    xml_team_name,
-                                    xml_team_starter,
-                                    xml_team_casinos)
 
 
 -- | Portion of the 'OddsGameTeamStarterXml' pickler that is not
@@ -663,8 +684,7 @@ pickle_starter =
     xpPair (xpAttr "ID" xpInt) (xpOption xpText)
   where
     from_tuple = uncurry OddsGameTeamStarterXml
-    to_tuple OddsGameTeamStarterXml{..} = (xml_starter_id,
-                                           xml_starter_name)
+
 
 -- | Pickler for an home team 'OddsGameTeamStarterXml'
 --
@@ -695,14 +715,6 @@ pickle_away_team =
   where
     from_tuple = uncurryN OddsGameTeamXml
 
-    -- Use record wildcards to avoid unused field warnings.
-    to_tuple OddsGameTeamXml{..} = (xml_team_id,
-                                    xml_team_rotation_number,
-                                    xml_team_abbr,
-                                    xml_team_name,
-                                    xml_team_starter,
-                                    xml_team_casinos)
-
 
 
 -- | Pickler for an 'OddsGameOverUnderXml'.
@@ -732,13 +744,6 @@ pickle_game =
     pickle_over_under
   where
     from_tuple = uncurryN OddsGameXml
-    -- Use record wildcards to avoid unused field warnings.
-    to_tuple OddsGameXml{..} = (xml_game_id,
-                                xml_game_date,
-                                xml_game_time,
-                                xml_away_team,
-                                xml_home_team,
-                                xml_over_under)
 
 
 -- | Pickler for the top-level 'Message'.
@@ -757,14 +762,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_title m,
-                  xml_line_time m,
-                  xml_games_with_notes m,
-                  xml_time_stamp m)
 
 
 --