X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FMLBBoxScore.hs;h=68891d30e555773c7a667bc9d77bea2f24bb5883;hb=26ca22c40d96e7fae3fe54a97c98e096d0cbfc7f;hp=8a15a883e07910b12f66125e034563e2d14e2689;hpb=a8657d01ab3d8c2f7f698ec4c613c76078adfc19;p=dead%2Fhtsn-import.git diff --git a/src/TSN/XML/MLBBoxScore.hs b/src/TSN/XML/MLBBoxScore.hs index 8a15a88..68891d3 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 @@ -33,6 +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 Data.Typeable ( Typeable ) import Database.Groundhog ( insert, @@ -59,7 +61,6 @@ 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 ( @@ -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 } @@ -146,9 +148,9 @@ data Message = deriving (Eq, GHC.Generic, Show) --- | For 'Generics.to_tuple'. +-- | For 'H.convert'. -- -instance Generic Message +instance H.HVector Message instance ToDb Message where -- | The database analogue of a 'Message' is a 'MLBBoxScore'. @@ -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 @@ -203,9 +206,9 @@ data MLBBoxScoreGameBreakdownXml = xml_home_team :: MLBBoxScoreTeamBreakdownXml } deriving (Eq, GHC.Generic, Show) --- | For 'Generics.to_tuple' +-- | For 'H.convert' -- -instance Generic MLBBoxScoreGameBreakdownXml +instance H.HVector MLBBoxScoreGameBreakdownXml data MLBBoxScoreHomerunStatsListingBatter = @@ -216,9 +219,9 @@ data MLBBoxScoreHomerunStatsListingBatter = db_batter_id :: Int } deriving (Data, Eq, GHC.Generic, Show, Typeable) --- | For 'Generics.to_tuple' +-- | For 'H.convert' -- -instance Generic MLBBoxScoreHomerunStatsListingBatter +instance H.HVector MLBBoxScoreHomerunStatsListingBatter data MLBBoxScoreHomerunStatsListing = @@ -234,9 +237,9 @@ data MLBBoxScoreHomerunStatsListingXml = xml_pitchers :: [MLBBoxScoreHomerunStatsListingPitcherXml] } deriving (Eq, GHC.Generic, Show) --- | For 'Generics.to_tuple' +-- | For 'H.convert' -- -instance Generic MLBBoxScoreHomerunStatsListingXml +instance H.HVector MLBBoxScoreHomerunStatsListingXml instance Child MLBBoxScoreHomerunStatsListingXml where -- | Each 'MLBBoxScoreHomerunStatsListingXml' is contained in (i.e. has a @@ -287,9 +290,9 @@ data MLBBoxScoreHomerunStatsListingPitcherXml = xml_pitchers_pitcher_id :: Int } deriving (Eq, GHC.Generic, Show) --- | For 'Generics.to_tuple' +-- | For 'H.convert' -- -instance Generic MLBBoxScoreHomerunStatsListingPitcherXml +instance H.HVector MLBBoxScoreHomerunStatsListingPitcherXml instance Child MLBBoxScoreHomerunStatsListingPitcherXml where -- | Each 'MLBBoxScoreHomerunStatsListingPitcherXml' is contained in @@ -348,8 +351,8 @@ data MLBBoxScoreTeamBreakdownXml = deriving (Eq, GHC.Generic, Show) --- | For 'Generics.to_tuple'. -instance Generic MLBBoxScoreTeamBreakdownXml +-- | For 'H.convert'. +instance H.HVector MLBBoxScoreTeamBreakdownXml instance ToDb MLBBoxScoreTeamBreakdownXml where -- | The database analogue of a 'MLBBoxScoreTeamBreakdownXml' is @@ -403,9 +406,9 @@ data MLBBoxScore_MLBBoxScoreTeamBreakdown = --- | For 'Generics.to_tuple'. +-- | For 'H.convert'. -- -instance Generic MLBBoxScoreRunsByInningsXml +instance H.HVector MLBBoxScoreRunsByInningsXml instance ToDb MLBBoxScoreRunsByInningsXml 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, @@ -451,8 +457,23 @@ data MLBBoxScoreMiscPitchingStatsXml = deriving (Eq, GHC.Generic, Show) --- | For 'Generics.to_tuple'. -instance Generic MLBBoxScoreMiscPitchingStatsXml +-- | For 'H.convert'. +-- +instance H.HVector 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 = @@ -462,9 +483,92 @@ data MLBBoxScoreMiscPitchingStatsIntentionalWalkXml = xml_iw_number_of_times_walked :: Int } deriving (Eq, GHC.Generic, Show) +-- | For 'H.convert'. +-- +instance H.HVector 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 } + --- | For 'Generics.to_tuple'. -instance Generic MLBBoxScoreMiscPitchingStatsIntentionalWalkXml +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 = @@ -475,9 +579,9 @@ data MLBBoxScoreMiscPitchingStatsHitByPitchXml = deriving (Eq, GHC.Generic, Show) --- | For 'Generics.to_tuple'. +-- | For 'H.convert'. -- -instance Generic MLBBoxScoreMiscPitchingStatsHitByPitchXml +instance H.HVector MLBBoxScoreMiscPitchingStatsHitByPitchXml -- @@ -537,6 +641,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 +665,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 @@ -628,7 +761,7 @@ mkPersist tsn_codegen_config [groundhog| pickle_message :: PU Message pickle_message = xpElem "message" $ - xpWrap (from_tuple, to_tuple) $ + xpWrap (from_tuple, H.convert) $ xp23Tuple (xpElem "XML_File_ID" xpInt) (xpElem "heading" xpText) (xpElem "category" xpText) @@ -666,7 +799,7 @@ pickle_team_summary = pickle_game_breakdown :: PU MLBBoxScoreGameBreakdownXml pickle_game_breakdown = xpElem "Game_Breakdown" $ - xpWrap (from_tuple, to_tuple) $ + xpWrap (from_tuple, H.convert) $ xpPair pickle_away_team pickle_home_team where @@ -676,7 +809,7 @@ pickle_game_breakdown = pickle_runs_by_innings :: PU MLBBoxScoreRunsByInningsXml pickle_runs_by_innings = xpElem "Runs_By_Innings" $ - xpWrap (from_tuple, to_tuple) $ + xpWrap (from_tuple, H.convert) $ xpPair (xpAttr "Inning" xpInt) xpInt where @@ -685,7 +818,7 @@ pickle_runs_by_innings = pickle_team :: PU MLBBoxScoreTeamBreakdownXml pickle_team = - xpWrap (from_tuple, to_tuple) $ + xpWrap (from_tuple, H.convert) $ xp4Tuple (xpList pickle_runs_by_innings) (xpElem "Runs" xpInt) (xpElem "Hits" xpInt) @@ -706,7 +839,7 @@ pickle_home_team = pickle_batter :: PU MLBBoxScoreHomerunStatsListingBatter pickle_batter = xpElem "HRS_Batter_ID" $ - xpWrap (from_tuple, to_tuple) $ + xpWrap (from_tuple, H.convert) $ xp4Tuple (xpAttr "HRS_Batter_FirstName" $ xpText) (xpAttr "HRS_Batter_LastName" $ xpText) (xpAttr "RBIs" $ xpInt) @@ -718,7 +851,7 @@ pickle_batter = pickle_pitcher :: PU MLBBoxScoreHomerunStatsListingPitcherXml pickle_pitcher = xpElem "HRS_Pitcher_ID" $ - xpWrap (from_tuple, to_tuple) $ + xpWrap (from_tuple, H.convert) $ xp4Tuple (xpAttr "HRS_Homeruns_Off_Pitcher" $ xpInt) (xpAttr "HRS_Pitcher_FirstName" $ xpText) (xpAttr "HRS_Pitcher_LastName" $ xpText) @@ -730,7 +863,7 @@ pickle_pitcher = pickle_homerun_stats_listing :: PU MLBBoxScoreHomerunStatsListingXml pickle_homerun_stats_listing = xpElem "HRS_Listing" $ - xpWrap (from_tuple, to_tuple) $ + xpWrap (from_tuple, H.convert) $ xpTriple pickle_batter (xpElem "Season_Homeruns" xpInt) (xpList pickle_pitcher) @@ -746,7 +879,7 @@ pickle_homerun_stats_listings = pickle_misc_pitching_stats :: PU MLBBoxScoreMiscPitchingStatsXml pickle_misc_pitching_stats = xpElem "Misc_Pitching_Stats" $ - xpWrap (from_tuple, to_tuple) $ + xpWrap (from_tuple, H.convert) $ xpTriple (xpOption $ xpElem "Wild_Pitches" xpInt) pickle_intentional_walks pickle_hits_by_pitch @@ -758,7 +891,7 @@ pickle_misc_pitching_stats = pickle_intentional_walks :: PU [MLBBoxScoreMiscPitchingStatsIntentionalWalkXml] pickle_intentional_walks = xpElem "Intentional_Walks" $ xpList $ xpElem "IW_Listing" $ - xpWrap (from_tuple, to_tuple) $ + xpWrap (from_tuple, H.convert) $ xpTriple (xpElem "IW_Batter_ID" xpInt) (xpElem "IW_Pitcher_ID" xpInt) (xpElem "IW_Number_Of_Times_Walked" xpInt) @@ -770,7 +903,7 @@ pickle_intentional_walks = pickle_hits_by_pitch :: PU [MLBBoxScoreMiscPitchingStatsHitByPitchXml] pickle_hits_by_pitch = xpElem "Hit_By_Pitch" $ xpList $ xpElem "HBP_Listing" $ - xpWrap (from_tuple, to_tuple) $ + xpWrap (from_tuple, H.convert) $ xpTriple (xpElem "HBP_Batter_ID" xpInt) (xpElem "HBP_Pitcher_ID" xpInt) (xpElem "HBP_Number_Of_Times_Hit" xpInt)