X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FMLBBoxScore.hs;h=68891d30e555773c7a667bc9d77bea2f24bb5883;hb=26ca22c40d96e7fae3fe54a97c98e096d0cbfc7f;hp=ee6ad443e6ba188de142af92bfc7cea307923510;hpb=9a2ac3406dfffd9d0af4c95c3eb038fa4df145c1;p=dead%2Fhtsn-import.git diff --git a/src/TSN/XML/MLBBoxScore.hs b/src/TSN/XML/MLBBoxScore.hs index ee6ad44..68891d3 100644 --- a/src/TSN/XML/MLBBoxScore.hs +++ b/src/TSN/XML/MLBBoxScore.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE QuasiQuotes #-} @@ -11,45 +13,48 @@ module TSN.XML.MLBBoxScore ( dtd, pickle_message, -- * Tests --- auto_racing_results_tests, + -- auto_racing_results_tests, -- * WARNING: these are private but exported to silence warnings - MLBBoxScoreConstructor(..) ) --- AutoRacingResultsListingConstructor(..), --- AutoRacingResultsRaceInformationConstructor(..) ) + MLBBoxScore_MLBBoxScoreTeamBreakdownConstructor(..), + MLBBoxScoreConstructor(..), + MLBBoxScoreHomerunStatsListingConstructor(..), + MLBBoxScoreHomerunStatsListingPitcherConstructor(..), + MLBBoxScoreMiscellaneousGameInfo(..), + MLBBoxScoreMiscPitchingStatsHitByPitchConstructor(..), + MLBBoxScoreMiscPitchingStatsIntentionalWalkConstructor(..), + MLBBoxScoreRunsByInningsConstructor(..), + MLBBoxScoreTeamBreakdownConstructor(..), + 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 qualified Data.Vector.HFixed as H ( HVector, convert ) +import Data.Typeable ( Typeable ) import Database.Groundhog ( - countAll, - deleteAll, insert, - migrate, - runMigration, - silentMigrationLogger ) + insert_, + migrate ) import Database.Groundhog.Core ( DefaultKey ) -import Database.Groundhog.Generic ( runDbConn ) -import Database.Groundhog.Sqlite ( withSqliteConn ) import Database.Groundhog.TH ( groundhog, mkPersist ) -import Test.Tasty ( TestTree, testGroup ) -import Test.Tasty.HUnit ( (@?=), testCase ) +import qualified GHC.Generics as GHC ( Generic ) import Text.XML.HXT.Core ( PU, xp4Tuple, - xp11Tuple, xp23Tuple, xpAttr, - xpDefault, xpElem, xpInt, xpList, xpOption, xpPair, - xpPrim, xpText, xpTriple, xpUnit, @@ -68,10 +73,7 @@ import Xml ( Child(..), FromXml(..), FromXmlFk(..), - ToDb(..), - pickle_unpickle, - unpickleable, - unsafe_unpickle ) + ToDb(..) ) -- | The DTD to which this module corresponds. Used to invoke dbimport. @@ -106,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 } @@ -139,11 +142,15 @@ 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, Show) + deriving (Eq, GHC.Generic, Show) + +-- | For 'H.convert'. +-- +instance H.HVector Message instance ToDb Message where -- | The database analogue of a 'Message' is a 'MLBBoxScore'. @@ -159,19 +166,14 @@ instance ToDb Message where instance Child Message where type Parent Message = MLBBoxScore - --- | The 'FromXml' instance for 'Message' is required for the +-- | The 'FromXmlFk' instance for 'Message' is required for the -- 'XmlImport' instance. --- instance FromXmlFkTeams Message where -- | To convert a 'Message' to an 'MLBBoxScore', we drop the -- teams/summaries and combine the date/time. Also missing are the -- embedded elements game_breakdown, homerun_stats, and -- miscellaneous_game_info. -- - -- The first \"missing\" argument is the foreign key to its - -- parent, which it doesn't have. (See the 'Child' instance.) - -- from_xml_fk_teams _ vteam_id hteam_id Message{..} = MLBBoxScore { db_xml_file_id = xml_xml_file_id, @@ -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 @@ -194,61 +197,392 @@ instance FromXmlFkTeams Message where UTCTime (utctDay xml_game_date) (utctDayTime xml_game_time) - data MLBBoxScoreTeamSummary = MLBBoxScoreTeamSummary data MLBBoxScoreTeamSummaryXml = MLBBoxScoreTeamSummaryXml deriving (Eq, Show) -data MLBBoxScoreGameBreakdown = MLBBoxScoreGameBreakdown data MLBBoxScoreGameBreakdownXml = MLBBoxScoreGameBreakdownXml { - xml_away_team :: MLBBoxScoreGameBreakdownTeamXml, - xml_home_team :: MLBBoxScoreGameBreakdownTeamXml } - deriving (Eq, Show) + xml_away_team :: MLBBoxScoreTeamBreakdownXml, + xml_home_team :: MLBBoxScoreTeamBreakdownXml } + deriving (Eq, GHC.Generic, Show) + +-- | For 'H.convert' +-- +instance H.HVector MLBBoxScoreGameBreakdownXml + + +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 'H.convert' +-- +instance H.HVector 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 'H.convert' +-- +instance H.HVector 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 'H.convert' +-- +instance H.HVector 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 MLBBoxScoreHomerunStats = MLBBoxScoreHomerunStats -data MLBBoxScoreHomerunStatsXml = MLBBoxScoreHomerunStatsXml - deriving (Eq, Show) data MLBBoxScoreMiscellaneousGameInfo = MLBBoxScoreMiscellaneousGameInfo data MLBBoxScoreMiscellaneousGameInfoXml = MLBBoxScoreMiscellaneousGameInfoXml deriving (Eq, Show) -data MLBBoxScoreGameBreakdownTeamXml = - MLBBoxScoreGameBreakdownTeamXml { + +-- Team Breakdown +data MLBBoxScoreTeamBreakdown = + MLBBoxScoreTeamBreakdown { + db_runs :: Int, + db_hits :: Int, + db_errors :: Int } +data MLBBoxScoreTeamBreakdownXml = + MLBBoxScoreTeamBreakdownXml { xml_runs_by_innings :: [MLBBoxScoreRunsByInningsXml], xml_runs :: Int, xml_hits :: Int, xml_errors :: Int } - deriving (Eq, Show) + deriving (Eq, GHC.Generic, Show) + + +-- | For 'H.convert'. +instance H.HVector MLBBoxScoreTeamBreakdownXml + +instance ToDb MLBBoxScoreTeamBreakdownXml where + -- | The database analogue of a 'MLBBoxScoreTeamBreakdownXml' is + -- a 'MLBBoxScoreTeamBreakdown'. + -- + type Db MLBBoxScoreTeamBreakdownXml = MLBBoxScoreTeamBreakdown + + +-- | The 'FromXml' instance for 'MLBBoxScoreTeamBreakdownXml' is +-- required for the 'XmlImport' instance. +-- +instance FromXml MLBBoxScoreTeamBreakdownXml where + -- | To convert a 'MLBBoxScoreTeamBreakdownXml' to an + -- '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 } + +instance XmlImport MLBBoxScoreTeamBreakdownXml + +-- Runs by innings +data MLBBoxScoreRunsByInnings = + MLBBoxScoreRunsByInnings { + db_mlb_box_scores_team_breakdowns_id :: DefaultKey + MLBBoxScoreTeamBreakdown, + db_runs_by_innings_inning_number :: Int, + db_runs_by_innings_runs :: Int } data MLBBoxScoreRunsByInningsXml = MLBBoxScoreRunsByInningsXml { xml_runs_by_innings_inning_number :: Int, xml_runs_by_innings_runs :: Int } - deriving (Eq, Show) + deriving (Eq, GHC.Generic, Show) + + +-- * MLBBoxScore_MLBBoxScoreTeamSummary + +-- | Mapping between 'MLBBoxScore' records and +-- 'MLBBoxScoreTeamSummary' records in the database. We don't use +-- the names anywhere, so we let Groundhog choose them. +-- +data MLBBoxScore_MLBBoxScoreTeamBreakdown = + MLBBoxScore_MLBBoxScoreTeamBreakdown + (DefaultKey MLBBoxScore) + (DefaultKey MLBBoxScoreTeamBreakdown) -- Away team + (DefaultKey MLBBoxScoreTeamBreakdown) -- Home team + + + +-- | For 'H.convert'. +-- +instance H.HVector MLBBoxScoreRunsByInningsXml -data MLBBoxScoreMiscPitchingStats = MLBBoxScoreMiscPitchingStats +instance ToDb MLBBoxScoreRunsByInningsXml where + -- | The database analogue of a 'MLBBoxScoreRunsByInningsXml' is + -- a 'MLBBoxScoreRunsByInnings'. + -- + type Db MLBBoxScoreRunsByInningsXml = MLBBoxScoreRunsByInnings + + +instance Child MLBBoxScoreRunsByInningsXml where + -- | Each 'MLBBoxScoreRunsByInningsXml' is contained in (i.e. has a + -- foreign key to) a 'MLBBoxScoreTeamBreakdownXml'. + -- + type Parent MLBBoxScoreRunsByInningsXml = MLBBoxScoreTeamBreakdown + + +instance FromXmlFk MLBBoxScoreRunsByInningsXml where + -- | To convert an 'MLBBoxScoreRunsByInningsXml' to an + -- '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 } + + +-- | This allows us to insert the XML representation +-- 'MLBBoxScoreRunsByInningsXml' directly. +-- +instance XmlImportFk MLBBoxScoreRunsByInningsXml + + + +-- | 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, xml_intentional_walks :: [MLBBoxScoreMiscPitchingStatsIntentionalWalkXml], xml_hits_by_pitch :: [MLBBoxScoreMiscPitchingStatsHitByPitchXml] } - deriving (Eq, Show) + deriving (Eq, GHC.Generic, Show) + + +-- | 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 = MLBBoxScoreMiscPitchingStatsIntentionalWalkXml { xml_iw_batter_id :: Int, xml_iw_pitcher_id :: Int, xml_iw_number_of_times_walked :: Int } - deriving (Eq, Show) + 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 } + + +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, xml_hbp_pitcher_id :: Int, xml_hbp_number_of_times_hit :: Int } - deriving (Eq, Show) + deriving (Eq, GHC.Generic, Show) + + +-- | For 'H.convert'. +-- +instance H.HVector MLBBoxScoreMiscPitchingStatsHitByPitchXml + -- -- * Database @@ -269,12 +603,52 @@ instance DbImport Message where vteam_fk <- insert vteam hteam_fk <- insert hteam - -- Now we can key the message to the teams we just inserted. - -- The message has no parent, so we pass in undefined. + -- Now we can key the message to the teams/breakdowns we just + -- inserted. let db_msg = from_xml_fk_teams undefined vteam_fk hteam_fk m msg_id <- insert db_msg - -- Now get the hteam + -- Next, the vteam/hteam breakdowns, also needed to construct the + -- main message record + let vteam_bd = xml_away_team $ xml_game_breakdown m + let hteam_bd = xml_home_team $ xml_game_breakdown m + + vteam_bd_fk <- insert_xml vteam_bd + hteam_bd_fk <- insert_xml hteam_bd + + -- Insert the runs-by-innings associated with the vteam/hteam + -- breakdowns. + forM_ (xml_runs_by_innings vteam_bd) $ insert_xml_fk_ vteam_bd_fk + forM_ (xml_runs_by_innings hteam_bd) $ insert_xml_fk_ hteam_bd_fk + + -- Now the join table record that ties the message to its two team + -- breakdowns. + let msg__breakdown = MLBBoxScore_MLBBoxScoreTeamBreakdown + msg_id + vteam_bd_fk + hteam_bd_fk + + 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 @@ -290,6 +664,92 @@ mkPersist tsn_codegen_config [groundhog| # Prevent multiple imports of the same message. 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: + - name: MLBBoxScoreTeamBreakdown + +- entity: MLBBoxScoreRunsByInnings + dbName: mlb_box_scores_team_breakdowns_runs_by_innings + constructors: + - name: MLBBoxScoreRunsByInnings + fields: + - name: db_mlb_box_scores_team_breakdowns_id + reference: + onDelete: cascade + + +- entity: MLBBoxScore_MLBBoxScoreTeamBreakdown + dbName: mlb_box_scores__mlb_box_scores_team_breakdowns + constructors: + - name: MLBBoxScore_MLBBoxScoreTeamBreakdown + fields: + - name: mLBBoxScore_MLBBoxScoreTeamBreakdown0 + dbName: mlb_box_scores_id + reference: + onDelete: cascade + - name: mLBBoxScore_MLBBoxScoreTeamBreakdown1 + dbName: mlb_box_scores_team_breakdowns_away_team_id + reference: + onDelete: cascade + - name: mLBBoxScore_MLBBoxScoreTeamBreakdown2 + dbName: db_mlb_box_scores_team_breakdowns_home_team_id + reference: + onDelete: cascade |] @@ -301,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) @@ -322,135 +782,139 @@ 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 from_tuple = uncurryN Message - to_tuple m = (xml_xml_file_id m, - xml_heading m, - xml_category m, - xml_sport m, - xml_game_id m, - xml_schedule_id m, - xml_vteam m, - xml_hteam m, - xml_vteam_id m, - xml_hteam_id m, - xml_season m, - xml_season_type m, - xml_title m, - xml_game_date m, - xml_game_time m, - xml_game_number m, - xml_capacity m, - xml_game_breakdown m, - xml_team_summaries m, - xml_misc_pitching_stats m, - xml_homerun_stats m, - xml_miscellaneous_game_info m, - xml_time_stamp m) pickle_team_summary :: PU MLBBoxScoreTeamSummaryXml pickle_team_summary = - xpElem "Team_Summary" $ xpWrap (from_tuple, to_tuple) $ xpUnit + xpElem "Team_Summary" $ xpWrap (from_tuple, to_tuple') $ xpUnit where from_tuple _ = MLBBoxScoreTeamSummaryXml - to_tuple _ = () + to_tuple' _ = () 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 from_tuple = uncurry MLBBoxScoreGameBreakdownXml - to_tuple MLBBoxScoreGameBreakdownXml{..} = (xml_away_team, xml_home_team) 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 from_tuple = uncurry MLBBoxScoreRunsByInningsXml - to_tuple MLBBoxScoreRunsByInningsXml{..} = - (xml_runs_by_innings_inning_number, xml_runs_by_innings_runs) + +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) (xpElem "Errors" xpInt) where - from_tuple = uncurryN MLBBoxScoreGameBreakdownTeamXml - to_tuple MLBBoxScoreGameBreakdownTeamXml{..} = - (xml_runs_by_innings, xml_runs, xml_hits, xml_errors) + from_tuple = uncurryN MLBBoxScoreTeamBreakdownXml -pickle_away_team :: PU MLBBoxScoreGameBreakdownTeamXml + +pickle_away_team :: PU MLBBoxScoreTeamBreakdownXml pickle_away_team = xpElem "AwayTeam" pickle_team -pickle_home_team :: PU MLBBoxScoreGameBreakdownTeamXml +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, H.convert) $ + 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, H.convert) $ + 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, H.convert) $ + 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 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 where from_tuple = uncurryN MLBBoxScoreMiscPitchingStatsXml - to_tuple MLBBoxScoreMiscPitchingStatsXml{..} = - (xml_wild_pitches, xml_intentional_walks, xml_hits_by_pitch) + 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) where from_tuple = uncurryN MLBBoxScoreMiscPitchingStatsIntentionalWalkXml - to_tuple MLBBoxScoreMiscPitchingStatsIntentionalWalkXml{..} = - (xml_iw_batter_id, xml_iw_pitcher_id, xml_iw_number_of_times_walked) + 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) where from_tuple = uncurryN MLBBoxScoreMiscPitchingStatsHitByPitchXml - to_tuple MLBBoxScoreMiscPitchingStatsHitByPitchXml{..} = - (xml_hbp_batter_id, xml_hbp_pitcher_id, xml_hbp_number_of_times_hit) pickle_miscellaneous_game_info :: PU MLBBoxScoreMiscellaneousGameInfoXml pickle_miscellaneous_game_info = - xpElem "Miscelaneous_Game_Info" $ xpWrap (from_tuple, to_tuple) $ xpUnit + xpElem "Miscelaneous_Game_Info" $ xpWrap (from_tuple, to_tuple') $ xpUnit where from_tuple _ = MLBBoxScoreMiscellaneousGameInfoXml - to_tuple _ = () + to_tuple' _ = ()