Use Generics.to_tuple in TSN.XML.AutoRacingResults.

diff --git a/src/TSN/XML/AutoRacingResults.hs b/src/TSN/XML/AutoRacingResults.hs
index 8a05e733226b4e418b519d75c9b9209def9496d1..40e199f5464e6ea6f84e655925ebe8f10089d6eb 100644 (file)
--- a/src/TSN/XML/AutoRacingResults.hs
+++ b/src/TSN/XML/AutoRacingResults.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE QuasiQuotes #-}
@@ -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 (
@@ -59,6 +61,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 (
@@ -128,7 +131,11 @@ data Message =
     xml_listings :: [AutoRacingResultsListingXml],
     xml_race_information :: AutoRacingResultsRaceInformationXml,
     xml_time_stamp :: UTCTime }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic Message
 
 
 instance ToDb Message where
@@ -206,8 +213,11 @@ data AutoRacingResultsListingXml =
     xml_dnf :: Maybe Bool,
     xml_nc :: Maybe Bool,
     xml_earnings :: Maybe Int }
-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
 
+-- | For 'Generics.to_tuple'.
+--
+instance Generic AutoRacingResultsListingXml
 
 instance ToDb AutoRacingResultsListingXml where
   -- | The database analogue of an 'AutoRacingResultsListingXml' is
@@ -319,7 +329,7 @@ data AutoRacingResultsRaceInformationXml =
     xml_lead_changes :: Maybe String,
     xml_lap_leaders :: Maybe String,
     xml_most_laps_leading :: Maybe MostLapsLeading }
-  deriving (Eq,Show)
+  deriving (Eq, Show)
 
 
 instance ToDb AutoRacingResultsRaceInformationXml where
@@ -474,19 +484,6 @@ pickle_listing =
               (xpElem "Earnings" xp_earnings)
   where
     from_tuple = uncurryN AutoRacingResultsListingXml
-    to_tuple m = (xml_finish_position m,
-                  xml_starting_position m,
-                  xml_car_number m,
-                  xml_driver_id m,
-                  xml_driver m,
-                  xml_car_make m,
-                  xml_points m,
-                  xml_laps_completed m,
-                  xml_laps_leading m,
-                  xml_status m,
-                  xml_dnf m,
-                  xml_nc m,
-                  xml_earnings m)
 
 
 -- | Pickler for the top-level 'Message'.
@@ -510,19 +507,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_race_id m,
-                  xml_race_date m,
-                  xml_title m,
-                  xml_track_location m,
-                  xml_laps_remaining m,
-                  xml_checkered_flag m,
-                  xml_listings m,
-                  xml_race_information m,
-                  xml_time_stamp m)
 
 
 -- | Pickler for the \<Most_Laps_Leading\> child of a
@@ -536,7 +520,7 @@ pickle_message =
 pickle_most_laps_leading :: PU (Maybe MostLapsLeading)
 pickle_most_laps_leading =
   xpElem "Most_Laps_Leading" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, to_tuple') $
     xpTriple (xpOption $ xpElem "DriverID" xpInt)
              (xpOption $ xpElem "Driver" xpText)
              (xpOption $ xpElem "NumberOfLaps" xpInt)
@@ -548,14 +532,14 @@ pickle_most_laps_leading =
 
     -- Sure had to go out of my way to avoid the warnings about unused
     -- db_most_laps_foo fields here.
-    to_tuple :: Maybe MostLapsLeading -> (Maybe Int, Maybe String, Maybe Int)
-    to_tuple Nothing = (Nothing, Nothing, Nothing)
-    to_tuple (Just (MostLapsLeading Nothing _ _)) = (Nothing, Nothing, Nothing)
-    to_tuple (Just (MostLapsLeading _ Nothing _)) = (Nothing, Nothing, Nothing)
-    to_tuple (Just (MostLapsLeading _ _ Nothing)) = (Nothing, Nothing, Nothing)
-    to_tuple (Just m) = (db_most_laps_leading_driver_id m,
-                         db_most_laps_leading_driver m,
-                         db_most_laps_leading_number_of_laps m)
+    to_tuple' :: Maybe MostLapsLeading -> (Maybe Int, Maybe String, Maybe Int)
+    to_tuple' Nothing = (Nothing, Nothing, Nothing)
+    to_tuple' (Just (MostLapsLeading Nothing _ _)) = (Nothing, Nothing, Nothing)
+    to_tuple' (Just (MostLapsLeading _ Nothing _)) = (Nothing, Nothing, Nothing)
+    to_tuple' (Just (MostLapsLeading _ _ Nothing)) = (Nothing, Nothing, Nothing)
+    to_tuple' (Just m) = (db_most_laps_leading_driver_id m,
+                          db_most_laps_leading_driver m,
+                          db_most_laps_leading_number_of_laps m)
 
 
 -- | Pickler for the \<Race_Information\> child of \<message\>.
@@ -575,7 +559,7 @@ pickle_most_laps_leading =
 pickle_race_information :: PU AutoRacingResultsRaceInformationXml
 pickle_race_information =
   xpElem "Race_Information" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, to_tuple') $
     xp11Tuple (-- I can't think of another way to get both the
                -- TrackLength and its KPH attribute. So we shove them
                -- both in a 2-tuple. This should probably be an embedded type!
@@ -600,17 +584,17 @@ pickle_race_information =
           x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12
 
     -- And here we have to re-pair the first two.
-    to_tuple m = ((xml_track_length m, xml_track_length_kph m),
-                  xml_laps m,
-                  xml_average_speed_mph m,
-                  xml_average_speed_kph m,
-                  xml_average_speed m,
-                  xml_time_of_race m,
-                  xml_margin_of_victory m,
-                  xml_cautions m,
-                  xml_lead_changes m,
-                  xml_lap_leaders m,
-                  xml_most_laps_leading m)
+    to_tuple' m = ((xml_track_length m, xml_track_length_kph m),
+                   xml_laps m,
+                   xml_average_speed_mph m,
+                   xml_average_speed_kph m,
+                   xml_average_speed m,
+                   xml_time_of_race m,
+                   xml_margin_of_victory m,
+                   xml_cautions m,
+                   xml_lead_changes m,
+                   xml_lap_leaders m,
+                   xml_most_laps_leading m)
 
 --
 -- * Tasty Tests