From 1cecab83b93656aa08ef5128b4e3bd3b6385ac8d Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Fri, 2 Jan 2015 17:02:21 -0500 Subject: [PATCH] Remove more boilerplate in TSN.XML.MLBBoxScore. --- src/TSN/XML/MLBBoxScore.hs | 182 +++++++++++++++++++++---------------- 1 file changed, 105 insertions(+), 77 deletions(-) diff --git a/src/TSN/XML/MLBBoxScore.hs b/src/TSN/XML/MLBBoxScore.hs index 68891d3..e767250 100644 --- a/src/TSN/XML/MLBBoxScore.hs +++ b/src/TSN/XML/MLBBoxScore.hs @@ -34,7 +34,7 @@ import Data.Data ( Data ) import Data.Maybe ( fromMaybe ) import Data.Time ( UTCTime(..) ) import Data.Tuple.Curry ( uncurryN ) -import qualified Data.Vector.HFixed as H ( HVector, convert ) +import qualified Data.Vector.HFixed as H ( HVector, cons, convert, tail ) import Data.Typeable ( Typeable ) import Database.Groundhog ( insert, @@ -211,12 +211,14 @@ data MLBBoxScoreGameBreakdownXml = instance H.HVector MLBBoxScoreGameBreakdownXml +-- | The leading underscores prevent unused field warnings. +-- data MLBBoxScoreHomerunStatsListingBatter = MLBBoxScoreHomerunStatsListingBatter { - db_batter_first_name :: String, - db_batter_last_name :: String, - db_batter_rbis :: Int, - db_batter_id :: Int } + _db_batter_first_name :: String, + _db_batter_last_name :: String, + _db_batter_rbis :: Int, + _db_batter_id :: Int } deriving (Data, Eq, GHC.Generic, Show, Typeable) -- | For 'H.convert' @@ -273,21 +275,32 @@ instance FromXmlFk MLBBoxScoreHomerunStatsListingXml where instance XmlImportFk MLBBoxScoreHomerunStatsListingXml +-- | The leading underscores prevent unused field warnings. +-- data MLBBoxScoreHomerunStatsListingPitcher = MLBBoxScoreHomerunStatsListingPitcher { - db_mlb_box_score_homerun_stats_listings_id :: + _db_mlb_box_score_homerun_stats_listings_id :: DefaultKey MLBBoxScoreHomerunStatsListing, - db_homeruns_off_pitcher :: Int, - db_pitcher_first_name :: String, - db_pitcher_last_name :: String, - db_pitchers_pitcher_id :: Int } + _db_homeruns_off_pitcher :: Int, + _db_pitcher_first_name :: String, + _db_pitcher_last_name :: String, + _db_pitchers_pitcher_id :: Int } + deriving ( GHC.Generic ) + +-- | For 'H.cons' and 'H.convert'. +-- +instance H.HVector MLBBoxScoreHomerunStatsListingPitcher + + +-- | The leading underscores prevent unused field warnings. +-- data MLBBoxScoreHomerunStatsListingPitcherXml = MLBBoxScoreHomerunStatsListingPitcherXml { - xml_homeruns_off_pitcher :: Int, - xml_pitcher_first_name :: String, - xml_pitcher_last_name :: String, - xml_pitchers_pitcher_id :: Int } + _xml_homeruns_off_pitcher :: Int, + _xml_pitcher_first_name :: String, + _xml_pitcher_last_name :: String, + _xml_pitchers_pitcher_id :: Int } deriving (Eq, GHC.Generic, Show) -- | For 'H.convert' @@ -314,13 +327,7 @@ instance FromXmlFk MLBBoxScoreHomerunStatsListingPitcherXml where -- | To convert an 'MLBBoxScoreHomerunStatsListingPitcherXml' to an -- 'MLBBoxScoreHomerunStatsListingPitcher', we add the foreign key. -- - from_xml_fk fk MLBBoxScoreHomerunStatsListingPitcherXml{..} = - MLBBoxScoreHomerunStatsListingPitcher { - db_mlb_box_score_homerun_stats_listings_id = fk, - db_homeruns_off_pitcher = xml_homeruns_off_pitcher, - db_pitcher_first_name = xml_pitcher_first_name, - db_pitcher_last_name = xml_pitcher_last_name, - db_pitchers_pitcher_id = xml_pitchers_pitcher_id } + from_xml_fk = H.cons -- | This allows us to insert the XML representation @@ -337,17 +344,28 @@ data MLBBoxScoreMiscellaneousGameInfoXml = MLBBoxScoreMiscellaneousGameInfoXml -- Team Breakdown + +-- | The leading underscores prevent unused field warnings. +-- data MLBBoxScoreTeamBreakdown = MLBBoxScoreTeamBreakdown { - db_runs :: Int, - db_hits :: Int, - db_errors :: Int } + _db_runs :: Int, + _db_hits :: Int, + _db_errors :: Int } + deriving ( GHC.Generic ) + +-- | For 'H.cons' and 'H.convert'. +-- +instance H.HVector MLBBoxScoreTeamBreakdown + +-- | The leading underscores prevent unused field warnings. +-- data MLBBoxScoreTeamBreakdownXml = MLBBoxScoreTeamBreakdownXml { xml_runs_by_innings :: [MLBBoxScoreRunsByInningsXml], - xml_runs :: Int, - xml_hits :: Int, - xml_errors :: Int } + _xml_runs :: Int, + _xml_hits :: Int, + _xml_errors :: Int } deriving (Eq, GHC.Generic, Show) @@ -369,26 +387,33 @@ instance FromXml MLBBoxScoreTeamBreakdownXml where -- 'MLBBoxScoreTeamBreakdown', we just drop the -- 'xml_runs_by_innings'. -- - from_xml MLBBoxScoreTeamBreakdownXml{..} = - MLBBoxScoreTeamBreakdown { - db_runs = xml_runs, - db_hits = xml_hits, - db_errors = xml_errors } + from_xml = H.tail instance XmlImport MLBBoxScoreTeamBreakdownXml -- Runs by innings + +-- | The leading underscores prevent unused field warnings. +-- data MLBBoxScoreRunsByInnings = MLBBoxScoreRunsByInnings { - db_mlb_box_scores_team_breakdowns_id :: DefaultKey + _db_mlb_box_scores_team_breakdowns_id :: DefaultKey MLBBoxScoreTeamBreakdown, - db_runs_by_innings_inning_number :: Int, - db_runs_by_innings_runs :: Int } + _db_runs_by_innings_inning_number :: Int, + _db_runs_by_innings_runs :: Int } + deriving ( GHC.Generic ) + + +-- | For 'H.cons' and 'H.convert'. +instance H.HVector MLBBoxScoreRunsByInnings + +-- | The leading underscores prevent unused field warnings. +-- data MLBBoxScoreRunsByInningsXml = MLBBoxScoreRunsByInningsXml { - xml_runs_by_innings_inning_number :: Int, - xml_runs_by_innings_runs :: Int } + _xml_runs_by_innings_inning_number :: Int, + _xml_runs_by_innings_runs :: Int } deriving (Eq, GHC.Generic, Show) @@ -430,11 +455,7 @@ instance FromXmlFk MLBBoxScoreRunsByInningsXml where -- 'MLBBoxScoreRunsByInnings', we add the foreign key and copy -- everything else verbatim. -- - from_xml_fk fk MLBBoxScoreRunsByInningsXml{..} = - MLBBoxScoreRunsByInnings { - db_mlb_box_scores_team_breakdowns_id = fk, - db_runs_by_innings_inning_number = xml_runs_by_innings_inning_number, - db_runs_by_innings_runs = xml_runs_by_innings_runs } + from_xml_fk = H.cons -- | This allows us to insert the XML representation @@ -465,22 +486,31 @@ instance H.HVector MLBBoxScoreMiscPitchingStatsXml -- * MLBBoxScoreMiscPitchingStatsIntentionalWalk -- | Database representation of an intentional walk. The weird --- prefixes avoid collisiont with the other batter/pitcher_ids, and +-- prefixes avoid collisions with the other batter/pitcher_ids, and -- still get mangled properly by Groundhog. -- +-- The leading underscores prevent unused field warnings. +-- data MLBBoxScoreMiscPitchingStatsIntentionalWalk = MLBBoxScoreMiscPitchingStatsIntentionalWalk { - dbiw_mlb_box_scores_id :: DefaultKey MLBBoxScore, - dbiw_batter_id :: Int, - dbiw_pitcher_id :: Int, - dbiw_number_of_times_walked :: Int } + _dbiw_mlb_box_scores_id :: DefaultKey MLBBoxScore, + _dbiw_batter_id :: Int, + _dbiw_pitcher_id :: Int, + _dbiw_number_of_times_walked :: Int } + deriving ( GHC.Generic ) +-- | For 'H.cons' and 'H.convert'. +-- +instance H.HVector MLBBoxScoreMiscPitchingStatsIntentionalWalk + +-- | The leading underscores prevent unused field warnings. +-- data MLBBoxScoreMiscPitchingStatsIntentionalWalkXml = MLBBoxScoreMiscPitchingStatsIntentionalWalkXml { - xml_iw_batter_id :: Int, - xml_iw_pitcher_id :: Int, - xml_iw_number_of_times_walked :: Int } + _xml_iw_batter_id :: Int, + _xml_iw_pitcher_id :: Int, + _xml_iw_number_of_times_walked :: Int } deriving (Eq, GHC.Generic, Show) -- | For 'H.convert'. @@ -510,12 +540,7 @@ instance FromXmlFk MLBBoxScoreMiscPitchingStatsIntentionalWalkXml where -- to an 'MLBBoxScoreMiscPitchingStatsIntentionalWalk', we add the -- foreign key and copy everything else verbatim. -- - from_xml_fk fk MLBBoxScoreMiscPitchingStatsIntentionalWalkXml{..} = - MLBBoxScoreMiscPitchingStatsIntentionalWalk { - dbiw_mlb_box_scores_id = fk, - dbiw_batter_id = xml_iw_batter_id, - dbiw_pitcher_id = xml_iw_pitcher_id, - dbiw_number_of_times_walked = xml_iw_number_of_times_walked } + from_xml_fk = H.cons -- | This allows us to insert the XML representation @@ -527,13 +552,19 @@ instance XmlImportFk MLBBoxScoreMiscPitchingStatsIntentionalWalkXml -- * MLBBoxScoreMiscPitchingStatsHitByPitchXml +-- | The leading underscores prevent unused field warnings. +-- data MLBBoxScoreMiscPitchingStatsHitByPitch = MLBBoxScoreMiscPitchingStatsHitByPitch { - dbhbp_mlb_box_scores_id :: DefaultKey MLBBoxScore, - dbhbp_batter_id :: Int, - dbhbp_pitcher_id :: Int, - dbhbp_number_of_times_hit :: Int } + _dbhbp_mlb_box_scores_id :: DefaultKey MLBBoxScore, + _dbhbp_batter_id :: Int, + _dbhbp_pitcher_id :: Int, + _dbhbp_number_of_times_hit :: Int } + deriving ( GHC.Generic ) +-- | For 'H.cons' and 'H.convert'. +-- +instance H.HVector MLBBoxScoreMiscPitchingStatsHitByPitch instance ToDb MLBBoxScoreMiscPitchingStatsHitByPitchXml where -- | The database analogue of a @@ -557,12 +588,7 @@ instance FromXmlFk MLBBoxScoreMiscPitchingStatsHitByPitchXml where -- to an 'MLBBoxScoreMiscPitchingStatsHitByPitch', we add the -- foreign key and copy everything else verbatim. -- - from_xml_fk fk MLBBoxScoreMiscPitchingStatsHitByPitchXml{..} = - MLBBoxScoreMiscPitchingStatsHitByPitch { - dbhbp_mlb_box_scores_id = fk, - dbhbp_batter_id = xml_hbp_batter_id, - dbhbp_pitcher_id = xml_hbp_pitcher_id, - dbhbp_number_of_times_hit = xml_hbp_number_of_times_hit } + from_xml_fk = H.cons -- | This allows us to insert the XML representation @@ -571,11 +597,13 @@ instance FromXmlFk MLBBoxScoreMiscPitchingStatsHitByPitchXml where instance XmlImportFk MLBBoxScoreMiscPitchingStatsHitByPitchXml +-- | The leading underscores prevent unused field warnings. +-- data MLBBoxScoreMiscPitchingStatsHitByPitchXml = MLBBoxScoreMiscPitchingStatsHitByPitchXml { - xml_hbp_batter_id :: Int, - xml_hbp_pitcher_id :: Int, - xml_hbp_number_of_times_hit :: Int } + _xml_hbp_batter_id :: Int, + _xml_hbp_pitcher_id :: Int, + _xml_hbp_number_of_times_hit :: Int } deriving (Eq, GHC.Generic, Show) @@ -671,7 +699,7 @@ mkPersist tsn_codegen_config [groundhog| constructors: - name: MLBBoxScoreMiscPitchingStatsIntentionalWalk fields: - - name: dbiw_mlb_box_scores_id + - name: _dbiw_mlb_box_scores_id reference: onDelete: cascade @@ -681,20 +709,20 @@ mkPersist tsn_codegen_config [groundhog| constructors: - name: MLBBoxScoreMiscPitchingStatsHitByPitch fields: - - name: dbhbp_mlb_box_scores_id + - name: _dbhbp_mlb_box_scores_id reference: onDelete: cascade - embedded: MLBBoxScoreHomerunStatsListingBatter fields: - - name: db_batter_first_name + - name: _db_batter_first_name dbName: batter_first_name - - name: db_batter_last_name + - name: _db_batter_last_name dbName: batter_last_name - - name: db_batter_rbis + - name: _db_batter_rbis dbName: batter_rbis - - name: db_batter_id + - name: _db_batter_id dbName: batter_id - entity: MLBBoxScoreHomerunStatsListing @@ -714,7 +742,7 @@ mkPersist tsn_codegen_config [groundhog| constructors: - name: MLBBoxScoreHomerunStatsListingPitcher fields: - - name: db_mlb_box_score_homerun_stats_listings_id + - name: _db_mlb_box_score_homerun_stats_listings_id reference: onDelete: cascade @@ -728,7 +756,7 @@ mkPersist tsn_codegen_config [groundhog| constructors: - name: MLBBoxScoreRunsByInnings fields: - - name: db_mlb_box_scores_team_breakdowns_id + - name: _db_mlb_box_scores_team_breakdowns_id reference: onDelete: cascade -- 2.43.2