From: Michael Orlitzky <michael@orlitzky.com>
Date: Mon, 29 Dec 2014 21:34:41 +0000 (-0500)
Subject: Use Generics.to_tuple in TSN.XML.EarlyLine.
X-Git-Tag: 0.2.1~55
X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=3bfc121da2702b9d7df9978b78367991eff6bff1;p=dead%2Fhtsn-import.git

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

diff --git a/src/TSN/XML/EarlyLine.hs b/src/TSN/XML/EarlyLine.hs
index 71379f9..88c8634 100644
--- a/src/TSN/XML/EarlyLine.hs
+++ b/src/TSN/XML/EarlyLine.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE QuasiQuotes #-}
@@ -49,6 +50,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 (
@@ -66,6 +68,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 (
@@ -120,7 +123,11 @@ data Message =
     xml_title :: String,
     xml_dates :: [EarlyLineDate],
     xml_time_stamp :: UTCTime }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic Message
 
 
 instance ToDb Message where
@@ -171,10 +178,21 @@ instance XmlImport Message
 --   with. But it allows us to pickle and unpickle correctly at least.
 --
 data EarlyLineGameWithNote =
-  EarlyLineGameWithNote {
-    date_note :: Maybe String,
-    date_game :: EarlyLineGameXml }
-  deriving (Eq, Show)
+  EarlyLineGameWithNote
+    (Maybe String) -- date_note, unused
+    EarlyLineGameXml -- date_game
+  deriving (Eq, GHC.Generic, Show)
+
+-- | Accessor for the game within a 'EarlyLineGameWithNote'. We define
+--   this ourselves to avoid an unused field warning for date_note.
+--
+date_game :: EarlyLineGameWithNote -> EarlyLineGameXml
+date_game (EarlyLineGameWithNote _ g) = g
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic EarlyLineGameWithNote
+
 
 
 -- | XML representation of a \<date\>. It has a \"value\" attribute
@@ -186,7 +204,11 @@ data EarlyLineDate =
   EarlyLineDate {
     date_value :: UTCTime,
     date_games_with_notes :: [EarlyLineGameWithNote] }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic EarlyLineDate
 
 
 
@@ -232,8 +254,12 @@ data EarlyLineGameXml =
     xml_away_team :: EarlyLineGameTeamXml,
     xml_home_team :: EarlyLineGameTeamXml,
     xml_over_under :: Maybe String }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
 
+-- | For 'Generics.to_tuple'.
+--
+instance Generic EarlyLineGameXml
 
 
 -- * EarlyLineGameTeam / EarlyLineGameTeamXml
@@ -351,21 +377,21 @@ date_to_games fk date =
     --   with the day portion of the supplied @date@. If not, then we
     --   just use @date as-is.
     --
-    combine_date_time :: EarlyLineGameXml -> UTCTime
-    combine_date_time (EarlyLineGameXml (Just t) _ _ _) =
+    combine_date_time :: Maybe UTCTime -> UTCTime
+    combine_date_time (Just t) =
       UTCTime (utctDay $ date_value date) (utctDayTime t)
-    combine_date_time (EarlyLineGameXml Nothing _ _ _ ) = date_value date
+    combine_date_time Nothing = date_value date
 
     -- | Convert an XML game to a database one.
     --
     convert_game :: EarlyLineGameXml -> EarlyLineGame
-    convert_game gx =
+    convert_game EarlyLineGameXml{..} =
       EarlyLineGame {
         db_early_lines_id = fk,
-        db_game_time = combine_date_time gx,
-        db_away_team = from_xml (xml_away_team gx),
-        db_home_team = from_xml (xml_home_team gx),
-        db_over_under = xml_over_under gx }
+        db_game_time = combine_date_time xml_game_time,
+        db_away_team = from_xml xml_away_team,
+        db_home_team = from_xml xml_home_team,
+        db_over_under = xml_over_under }
 
 
 --
@@ -464,13 +490,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_dates m,
-                  xml_time_stamp m)
 
 
 
@@ -484,7 +503,6 @@ pickle_game_with_note =
            pickle_game
   where
     from_tuple = uncurry EarlyLineGameWithNote
-    to_tuple m = (date_note m, date_game m)
 
 
 -- | Pickler for the \<date\> elements within each \<message\>.
@@ -497,7 +515,6 @@ pickle_date =
            (xpList pickle_game_with_note)
   where
     from_tuple = uncurry EarlyLineDate
-    to_tuple m = (date_value m, date_games_with_notes m)
 
 
 
@@ -513,10 +530,6 @@ pickle_game =
              (xpElem "over_under" (xpOption xpText))
   where
     from_tuple = uncurryN EarlyLineGameXml
-    to_tuple m = (xml_game_time m,
-                  xml_away_team m,
-                  xml_home_team m,
-                  xml_over_under m)
 
 
 
@@ -547,7 +560,7 @@ pickle_home_team = xpElem "teamH" pickle_team
 --
 pickle_team :: PU EarlyLineGameTeamXml
 pickle_team =
-  xpWrap (from_tuple, to_tuple) $
+  xpWrap (from_tuple, to_tuple') $
   xp6Tuple (xpAttr "rotation" (xpOption xpInt))
            (xpOption $ xpAttr "line" (xpOption xpText))
            (xpOption $ xpAttr "name" xpText)
@@ -558,7 +571,7 @@ pickle_team =
     from_tuple (u,v,w,x,y,z) =
       EarlyLineGameTeamXml u (join v) w x (join y) (join z)
 
-    to_tuple (EarlyLineGameTeamXml u v w x y z) =
+    to_tuple' (EarlyLineGameTeamXml u v w x y z) =
       (u, double_just v, w, x, double_just y, double_just z)
       where
         double_just val = case val of