From 695787ae867853750b562feb7ef4e176958761e9 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Thu, 1 Jan 2015 19:57:03 -0500 Subject: [PATCH] TSN.XML.MLBBoxScore: Add database code for the miscellaneous pitching stats. --- src/TSN/XML/MLBBoxScore.hs | 140 +++++++++++++++++++++++++++++++++++-- 1 file changed, 136 insertions(+), 4 deletions(-) diff --git a/src/TSN/XML/MLBBoxScore.hs b/src/TSN/XML/MLBBoxScore.hs index 8a15a88..97f6a81 100644 --- a/src/TSN/XML/MLBBoxScore.hs +++ b/src/TSN/XML/MLBBoxScore.hs @@ -20,7 +20,8 @@ module TSN.XML.MLBBoxScore ( MLBBoxScoreHomerunStatsListingConstructor(..), MLBBoxScoreHomerunStatsListingPitcherConstructor(..), MLBBoxScoreMiscellaneousGameInfo(..), - MLBBoxScoreMiscPitchingStats(..), -- can go eventually + MLBBoxScoreMiscPitchingStatsHitByPitchConstructor(..), + MLBBoxScoreMiscPitchingStatsIntentionalWalkConstructor(..), MLBBoxScoreRunsByInningsConstructor(..), MLBBoxScoreTeamBreakdownConstructor(..), MLBBoxScoreTeamSummary(..) -- can go eventually @@ -107,6 +108,7 @@ data MLBBoxScore = db_game_time :: UTCTime, db_game_number :: Int, db_capacity :: Int, + db_wild_pitches :: Maybe Int, -- From misc pitching stats db_title :: String, db_time_stamp :: UTCTime } @@ -187,6 +189,7 @@ instance FromXmlFkTeams Message where db_game_time = make_game_time, db_game_number = xml_game_number, db_capacity = xml_capacity, + db_wild_pitches = xml_wild_pitches xml_misc_pitching_stats, db_title = xml_title, db_time_stamp = xml_time_stamp } where @@ -441,8 +444,11 @@ instance XmlImportFk MLBBoxScoreRunsByInningsXml - -data MLBBoxScoreMiscPitchingStats = MLBBoxScoreMiscPitchingStats +-- | The type representing \ XML elements. It +-- has no associated database type; the 'xml_wild_pitches' are +-- stored directly in the 'MLBBoxScore', and the two linked tables +-- are treated as children of the 'MLBBoxScore'. +-- data MLBBoxScoreMiscPitchingStatsXml = MLBBoxScoreMiscPitchingStatsXml { xml_wild_pitches :: Maybe Int, @@ -452,9 +458,24 @@ data MLBBoxScoreMiscPitchingStatsXml = -- | For 'Generics.to_tuple'. +-- instance Generic MLBBoxScoreMiscPitchingStatsXml +-- * MLBBoxScoreMiscPitchingStatsIntentionalWalk + +-- | Database representation of an intentional walk. The weird +-- prefixes avoid collisiont with the other batter/pitcher_ids, and +-- still get mangled properly by Groundhog. +-- +data MLBBoxScoreMiscPitchingStatsIntentionalWalk = + MLBBoxScoreMiscPitchingStatsIntentionalWalk { + dbiw_mlb_box_scores_id :: DefaultKey MLBBoxScore, + dbiw_batter_id :: Int, + dbiw_pitcher_id :: Int, + dbiw_number_of_times_walked :: Int } + + data MLBBoxScoreMiscPitchingStatsIntentionalWalkXml = MLBBoxScoreMiscPitchingStatsIntentionalWalkXml { xml_iw_batter_id :: Int, @@ -462,11 +483,93 @@ data MLBBoxScoreMiscPitchingStatsIntentionalWalkXml = xml_iw_number_of_times_walked :: Int } deriving (Eq, GHC.Generic, Show) - -- | For 'Generics.to_tuple'. instance Generic MLBBoxScoreMiscPitchingStatsIntentionalWalkXml +instance ToDb MLBBoxScoreMiscPitchingStatsIntentionalWalkXml where + -- | The database analogue of a + -- 'MLBBoxScoreMiscPitchingStatsIntentionalWalkXml' is a + -- 'MLBBoxScoreMiscPitchingStatsIntentionalWalk'. + -- + type Db MLBBoxScoreMiscPitchingStatsIntentionalWalkXml = + MLBBoxScoreMiscPitchingStatsIntentionalWalk + + +instance Child MLBBoxScoreMiscPitchingStatsIntentionalWalkXml where + -- | Each 'MLBBoxScoreMiscPitchingStatsIntentionalWalkXml' is + -- contained in (i.e. has a foreign key to) a 'MLBBoxScore'. + -- + type Parent MLBBoxScoreMiscPitchingStatsIntentionalWalkXml = + MLBBoxScore + + +instance FromXmlFk MLBBoxScoreMiscPitchingStatsIntentionalWalkXml where + -- | To convert an 'MLBBoxScoreMiscPitchingStatsIntentionalWalkXml' + -- 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 } + + +-- | This allows us to insert the XML representation +-- 'MLBBoxScoreMiscPitchingStatsIntentionalWalkXml' directly. +-- +instance XmlImportFk MLBBoxScoreMiscPitchingStatsIntentionalWalkXml + + + +-- * MLBBoxScoreMiscPitchingStatsHitByPitchXml + +data MLBBoxScoreMiscPitchingStatsHitByPitch = + MLBBoxScoreMiscPitchingStatsHitByPitch { + dbhbp_mlb_box_scores_id :: DefaultKey MLBBoxScore, + dbhbp_batter_id :: Int, + dbhbp_pitcher_id :: Int, + dbhbp_number_of_times_hit :: Int } + + +instance ToDb MLBBoxScoreMiscPitchingStatsHitByPitchXml where + -- | The database analogue of a + -- 'MLBBoxScoreMiscPitchingStatsHitByPitchXml' is a + -- 'MLBBoxScoreMiscPitchingStatsHitByPitch'. + -- + type Db MLBBoxScoreMiscPitchingStatsHitByPitchXml = + MLBBoxScoreMiscPitchingStatsHitByPitch + + +instance Child MLBBoxScoreMiscPitchingStatsHitByPitchXml where + -- | Each 'MLBBoxScoreMiscPitchingStatsHitByPitchXml' is + -- contained in (i.e. has a foreign key to) a 'MLBBoxScore'. + -- + type Parent MLBBoxScoreMiscPitchingStatsHitByPitchXml = + MLBBoxScore + + +instance FromXmlFk MLBBoxScoreMiscPitchingStatsHitByPitchXml where + -- | To convert an 'MLBBoxScoreMiscPitchingStatsHitByPitchXml' + -- 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 } + + +-- | This allows us to insert the XML representation +-- 'MLBBoxScoreMiscPitchingStatsHitByPitchXml' directly. +-- +instance XmlImportFk MLBBoxScoreMiscPitchingStatsHitByPitchXml + + data MLBBoxScoreMiscPitchingStatsHitByPitchXml = MLBBoxScoreMiscPitchingStatsHitByPitchXml { xml_hbp_batter_id :: Int, @@ -537,6 +640,14 @@ instance DbImport Message where -- And all of its pitchers forM_ (xml_pitchers listing) $ insert_xml_fk listing_id + -- We have two tables of pitching stats that need to be keyed to + -- the message, too. + let iws = xml_intentional_walks (xml_misc_pitching_stats m) + forM_ iws $ insert_xml_fk_ msg_id + + let hbps = xml_hits_by_pitch (xml_misc_pitching_stats m) + forM_ hbps $ insert_xml_fk_ msg_id + return ImportSucceeded @@ -553,6 +664,27 @@ mkPersist tsn_codegen_config [groundhog| fields: [db_xml_file_id] + +- entity: MLBBoxScoreMiscPitchingStatsIntentionalWalk + dbName: mlb_box_scores_misc_pitching_stats_intentional_walks + constructors: + - name: MLBBoxScoreMiscPitchingStatsIntentionalWalk + fields: + - name: dbiw_mlb_box_scores_id + reference: + onDelete: cascade + + +- entity: MLBBoxScoreMiscPitchingStatsHitByPitch + dbName: mlb_box_scores_misc_pitching_stats_hits_by_pitch + constructors: + - name: MLBBoxScoreMiscPitchingStatsHitByPitch + fields: + - name: dbhbp_mlb_box_scores_id + reference: + onDelete: cascade + + - embedded: MLBBoxScoreHomerunStatsListingBatter fields: - name: db_batter_first_name -- 2.43.2