X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FMLBBoxScore.hs;h=97f6a81d0c4b88215d9d67bb8313d69a2d6afc26;hb=695787ae867853750b562feb7ef4e176958761e9;hp=b7388991b9ce2b8d5aaa68bdf01be4992fda63ac;hpb=7e243c5b8f2d34f31c81df78ba799d1e2123ade2;p=dead%2Fhtsn-import.git diff --git a/src/TSN/XML/MLBBoxScore.hs b/src/TSN/XML/MLBBoxScore.hs index b738899..97f6a81 100644 --- a/src/TSN/XML/MLBBoxScore.hs +++ b/src/TSN/XML/MLBBoxScore.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE QuasiQuotes #-} @@ -16,21 +17,24 @@ module TSN.XML.MLBBoxScore ( -- * WARNING: these are private but exported to silence warnings MLBBoxScore_MLBBoxScoreTeamBreakdownConstructor(..), MLBBoxScoreConstructor(..), - MLBBoxScoreHomerunStats(..), + MLBBoxScoreHomerunStatsListingConstructor(..), + MLBBoxScoreHomerunStatsListingPitcherConstructor(..), MLBBoxScoreMiscellaneousGameInfo(..), - MLBBoxScoreMiscPitchingStats(..), + MLBBoxScoreMiscPitchingStatsHitByPitchConstructor(..), + MLBBoxScoreMiscPitchingStatsIntentionalWalkConstructor(..), MLBBoxScoreRunsByInningsConstructor(..), MLBBoxScoreTeamBreakdownConstructor(..), - MLBBoxScoreTeamSummary(..) - ) --- AutoRacingResultsListingConstructor(..), --- AutoRacingResultsRaceInformationConstructor(..) ) + MLBBoxScoreTeamSummary(..) -- can go eventually + ) where -- System imports. import Control.Monad ( forM_ ) +import Data.Data ( Data ) +import Data.Maybe ( fromMaybe ) import Data.Time ( UTCTime(..) ) import Data.Tuple.Curry ( uncurryN ) +import Data.Typeable ( Typeable ) import Database.Groundhog ( insert, insert_, @@ -104,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 } @@ -137,7 +142,7 @@ data Message = xml_game_breakdown :: MLBBoxScoreGameBreakdownXml, xml_team_summaries :: [MLBBoxScoreTeamSummaryXml], xml_misc_pitching_stats :: MLBBoxScoreMiscPitchingStatsXml, - xml_homerun_stats :: Maybe MLBBoxScoreHomerunStatsXml, + xml_homerun_stats_listings :: Maybe [MLBBoxScoreHomerunStatsListingXml], xml_miscellaneous_game_info :: MLBBoxScoreMiscellaneousGameInfoXml, xml_time_stamp :: UTCTime } deriving (Eq, GHC.Generic, Show) @@ -184,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 @@ -205,9 +211,125 @@ data MLBBoxScoreGameBreakdownXml = instance Generic MLBBoxScoreGameBreakdownXml -data MLBBoxScoreHomerunStats = MLBBoxScoreHomerunStats -data MLBBoxScoreHomerunStatsXml = MLBBoxScoreHomerunStatsXml - deriving (Eq, Show) +data MLBBoxScoreHomerunStatsListingBatter = + MLBBoxScoreHomerunStatsListingBatter { + 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 'Generics.to_tuple' +-- +instance Generic MLBBoxScoreHomerunStatsListingBatter + + +data MLBBoxScoreHomerunStatsListing = + MLBBoxScoreHomerunStatsListing { + db_mlb_box_scores_id :: DefaultKey MLBBoxScore, + db_batter :: MLBBoxScoreHomerunStatsListingBatter, -- embedded + db_season_homeruns :: Int } + +data MLBBoxScoreHomerunStatsListingXml = + MLBBoxScoreHomerunStatsListingXml { + xml_batter :: MLBBoxScoreHomerunStatsListingBatter, + xml_season_homeruns :: Int, + xml_pitchers :: [MLBBoxScoreHomerunStatsListingPitcherXml] } + deriving (Eq, GHC.Generic, Show) + +-- | For 'Generics.to_tuple' +-- +instance Generic MLBBoxScoreHomerunStatsListingXml + +instance Child MLBBoxScoreHomerunStatsListingXml where + -- | Each 'MLBBoxScoreHomerunStatsListingXml' is contained in (i.e. has a + -- foreign key to) a 'MLBBoxScore'. + -- + type Parent MLBBoxScoreHomerunStatsListingXml = MLBBoxScore + + +instance ToDb MLBBoxScoreHomerunStatsListingXml where + -- | The database representation of + -- 'MLBBoxScoreHomerunStatsListingXml' is + -- 'MLBBoxScoreHomerunStatsListing'. + -- + type Db MLBBoxScoreHomerunStatsListingXml = MLBBoxScoreHomerunStatsListing + +instance FromXmlFk MLBBoxScoreHomerunStatsListingXml where + -- | To convert an 'MLBBoxScoreHomerunStatsListingXml' to an + -- 'MLBBoxScoreHomerunStatsListing', we add the foreign key and + -- drop the pitchers. + -- + from_xml_fk fk MLBBoxScoreHomerunStatsListingXml{..} = + MLBBoxScoreHomerunStatsListing { + db_mlb_box_scores_id = fk, + db_batter = xml_batter, + db_season_homeruns = xml_season_homeruns } + + +-- | This allows us to insert the XML representation +-- 'MLBBoxScoreHomerunStatsListingXml' directly. +-- +instance XmlImportFk MLBBoxScoreHomerunStatsListingXml + + +data MLBBoxScoreHomerunStatsListingPitcher = + MLBBoxScoreHomerunStatsListingPitcher { + 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 } + +data MLBBoxScoreHomerunStatsListingPitcherXml = + MLBBoxScoreHomerunStatsListingPitcherXml { + 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 'Generics.to_tuple' +-- +instance Generic MLBBoxScoreHomerunStatsListingPitcherXml + +instance Child MLBBoxScoreHomerunStatsListingPitcherXml where + -- | Each 'MLBBoxScoreHomerunStatsListingPitcherXml' is contained in + -- (i.e. has a foreign key to) a 'MLBBoxScoreHomerunStatsListing'. + -- + type Parent MLBBoxScoreHomerunStatsListingPitcherXml = + MLBBoxScoreHomerunStatsListing + + +instance ToDb MLBBoxScoreHomerunStatsListingPitcherXml where + -- | The database representation of + -- 'MLBBoxScoreHomerunStatsListingPitcherXml' is + -- 'MLBBoxScoreHomerunStatsListingPitcher'. + -- + type Db MLBBoxScoreHomerunStatsListingPitcherXml = MLBBoxScoreHomerunStatsListingPitcher + + +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 } + + +-- | This allows us to insert the XML representation +-- 'MLBBoxScoreHomerunStatsListingPitcherXml' directly. +-- +instance XmlImportFk MLBBoxScoreHomerunStatsListingPitcherXml + + + data MLBBoxScoreMiscellaneousGameInfo = MLBBoxScoreMiscellaneousGameInfo data MLBBoxScoreMiscellaneousGameInfoXml = MLBBoxScoreMiscellaneousGameInfoXml @@ -322,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, @@ -333,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, @@ -343,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, @@ -407,6 +629,25 @@ instance DbImport Message where insert_ msg__breakdown + -- Now insert the homerun stats listings, keyed to the message. + -- They need not be present, but we're going to loop through them + -- all anyway, so if we have 'Nothing', we convert that to an + -- empty list instead. This simplifies the `forM_` code. + let listings = fromMaybe [] (xml_homerun_stats_listings m) + forM_ listings $ \listing -> do + -- Insert the listing itself. + listing_id <- insert_xml_fk msg_id listing + -- 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 @@ -423,6 +664,59 @@ 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 + dbName: batter_first_name + - name: db_batter_last_name + dbName: batter_last_name + - name: db_batter_rbis + dbName: batter_rbis + - name: db_batter_id + dbName: batter_id + +- entity: MLBBoxScoreHomerunStatsListing + dbName: mlb_box_score_homerun_stats_listings + constructors: + - name: MLBBoxScoreHomerunStatsListing + fields: + - name: db_batter + embeddedType: + - {name: batter_first_name, dbName: batter_first_name} + - {name: batter_last_name, dbName: batter_last_name} + - {name: batter_rbis, dbName: batter_rbis} + - {name: batter_id, dbName: batter_id} + +- entity: MLBBoxScoreHomerunStatsListingPitcher + dbName: mlb_box_score_homerun_stats_listing_pitchers + constructors: + - name: MLBBoxScoreHomerunStatsListingPitcher + fields: + - name: db_mlb_box_score_homerun_stats_listings_id + reference: + onDelete: cascade + - entity: MLBBoxScoreTeamBreakdown dbName: mlb_box_scores_team_breakdowns constructors: @@ -487,7 +781,7 @@ pickle_message = pickle_game_breakdown (xpList pickle_team_summary) pickle_misc_pitching_stats - pickle_homerun_stats + (xpOption pickle_homerun_stats_listings) pickle_miscellaneous_game_info (xpElem "time_stamp" xp_time_stamp) where @@ -540,12 +834,45 @@ pickle_home_team :: PU MLBBoxScoreTeamBreakdownXml pickle_home_team = xpElem "HomeTeam" pickle_team -pickle_homerun_stats :: PU (Maybe MLBBoxScoreHomerunStatsXml) -pickle_homerun_stats = - xpOption $ xpElem "Homerun_Stats" $ xpWrap (from_tuple, to_tuple') $ xpUnit + +pickle_batter :: PU MLBBoxScoreHomerunStatsListingBatter +pickle_batter = + xpElem "HRS_Batter_ID" $ + xpWrap (from_tuple, to_tuple) $ + xp4Tuple (xpAttr "HRS_Batter_FirstName" $ xpText) + (xpAttr "HRS_Batter_LastName" $ xpText) + (xpAttr "RBIs" $ xpInt) + xpInt where - from_tuple _ = MLBBoxScoreHomerunStatsXml - to_tuple' _ = () + from_tuple = uncurryN MLBBoxScoreHomerunStatsListingBatter + + +pickle_pitcher :: PU MLBBoxScoreHomerunStatsListingPitcherXml +pickle_pitcher = + xpElem "HRS_Pitcher_ID" $ + xpWrap (from_tuple, to_tuple) $ + xp4Tuple (xpAttr "HRS_Homeruns_Off_Pitcher" $ xpInt) + (xpAttr "HRS_Pitcher_FirstName" $ xpText) + (xpAttr "HRS_Pitcher_LastName" $ xpText) + xpInt + where + from_tuple = uncurryN MLBBoxScoreHomerunStatsListingPitcherXml + + +pickle_homerun_stats_listing :: PU MLBBoxScoreHomerunStatsListingXml +pickle_homerun_stats_listing = + xpElem "HRS_Listing" $ + xpWrap (from_tuple, to_tuple) $ + xpTriple pickle_batter + (xpElem "Season_Homeruns" xpInt) + (xpList pickle_pitcher) + where + from_tuple = uncurryN MLBBoxScoreHomerunStatsListingXml + + +pickle_homerun_stats_listings :: PU [MLBBoxScoreHomerunStatsListingXml] +pickle_homerun_stats_listings = + xpElem "Homerun_Stats" $ xpList pickle_homerun_stats_listing pickle_misc_pitching_stats :: PU MLBBoxScoreMiscPitchingStatsXml