X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FAutoRacingSchedule.hs;h=1cbcbc1bfd2e1fa70fd2eedc58eab178ddf970eb;hb=52b420301965efe58a60672832c93b5046695cd0;hp=a7d683ae4033c5eaea604cacf210ed074588fb19;hpb=b6ba5347fa75f33f63b2eb358d5ab421392dd52e;p=dead%2Fhtsn-import.git

diff --git a/src/TSN/XML/AutoRacingSchedule.hs b/src/TSN/XML/AutoRacingSchedule.hs
index a7d683a..1cbcbc1 100644
--- a/src/TSN/XML/AutoRacingSchedule.hs
+++ b/src/TSN/XML/AutoRacingSchedule.hs
@@ -1,4 +1,6 @@
+
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE QuasiQuotes #-}
@@ -38,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 (
@@ -53,6 +56,7 @@ import Text.XML.HXT.Core (
   xpWrap )
 
 -- Local imports.
+import Generics ( Generic(..), prepend, to_tuple )
 import TSN.Codegen (
   tsn_codegen_config )
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
@@ -105,7 +109,11 @@ data Message =
     xml_complete_through :: String,
     xml_listings :: [AutoRacingScheduleListingXml],
     xml_time_stamp :: UTCTime }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic Message
 
 
 instance ToDb Message where
@@ -176,7 +184,11 @@ data AutoRacingScheduleListingXml =
                                 --   so we can't do the right thing and use
                                 --   a 'Double'.
     xml_race_results :: [AutoRacingScheduleListingRaceResult] }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic AutoRacingScheduleListingXml
 
 
 -- | Pseudo-accessor to get the race result listings out of a
@@ -255,35 +267,46 @@ newtype AutoRacingScheduleListingRaceResult =
 
 -- | Database representation of \<RaceResultListing\> within
 --   \<RaceResults\> within \<Listing\> within... \<message\>!
+--   The leading underscores prevent unused field warnings.
 --
 data AutoRacingScheduleListingRaceResultRaceResultListing =
   AutoRacingScheduleListingRaceResultRaceResultListing {
-    db_auto_racing_schedules_listings_id ::
+    _db_auto_racing_schedules_listings_id ::
       DefaultKey AutoRacingScheduleListing,
-    db_finish_position :: Int,
-    db_driver_id :: Int,
-    db_name :: String,
-    db_leading_laps :: Int,
-    db_listing_laps :: Int, -- ^ Avoid clash with race's \"laps\" field.
-    db_earnings :: String,  -- ^ This should be an Int, but can have commas.
-    db_status :: Maybe String -- ^ They can be empty
+    _db_finish_position :: Int,
+    _db_driver_id :: Int,
+    _db_name :: String,
+    _db_leading_laps :: Int,
+    _db_listing_laps :: Int, -- ^ Avoid clash with race's \"laps\" field.
+    _db_earnings :: String,  -- ^ This should be an Int, but can have commas.
+    _db_status :: Maybe String -- ^ They can be empty
     }
+  deriving ( GHC.Generic )
+
+-- | For 'Generics.prepend'.
+--
+instance Generic AutoRacingScheduleListingRaceResultRaceResultListing
 
 
 -- | XML Representation of an
 --   'AutoRacingScheduleListingRaceResultRaceResultListing'.
+--   The leading underscores prevent unused field warnings.
 --
 data AutoRacingScheduleListingRaceResultRaceResultListingXml =
   AutoRacingScheduleListingRaceResultRaceResultListingXml {
-    xml_finish_position :: Int,
-    xml_driver_id :: Int,
-    xml_name :: String,
-    xml_leading_laps :: Int,
-    xml_listing_laps :: Int, -- ^ Avoid clash with race's \"laps\" field.
-    xml_earnings :: String,  -- ^ Should be an 'Int', but can have commas.
-    xml_status :: Maybe String -- ^ They can be empty
+    _xml_finish_position :: Int,
+    _xml_driver_id :: Int,
+    _xml_name :: String,
+    _xml_leading_laps :: Int,
+    _xml_listing_laps :: Int, -- ^ Avoids clash with race's \"laps\" field.
+    _xml_earnings :: String,  -- ^ Should be an 'Int', but can have commas.
+    _xml_status :: Maybe String -- ^ They can be empty
     }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic AutoRacingScheduleListingRaceResultRaceResultListingXml
 
 
 instance ToDb AutoRacingScheduleListingRaceResultRaceResultListingXml where
@@ -311,16 +334,7 @@ instance FromXmlFk AutoRacingScheduleListingRaceResultRaceResultListingXml where
   --   'AutoRacingScheduleListingRaceResultRaceResultListing', we just
   --   add the foreign key to the parent 'AutoRacingScheduleListing'.
   --
-  from_xml_fk fk AutoRacingScheduleListingRaceResultRaceResultListingXml{..} =
-    AutoRacingScheduleListingRaceResultRaceResultListing {
-      db_auto_racing_schedules_listings_id = fk,
-      db_finish_position = xml_finish_position,
-      db_driver_id = xml_driver_id,
-      db_name = xml_name,
-      db_leading_laps = xml_leading_laps,
-      db_listing_laps = xml_listing_laps,
-      db_earnings = xml_earnings,
-      db_status = xml_status }
+  from_xml_fk = prepend
 
 
 -- | This allows us to insert the XML representation
@@ -382,7 +396,7 @@ mkPersist tsn_codegen_config [groundhog|
   constructors:
     - name: AutoRacingScheduleListingRaceResultRaceResultListing
       fields:
-        - name: db_auto_racing_schedules_listings_id
+        - name: _db_auto_racing_schedules_listings_id
           reference:
             onDelete: cascade
 |]
@@ -409,14 +423,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_complete_through m,
-                  xml_listings m,
-                  xml_time_stamp m)
 
 
 -- | Convert an 'AutoRacingScheduleListingXml' to/from XML.
@@ -437,16 +443,7 @@ pickle_listing =
                 (xpList pickle_race_results)
   where
     from_tuple = uncurryN AutoRacingScheduleListingXml
-    to_tuple m = (xml_race_id m,
-                  xml_race_date m,
-                  xml_race_time m,
-                  xml_race_name m,
-                  xml_track_name m,
-                  xml_location m,
-                  xml_tv_listing m,
-                  xml_laps m,
-                  xml_track_length m,
-                  xml_race_results m)
+
 
 
 -- | Convert an 'AutoRacingScheduleListingRaceResult' to/from XML.
@@ -481,14 +478,6 @@ pickle_race_results_listing =
     from_tuple =
       uncurryN AutoRacingScheduleListingRaceResultRaceResultListingXml
 
-    to_tuple m = (xml_finish_position m,
-                  xml_driver_id m,
-                  xml_name m,
-                  xml_leading_laps m,
-                  xml_listing_laps m,
-                  xml_earnings m,
-                  xml_status m)
-
 
 --
 -- Tasty Tests