+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE QuasiQuotes #-}
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,
- xp11Tuple,
+ xp4Tuple,
xp23Tuple,
xpAttr,
- xpDefault,
xpElem,
xpInt,
xpList,
xpOption,
xpPair,
- xpPrim,
xpText,
xpTriple,
xpUnit,
Child(..),
FromXml(..),
FromXmlFk(..),
- ToDb(..),
- pickle_unpickle,
- unpickleable,
- unsafe_unpickle )
+ ToDb(..) )
-- | The DTD to which this module corresponds. Used to invoke dbimport.
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_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'.
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,
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
UTCTime (utctDay xml_game_date) (utctDayTime xml_game_time)
-
data MLBBoxScoreTeamSummary = MLBBoxScoreTeamSummary
data MLBBoxScoreTeamSummaryXml = MLBBoxScoreTeamSummaryXml deriving (Eq, Show)
-data MLBBoxScoreGameBreakdown = MLBBoxScoreGameBreakdown
-data MLBBoxScoreGameBreakdownXml = MLBBoxScoreGameBreakdownXml
- 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
+
+
+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 MLBBoxScoreMiscPitchingStats = MLBBoxScoreMiscPitchingStats
-data MLBBoxScoreMiscPitchingStatsXml = MLBBoxScoreMiscPitchingStatsXml
- deriving (Eq, Show)
+
+-- 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, 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, 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 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 \<Misc_Pitching_Stats\> 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 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, 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, GHC.Generic, Show)
+
+
+-- | For 'H.convert'.
+--
+instance H.HVector MLBBoxScoreMiscPitchingStatsHitByPitchXml
+
--
-- * Database
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
# 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
|]
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)
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) $ xpUnit
+ 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 _ = MLBBoxScoreGameBreakdownXml
- to_tuple _ = ()
+ from_tuple = uncurryN MLBBoxScoreHomerunStatsListingPitcherXml
+
-pickle_homerun_stats :: PU (Maybe MLBBoxScoreHomerunStatsXml)
-pickle_homerun_stats =
- xpOption $ xpElem "Homerun_Stats" $ xpWrap (from_tuple, to_tuple) $ xpUnit
+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 _ = MLBBoxScoreHomerunStatsXml
- to_tuple _ = ()
+ 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) $ xpUnit
+ 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 _ = MLBBoxScoreMiscPitchingStatsXml
- to_tuple _ = ()
+ 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
+ xpElem "Miscelaneous_Game_Info" $ xpWrap (from_tuple, to_tuple') $ xpUnit
where
from_tuple _ = MLBBoxScoreMiscellaneousGameInfoXml
- to_tuple _ = ()
+ to_tuple' _ = ()
projects / dead / htsn-import.git / blobdiff