{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -- | Parse TSN XML for the DTD \"MLB_Boxscore_XML.dtd\". -- module TSN.XML.MLBBoxScore ( dtd, pickle_message, -- * Tests -- auto_racing_results_tests, -- * WARNING: these are private but exported to silence warnings 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, cons, convert, tail ) import Data.Typeable ( Typeable ) import Database.Groundhog ( insert, insert_, migrate ) import Database.Groundhog.Core ( DefaultKey ) import Database.Groundhog.TH ( groundhog, mkPersist ) import qualified GHC.Generics as GHC ( Generic ) import Text.XML.HXT.Core ( PU, xp4Tuple, xp23Tuple, xpAttr, xpElem, xpInt, xpList, xpOption, xpPair, xpText, xpTriple, xpUnit, xpWrap ) -- Local imports. import TSN.Codegen ( tsn_codegen_config ) import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate ) import TSN.Picklers ( xp_date, xp_time, xp_time_stamp ) import TSN.Team ( Team(..), FromXmlFkTeams(..) ) import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) ) import Xml ( Child(..), FromXml(..), FromXmlFk(..), ToDb(..) ) -- | The DTD to which this module corresponds. Used to invoke dbimport. -- dtd :: String dtd = "MLB_Boxscore_XML.dtd" -- -- * DB/XML data types -- -- MLBBoxScore/Message -- | Database representation of a 'Message'. The vteam/hteam have been -- removed since they use the TSN.Team representation. The -- 'xml_game_date' and 'xml_game_time' fields have also been -- combined into 'db_game_time'. Finally, the summaries are missing -- since they'll be keyed to us. -- data MLBBoxScore = MLBBoxScore { db_xml_file_id :: Int, db_heading :: String, db_category :: String, db_sport :: String, db_game_id :: Int, db_schedule_id :: Int, db_vteam_id :: DefaultKey Team, db_hteam_id :: DefaultKey Team, db_season :: String, db_season_type :: String, 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 } -- | XML Representation of an 'MBLBoxScore'. It has the same fields, -- but in addition contains the hteam/vteams and a game_date that -- will eventually be combined with the time. It also has a list of -- summaries. -- data Message = Message { xml_xml_file_id :: Int, xml_heading :: String, xml_category :: String, xml_sport :: String, xml_game_id :: Int, xml_schedule_id :: Int, xml_vteam :: String, xml_hteam :: String, xml_vteam_id :: String, xml_hteam_id :: String, xml_season :: String, xml_season_type :: String, xml_title :: String, xml_game_date :: UTCTime, xml_game_time :: UTCTime, xml_game_number :: Int, xml_capacity :: Int, xml_game_breakdown :: MLBBoxScoreGameBreakdownXml, xml_team_summaries :: [MLBBoxScoreTeamSummaryXml], xml_misc_pitching_stats :: MLBBoxScoreMiscPitchingStatsXml, xml_homerun_stats_listings :: Maybe [MLBBoxScoreHomerunStatsListingXml], xml_miscellaneous_game_info :: MLBBoxScoreMiscellaneousGameInfoXml, xml_time_stamp :: UTCTime } 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'. -- type Db Message = MLBBoxScore -- | This ugly hack allows us to make 'Message' an instance of -- 'FromXmlFkTeams'. That class usually requires that its instances -- have a parent, but 'Message' does not. So we declare it the -- parent of itself, and then ignore it. instance Child Message where type Parent Message = MLBBoxScore -- | 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. -- from_xml_fk_teams _ vteam_id hteam_id Message{..} = MLBBoxScore { db_xml_file_id = xml_xml_file_id, db_heading = xml_heading, db_category = xml_category, db_sport = xml_sport, db_game_id = xml_game_id, db_schedule_id = xml_schedule_id, db_vteam_id = vteam_id, db_hteam_id = hteam_id, db_season = xml_season, db_season_type = xml_season_type, 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 make_game_time = UTCTime (utctDay xml_game_date) (utctDayTime xml_game_time) data MLBBoxScoreTeamSummary = MLBBoxScoreTeamSummary data MLBBoxScoreTeamSummaryXml = MLBBoxScoreTeamSummaryXml deriving (Eq, Show) data MLBBoxScoreGameBreakdownXml = MLBBoxScoreGameBreakdownXml { xml_away_team :: MLBBoxScoreTeamBreakdownXml, xml_home_team :: MLBBoxScoreTeamBreakdownXml } deriving (Eq, GHC.Generic, Show) -- | For 'H.convert' -- 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 } 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 -- | The leading underscores prevent unused field warnings. -- 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 } 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 } 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 = H.cons -- | This allows us to insert the XML representation -- 'MLBBoxScoreHomerunStatsListingPitcherXml' directly. -- instance XmlImportFk MLBBoxScoreHomerunStatsListingPitcherXml data MLBBoxScoreMiscellaneousGameInfo = MLBBoxScoreMiscellaneousGameInfo data MLBBoxScoreMiscellaneousGameInfoXml = MLBBoxScoreMiscellaneousGameInfoXml deriving (Eq, Show) -- Team Breakdown -- | The leading underscores prevent unused field warnings. -- data MLBBoxScoreTeamBreakdown = MLBBoxScoreTeamBreakdown { _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 } 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 = 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 MLBBoxScoreTeamBreakdown, _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 } 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 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 = H.cons -- | 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, GHC.Generic, Show) -- | For 'H.convert'. -- instance H.HVector MLBBoxScoreMiscPitchingStatsXml -- * MLBBoxScoreMiscPitchingStatsIntentionalWalk -- | Database representation of an intentional walk. The weird -- 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 } 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 } 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 = H.cons -- | This allows us to insert the XML representation -- 'MLBBoxScoreMiscPitchingStatsIntentionalWalkXml' directly. -- 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 } deriving ( GHC.Generic ) -- | For 'H.cons' and 'H.convert'. -- instance H.HVector MLBBoxScoreMiscPitchingStatsHitByPitch 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 = H.cons -- | This allows us to insert the XML representation -- 'MLBBoxScoreMiscPitchingStatsHitByPitchXml' directly. -- 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 } deriving (Eq, GHC.Generic, Show) -- | For 'H.convert'. -- instance H.HVector MLBBoxScoreMiscPitchingStatsHitByPitchXml -- -- * Database -- instance DbImport Message where dbmigrate _ = run_dbmigrate $ do migrate (undefined :: MLBBoxScore) migrate (undefined :: MLBBoxScoreMiscPitchingStatsIntentionalWalk) migrate (undefined :: MLBBoxScoreMiscPitchingStatsHitByPitch) migrate (undefined :: MLBBoxScoreHomerunStatsListing) migrate (undefined :: MLBBoxScoreHomerunStatsListingPitcher) migrate (undefined :: MLBBoxScoreTeamBreakdown) migrate (undefined :: MLBBoxScoreRunsByInnings) migrate (undefined :: MLBBoxScore_MLBBoxScoreTeamBreakdown) -- | We insert the message. dbimport m = do -- First, get the vteam/hteam out of the XML message. let vteam = Team (xml_vteam_id m) Nothing (Just $ xml_vteam m) let hteam = Team (xml_hteam_id m) Nothing (Just $ xml_hteam m) -- Insert them... vteam_fk <- insert vteam hteam_fk <- insert hteam -- 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 -- 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 mkPersist tsn_codegen_config [groundhog| - entity: MLBBoxScore dbName: mlb_box_scores constructors: - name: MLBBoxScore uniques: - name: unique_mlb_box_scores type: constraint # 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 |] -- -- * Pickling -- pickle_message :: PU Message pickle_message = xpElem "message" $ xpWrap (from_tuple, H.convert) $ xp23Tuple (xpElem "XML_File_ID" xpInt) (xpElem "heading" xpText) (xpElem "category" xpText) (xpElem "sport" xpText) (xpElem "game_id" xpInt) (xpElem "schedule_id" xpInt) (xpElem "vteam" xpText) (xpElem "hteam" xpText) (xpElem "vteam_id" xpText) (xpElem "hteam_id" xpText) (xpElem "Season" xpText) (xpElem "SeasonType" xpText) (xpElem "title" xpText) (xpElem "Game_Date" xp_date) (xpElem "Game_Time" xp_time) (xpElem "GameNumber" xpInt) (xpElem "Capacity" xpInt) pickle_game_breakdown (xpList pickle_team_summary) pickle_misc_pitching_stats (xpOption pickle_homerun_stats_listings) pickle_miscellaneous_game_info (xpElem "time_stamp" xp_time_stamp) where from_tuple = uncurryN Message pickle_team_summary :: PU MLBBoxScoreTeamSummaryXml pickle_team_summary = xpElem "Team_Summary" $ xpWrap (from_tuple, to_tuple') xpUnit where from_tuple _ = MLBBoxScoreTeamSummaryXml to_tuple' _ = () pickle_game_breakdown :: PU MLBBoxScoreGameBreakdownXml pickle_game_breakdown = xpElem "Game_Breakdown" $ xpWrap (from_tuple, H.convert) $ xpPair pickle_away_team pickle_home_team where from_tuple = uncurry MLBBoxScoreGameBreakdownXml pickle_runs_by_innings :: PU MLBBoxScoreRunsByInningsXml pickle_runs_by_innings = xpElem "Runs_By_Innings" $ xpWrap (from_tuple, H.convert) $ xpPair (xpAttr "Inning" xpInt) xpInt where from_tuple = uncurry MLBBoxScoreRunsByInningsXml pickle_team :: PU MLBBoxScoreTeamBreakdownXml pickle_team = xpWrap (from_tuple, H.convert) $ xp4Tuple (xpList pickle_runs_by_innings) (xpElem "Runs" xpInt) (xpElem "Hits" xpInt) (xpElem "Errors" xpInt) where from_tuple = uncurryN MLBBoxScoreTeamBreakdownXml pickle_away_team :: PU MLBBoxScoreTeamBreakdownXml pickle_away_team = xpElem "AwayTeam" pickle_team pickle_home_team :: PU MLBBoxScoreTeamBreakdownXml pickle_home_team = xpElem "HomeTeam" pickle_team 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 = 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, H.convert) $ xpTriple (xpOption $ xpElem "Wild_Pitches" xpInt) pickle_intentional_walks pickle_hits_by_pitch where from_tuple = uncurryN MLBBoxScoreMiscPitchingStatsXml pickle_intentional_walks :: PU [MLBBoxScoreMiscPitchingStatsIntentionalWalkXml] pickle_intentional_walks = xpElem "Intentional_Walks" $ xpList $ xpElem "IW_Listing" $ 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 pickle_hits_by_pitch :: PU [MLBBoxScoreMiscPitchingStatsHitByPitchXml] pickle_hits_by_pitch = xpElem "Hit_By_Pitch" $ xpList $ xpElem "HBP_Listing" $ 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 pickle_miscellaneous_game_info :: PU MLBBoxScoreMiscellaneousGameInfoXml pickle_miscellaneous_game_info = xpElem "Miscelaneous_Game_Info" $ xpWrap (from_tuple, to_tuple') xpUnit where from_tuple _ = MLBBoxScoreMiscellaneousGameInfoXml to_tuple' _ = ()