From 7d4e1e7142bc3d80efab03d983cb2915d9a893db Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Mon, 29 Dec 2014 16:33:57 -0500 Subject: [PATCH] Use Generics.to_tuple in TSN.XML.AutoRacingSchedule. --- src/TSN/XML/AutoRacingSchedule.hs | 48 ++++++++++++------------------- 1 file changed, 19 insertions(+), 29 deletions(-) diff --git a/src/TSN/XML/AutoRacingSchedule.hs b/src/TSN/XML/AutoRacingSchedule.hs index a7d683a..d4a726b 100644 --- a/src/TSN/XML/AutoRacingSchedule.hs +++ b/src/TSN/XML/AutoRacingSchedule.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE QuasiQuotes #-} @@ -38,6 +39,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 +55,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 ) @@ -105,7 +108,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 +183,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 @@ -283,7 +294,11 @@ data AutoRacingScheduleListingRaceResultRaceResultListingXml = 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 @@ -409,14 +424,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 +444,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 +479,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 -- 2.43.2