src/TSN/XML/MLBBoxScore.hs

   1 {-# LANGUAGE DeriveGeneric #-}
   2 {-# LANGUAGE DeriveDataTypeable #-}
   3 {-# LANGUAGE FlexibleInstances #-}
   4 {-# LANGUAGE GADTs #-}
   5 {-# LANGUAGE QuasiQuotes #-}
   6 {-# LANGUAGE RecordWildCards #-}
   7 {-# LANGUAGE TemplateHaskell #-}
   8 {-# LANGUAGE TypeFamilies #-}
   9
  10 -- | Parse TSN XML for the DTD \"MLB_Boxscore_XML.dtd\".
  11 --
  12 module TSN.XML.MLBBoxScore (
  13   dtd,
  14   pickle_message,
  15   -- * Tests
  16   --  auto_racing_results_tests,
  17   -- * WARNING: these are private but exported to silence warnings
  18   MLBBoxScore_MLBBoxScoreTeamBreakdownConstructor(..),
  19   MLBBoxScoreConstructor(..),
  20   MLBBoxScoreHomerunStatsListingConstructor(..),
  21   MLBBoxScoreHomerunStatsListingPitcherConstructor(..),
  22   MLBBoxScoreMiscellaneousGameInfo(..),
  23   MLBBoxScoreMiscPitchingStatsHitByPitchConstructor(..),
  24   MLBBoxScoreMiscPitchingStatsIntentionalWalkConstructor(..),
  25   MLBBoxScoreRunsByInningsConstructor(..),
  26   MLBBoxScoreTeamBreakdownConstructor(..),
  27   MLBBoxScoreTeamSummary(..) -- can go eventually
  28   )
  29 where
  30
  31 -- System imports.
  32 import Control.Monad ( forM_ )
  33 import Data.Data ( Data )
  34 import Data.Maybe ( fromMaybe )
  35 import Data.Time ( UTCTime(..) )
  36 import Data.Tuple.Curry ( uncurryN )
  37 import qualified Data.Vector.HFixed as H ( HVector, convert )
  38 import Data.Typeable ( Typeable )
  39 import Database.Groundhog (
  40   insert,
  41   insert_,
  42   migrate )
  43 import Database.Groundhog.Core ( DefaultKey )
  44 import Database.Groundhog.TH (
  45   groundhog,
  46   mkPersist )
  47 import qualified GHC.Generics as GHC ( Generic )
  48 import Text.XML.HXT.Core (
  49   PU,
  50   xp4Tuple,
  51   xp23Tuple,
  52   xpAttr,
  53   xpElem,
  54   xpInt,
  55   xpList,
  56   xpOption,
  57   xpPair,
  58   xpText,
  59   xpTriple,
  60   xpUnit,
  61   xpWrap )
  62
  63 -- Local imports.
  64 import TSN.Codegen ( tsn_codegen_config )
  65 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
  66 import TSN.Picklers (
  67   xp_date,
  68   xp_time,
  69   xp_time_stamp )
  70 import TSN.Team ( Team(..), FromXmlFkTeams(..) )
  71 import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) )
  72 import Xml (
  73   Child(..),
  74   FromXml(..),
  75   FromXmlFk(..),
  76   ToDb(..) )
  77
  78
  79 -- | The DTD to which this module corresponds. Used to invoke dbimport.
  80 --
  81 dtd :: String
  82 dtd = "MLB_Boxscore_XML.dtd"
  83
  84 --
  85 -- * DB/XML data types
  86 --
  87
  88 -- MLBBoxScore/Message
  89
  90 -- | Database representation of a 'Message'. The vteam/hteam have been
  91 --   removed since they use the TSN.Team representation. The
  92 --   'xml_game_date' and 'xml_game_time' fields have also been
  93 --   combined into 'db_game_time'. Finally, the summaries are missing
  94 --   since they'll be keyed to us.
  95 --
  96 data MLBBoxScore =
  97   MLBBoxScore {
  98     db_xml_file_id :: Int,
  99     db_heading :: String,
 100     db_category :: String,
 101     db_sport :: String,
 102     db_game_id :: Int,
 103     db_schedule_id :: Int,
 104     db_vteam_id :: DefaultKey Team,
 105     db_hteam_id :: DefaultKey Team,
 106     db_season :: String,
 107     db_season_type :: String,
 108     db_game_time :: UTCTime,
 109     db_game_number :: Int,
 110     db_capacity :: Int,
 111     db_wild_pitches :: Maybe Int, -- From misc pitching stats
 112     db_title :: String,
 113     db_time_stamp :: UTCTime }
 114
 115
 116
 117
 118 -- | XML Representation of an 'MBLBoxScore'. It has the same fields,
 119 --   but in addition contains the hteam/vteams and a game_date that
 120 --   will eventually be combined with the time. It also has a list of
 121 --   summaries.
 122 --
 123 data Message =
 124   Message {
 125     xml_xml_file_id :: Int,
 126     xml_heading :: String,
 127     xml_category :: String,
 128     xml_sport :: String,
 129     xml_game_id :: Int,
 130     xml_schedule_id :: Int,
 131     xml_vteam :: String,
 132     xml_hteam :: String,
 133     xml_vteam_id :: String,
 134     xml_hteam_id :: String,
 135     xml_season :: String,
 136     xml_season_type :: String,
 137     xml_title :: String,
 138     xml_game_date :: UTCTime,
 139     xml_game_time :: UTCTime,
 140     xml_game_number :: Int,
 141     xml_capacity :: Int,
 142     xml_game_breakdown :: MLBBoxScoreGameBreakdownXml,
 143     xml_team_summaries :: [MLBBoxScoreTeamSummaryXml],
 144     xml_misc_pitching_stats :: MLBBoxScoreMiscPitchingStatsXml,
 145     xml_homerun_stats_listings :: Maybe [MLBBoxScoreHomerunStatsListingXml],
 146     xml_miscellaneous_game_info :: MLBBoxScoreMiscellaneousGameInfoXml,
 147     xml_time_stamp :: UTCTime }
 148   deriving (Eq, GHC.Generic, Show)
 149
 150
 151 -- | For 'H.convert'.
 152 --
 153 instance H.HVector Message
 154
 155 instance ToDb Message where
 156   -- | The database analogue of a 'Message' is a 'MLBBoxScore'.
 157   --
 158   type Db Message = MLBBoxScore
 159
 160
 161
 162 -- | This ugly hack allows us to make 'Message' an instance of
 163 --   'FromXmlFkTeams'. That class usually requires that its instances
 164 --   have a parent, but 'Message' does not. So we declare it the
 165 --   parent of itself, and then ignore it.
 166 instance Child Message where
 167   type Parent Message = MLBBoxScore
 168
 169 -- | The 'FromXmlFk' instance for 'Message' is required for the
 170 --   'XmlImport' instance.
 171 instance FromXmlFkTeams Message where
 172   -- | To convert a 'Message' to an 'MLBBoxScore', we drop the
 173   --   teams/summaries and combine the date/time. Also missing are the
 174   --   embedded elements game_breakdown, homerun_stats, and
 175   --   miscellaneous_game_info.
 176   --
 177   from_xml_fk_teams _ vteam_id hteam_id Message{..} =
 178     MLBBoxScore {
 179       db_xml_file_id = xml_xml_file_id,
 180       db_heading = xml_heading,
 181       db_category = xml_category,
 182       db_sport = xml_sport,
 183       db_game_id = xml_game_id,
 184       db_schedule_id = xml_schedule_id,
 185       db_vteam_id = vteam_id,
 186       db_hteam_id = hteam_id,
 187       db_season = xml_season,
 188       db_season_type = xml_season_type,
 189       db_game_time = make_game_time,
 190       db_game_number = xml_game_number,
 191       db_capacity = xml_capacity,
 192       db_wild_pitches = xml_wild_pitches xml_misc_pitching_stats,
 193       db_title = xml_title,
 194       db_time_stamp = xml_time_stamp }
 195     where
 196       make_game_time =
 197         UTCTime (utctDay xml_game_date) (utctDayTime xml_game_time)
 198
 199
 200 data MLBBoxScoreTeamSummary = MLBBoxScoreTeamSummary
 201 data MLBBoxScoreTeamSummaryXml = MLBBoxScoreTeamSummaryXml deriving (Eq, Show)
 202
 203 data MLBBoxScoreGameBreakdownXml =
 204   MLBBoxScoreGameBreakdownXml {
 205     xml_away_team :: MLBBoxScoreTeamBreakdownXml,
 206     xml_home_team :: MLBBoxScoreTeamBreakdownXml }
 207   deriving (Eq, GHC.Generic, Show)
 208
 209 -- | For 'H.convert'
 210 --
 211 instance H.HVector MLBBoxScoreGameBreakdownXml
 212
 213
 214 data MLBBoxScoreHomerunStatsListingBatter =
 215   MLBBoxScoreHomerunStatsListingBatter {
 216     db_batter_first_name :: String,
 217     db_batter_last_name :: String,
 218     db_batter_rbis :: Int,
 219     db_batter_id :: Int }
 220   deriving (Data, Eq, GHC.Generic, Show, Typeable)
 221
 222 -- | For 'H.convert'
 223 --
 224 instance H.HVector MLBBoxScoreHomerunStatsListingBatter
 225
 226
 227 data MLBBoxScoreHomerunStatsListing =
 228   MLBBoxScoreHomerunStatsListing {
 229     db_mlb_box_scores_id :: DefaultKey MLBBoxScore,
 230     db_batter :: MLBBoxScoreHomerunStatsListingBatter, -- embedded
 231     db_season_homeruns :: Int }
 232
 233 data MLBBoxScoreHomerunStatsListingXml =
 234   MLBBoxScoreHomerunStatsListingXml {
 235     xml_batter :: MLBBoxScoreHomerunStatsListingBatter,
 236     xml_season_homeruns :: Int,
 237     xml_pitchers :: [MLBBoxScoreHomerunStatsListingPitcherXml] }
 238   deriving (Eq, GHC.Generic, Show)
 239
 240 -- | For 'H.convert'
 241 --
 242 instance H.HVector MLBBoxScoreHomerunStatsListingXml
 243
 244 instance Child MLBBoxScoreHomerunStatsListingXml where
 245   -- | Each 'MLBBoxScoreHomerunStatsListingXml' is contained in (i.e. has a
 246   --   foreign key to) a 'MLBBoxScore'.
 247   --
 248   type Parent MLBBoxScoreHomerunStatsListingXml = MLBBoxScore
 249
 250
 251 instance ToDb MLBBoxScoreHomerunStatsListingXml where
 252   -- | The database representation of
 253   --   'MLBBoxScoreHomerunStatsListingXml' is
 254   --   'MLBBoxScoreHomerunStatsListing'.
 255     --
 256   type Db MLBBoxScoreHomerunStatsListingXml = MLBBoxScoreHomerunStatsListing
 257
 258 instance FromXmlFk MLBBoxScoreHomerunStatsListingXml where
 259   -- | To convert an 'MLBBoxScoreHomerunStatsListingXml' to an
 260   --   'MLBBoxScoreHomerunStatsListing', we add the foreign key and
 261   --   drop the pitchers.
 262   --
 263   from_xml_fk fk MLBBoxScoreHomerunStatsListingXml{..} =
 264     MLBBoxScoreHomerunStatsListing {
 265       db_mlb_box_scores_id = fk,
 266       db_batter = xml_batter,
 267       db_season_homeruns = xml_season_homeruns }
 268
 269
 270 -- | This allows us to insert the XML representation
 271 --   'MLBBoxScoreHomerunStatsListingXml' directly.
 272 --
 273 instance XmlImportFk MLBBoxScoreHomerunStatsListingXml
 274
 275
 276 data MLBBoxScoreHomerunStatsListingPitcher =
 277   MLBBoxScoreHomerunStatsListingPitcher {
 278     db_mlb_box_score_homerun_stats_listings_id ::
 279       DefaultKey MLBBoxScoreHomerunStatsListing,
 280     db_homeruns_off_pitcher :: Int,
 281     db_pitcher_first_name :: String,
 282     db_pitcher_last_name :: String,
 283     db_pitchers_pitcher_id :: Int }
 284
 285 data MLBBoxScoreHomerunStatsListingPitcherXml =
 286   MLBBoxScoreHomerunStatsListingPitcherXml {
 287     xml_homeruns_off_pitcher :: Int,
 288     xml_pitcher_first_name :: String,
 289     xml_pitcher_last_name :: String,
 290     xml_pitchers_pitcher_id :: Int }
 291   deriving (Eq, GHC.Generic, Show)
 292
 293 -- | For 'H.convert'
 294 --
 295 instance H.HVector MLBBoxScoreHomerunStatsListingPitcherXml
 296
 297 instance Child MLBBoxScoreHomerunStatsListingPitcherXml where
 298   -- | Each 'MLBBoxScoreHomerunStatsListingPitcherXml' is contained in
 299   --   (i.e. has a foreign key to) a 'MLBBoxScoreHomerunStatsListing'.
 300   --
 301   type Parent MLBBoxScoreHomerunStatsListingPitcherXml =
 302     MLBBoxScoreHomerunStatsListing
 303
 304
 305 instance ToDb MLBBoxScoreHomerunStatsListingPitcherXml where
 306   -- | The database representation of
 307   --   'MLBBoxScoreHomerunStatsListingPitcherXml' is
 308   --   'MLBBoxScoreHomerunStatsListingPitcher'.
 309   --
 310   type Db MLBBoxScoreHomerunStatsListingPitcherXml = MLBBoxScoreHomerunStatsListingPitcher
 311
 312
 313 instance FromXmlFk MLBBoxScoreHomerunStatsListingPitcherXml where
 314   -- | To convert an 'MLBBoxScoreHomerunStatsListingPitcherXml' to an
 315   --   'MLBBoxScoreHomerunStatsListingPitcher', we add the foreign key.
 316   --
 317   from_xml_fk fk MLBBoxScoreHomerunStatsListingPitcherXml{..} =
 318     MLBBoxScoreHomerunStatsListingPitcher {
 319       db_mlb_box_score_homerun_stats_listings_id = fk,
 320       db_homeruns_off_pitcher = xml_homeruns_off_pitcher,
 321       db_pitcher_first_name = xml_pitcher_first_name,
 322       db_pitcher_last_name = xml_pitcher_last_name,
 323       db_pitchers_pitcher_id = xml_pitchers_pitcher_id }
 324
 325
 326 -- | This allows us to insert the XML representation
 327 --   'MLBBoxScoreHomerunStatsListingPitcherXml' directly.
 328 --
 329 instance XmlImportFk MLBBoxScoreHomerunStatsListingPitcherXml
 330
 331
 332
 333
 334 data MLBBoxScoreMiscellaneousGameInfo = MLBBoxScoreMiscellaneousGameInfo
 335 data MLBBoxScoreMiscellaneousGameInfoXml = MLBBoxScoreMiscellaneousGameInfoXml
 336   deriving (Eq, Show)
 337
 338
 339 -- Team Breakdown
 340 data MLBBoxScoreTeamBreakdown =
 341   MLBBoxScoreTeamBreakdown {
 342     db_runs :: Int,
 343     db_hits :: Int,
 344     db_errors :: Int }
 345 data MLBBoxScoreTeamBreakdownXml =
 346   MLBBoxScoreTeamBreakdownXml {
 347     xml_runs_by_innings :: [MLBBoxScoreRunsByInningsXml],
 348     xml_runs :: Int,
 349     xml_hits :: Int,
 350     xml_errors :: Int }
 351   deriving (Eq, GHC.Generic, Show)
 352
 353
 354 -- | For 'H.convert'.
 355 instance H.HVector MLBBoxScoreTeamBreakdownXml
 356
 357 instance ToDb MLBBoxScoreTeamBreakdownXml where
 358   -- | The database analogue of a 'MLBBoxScoreTeamBreakdownXml' is
 359   --   a 'MLBBoxScoreTeamBreakdown'.
 360   --
 361   type Db MLBBoxScoreTeamBreakdownXml = MLBBoxScoreTeamBreakdown
 362
 363
 364 -- | The 'FromXml' instance for 'MLBBoxScoreTeamBreakdownXml' is
 365 --   required for the 'XmlImport' instance.
 366 --
 367 instance FromXml MLBBoxScoreTeamBreakdownXml where
 368   -- | To convert a 'MLBBoxScoreTeamBreakdownXml' to an
 369   --   'MLBBoxScoreTeamBreakdown', we just drop the
 370   --   'xml_runs_by_innings'.
 371   --
 372   from_xml MLBBoxScoreTeamBreakdownXml{..} =
 373     MLBBoxScoreTeamBreakdown {
 374       db_runs = xml_runs,
 375       db_hits = xml_hits,
 376       db_errors = xml_errors }
 377
 378 instance XmlImport MLBBoxScoreTeamBreakdownXml
 379
 380 -- Runs by innings
 381 data MLBBoxScoreRunsByInnings =
 382   MLBBoxScoreRunsByInnings {
 383     db_mlb_box_scores_team_breakdowns_id :: DefaultKey
 384                                            MLBBoxScoreTeamBreakdown,
 385     db_runs_by_innings_inning_number :: Int,
 386     db_runs_by_innings_runs   :: Int }
 387
 388 data MLBBoxScoreRunsByInningsXml =
 389   MLBBoxScoreRunsByInningsXml {
 390     xml_runs_by_innings_inning_number :: Int,
 391     xml_runs_by_innings_runs   :: Int }
 392   deriving (Eq, GHC.Generic, Show)
 393
 394
 395 -- * MLBBoxScore_MLBBoxScoreTeamSummary
 396
 397 -- | Mapping between 'MLBBoxScore' records and
 398 --   'MLBBoxScoreTeamSummary' records in the database. We don't use
 399 --   the names anywhere, so we let Groundhog choose them.
 400 --
 401 data MLBBoxScore_MLBBoxScoreTeamBreakdown =
 402   MLBBoxScore_MLBBoxScoreTeamBreakdown
 403     (DefaultKey MLBBoxScore)
 404     (DefaultKey MLBBoxScoreTeamBreakdown) -- Away team
 405     (DefaultKey MLBBoxScoreTeamBreakdown) -- Home team
 406
 407
 408
 409 -- | For 'H.convert'.
 410 --
 411 instance H.HVector MLBBoxScoreRunsByInningsXml
 412
 413
 414 instance ToDb MLBBoxScoreRunsByInningsXml where
 415   -- | The database analogue of a 'MLBBoxScoreRunsByInningsXml' is
 416   --   a 'MLBBoxScoreRunsByInnings'.
 417   --
 418   type Db MLBBoxScoreRunsByInningsXml = MLBBoxScoreRunsByInnings
 419
 420
 421 instance Child MLBBoxScoreRunsByInningsXml where
 422   -- | Each 'MLBBoxScoreRunsByInningsXml' is contained in (i.e. has a
 423   --   foreign key to) a 'MLBBoxScoreTeamBreakdownXml'.
 424   --
 425   type Parent MLBBoxScoreRunsByInningsXml = MLBBoxScoreTeamBreakdown
 426
 427
 428 instance FromXmlFk MLBBoxScoreRunsByInningsXml where
 429   -- | To convert an 'MLBBoxScoreRunsByInningsXml' to an
 430   --   'MLBBoxScoreRunsByInnings', we add the foreign key and copy
 431   --   everything else verbatim.
 432   --
 433   from_xml_fk fk MLBBoxScoreRunsByInningsXml{..} =
 434     MLBBoxScoreRunsByInnings {
 435       db_mlb_box_scores_team_breakdowns_id = fk,
 436       db_runs_by_innings_inning_number = xml_runs_by_innings_inning_number,
 437       db_runs_by_innings_runs = xml_runs_by_innings_runs }
 438
 439
 440 -- | This allows us to insert the XML representation
 441 --   'MLBBoxScoreRunsByInningsXml' directly.
 442 --
 443 instance XmlImportFk MLBBoxScoreRunsByInningsXml
 444
 445
 446
 447 -- | The type representing \<Misc_Pitching_Stats\> XML elements. It
 448 --   has no associated database type; the 'xml_wild_pitches' are
 449 --   stored directly in the 'MLBBoxScore', and the two linked tables
 450 --   are treated as children of the 'MLBBoxScore'.
 451 --
 452 data MLBBoxScoreMiscPitchingStatsXml =
 453   MLBBoxScoreMiscPitchingStatsXml {
 454     xml_wild_pitches :: Maybe Int,
 455     xml_intentional_walks :: [MLBBoxScoreMiscPitchingStatsIntentionalWalkXml],
 456     xml_hits_by_pitch :: [MLBBoxScoreMiscPitchingStatsHitByPitchXml] }
 457   deriving (Eq, GHC.Generic, Show)
 458
 459
 460 -- | For 'H.convert'.
 461 --
 462 instance H.HVector MLBBoxScoreMiscPitchingStatsXml
 463
 464
 465 -- * MLBBoxScoreMiscPitchingStatsIntentionalWalk
 466
 467 -- | Database representation of an intentional walk. The weird
 468 --   prefixes avoid collisiont with the other batter/pitcher_ids, and
 469 --   still get mangled properly by Groundhog.
 470 --
 471 data MLBBoxScoreMiscPitchingStatsIntentionalWalk =
 472   MLBBoxScoreMiscPitchingStatsIntentionalWalk {
 473     dbiw_mlb_box_scores_id :: DefaultKey MLBBoxScore,
 474     dbiw_batter_id :: Int,
 475     dbiw_pitcher_id :: Int,
 476     dbiw_number_of_times_walked :: Int }
 477
 478
 479 data MLBBoxScoreMiscPitchingStatsIntentionalWalkXml =
 480   MLBBoxScoreMiscPitchingStatsIntentionalWalkXml {
 481     xml_iw_batter_id :: Int,
 482     xml_iw_pitcher_id :: Int,
 483     xml_iw_number_of_times_walked :: Int }
 484   deriving (Eq, GHC.Generic, Show)
 485
 486 -- | For 'H.convert'.
 487 --
 488 instance H.HVector MLBBoxScoreMiscPitchingStatsIntentionalWalkXml
 489
 490
 491 instance ToDb MLBBoxScoreMiscPitchingStatsIntentionalWalkXml where
 492   -- | The database analogue of a
 493   -- 'MLBBoxScoreMiscPitchingStatsIntentionalWalkXml' is a
 494   -- 'MLBBoxScoreMiscPitchingStatsIntentionalWalk'.
 495   --
 496   type Db MLBBoxScoreMiscPitchingStatsIntentionalWalkXml =
 497     MLBBoxScoreMiscPitchingStatsIntentionalWalk
 498
 499
 500 instance Child MLBBoxScoreMiscPitchingStatsIntentionalWalkXml where
 501   -- | Each 'MLBBoxScoreMiscPitchingStatsIntentionalWalkXml' is
 502   --   contained in (i.e. has a foreign key to) a 'MLBBoxScore'.
 503   --
 504   type Parent MLBBoxScoreMiscPitchingStatsIntentionalWalkXml =
 505     MLBBoxScore
 506
 507
 508 instance FromXmlFk MLBBoxScoreMiscPitchingStatsIntentionalWalkXml where
 509   -- | To convert an 'MLBBoxScoreMiscPitchingStatsIntentionalWalkXml'
 510   --   to an 'MLBBoxScoreMiscPitchingStatsIntentionalWalk', we add the
 511   --   foreign key and copy everything else verbatim.
 512   --
 513   from_xml_fk fk MLBBoxScoreMiscPitchingStatsIntentionalWalkXml{..} =
 514     MLBBoxScoreMiscPitchingStatsIntentionalWalk {
 515     dbiw_mlb_box_scores_id = fk,
 516     dbiw_batter_id = xml_iw_batter_id,
 517     dbiw_pitcher_id = xml_iw_pitcher_id,
 518     dbiw_number_of_times_walked = xml_iw_number_of_times_walked }
 519
 520
 521 -- | This allows us to insert the XML representation
 522 --   'MLBBoxScoreMiscPitchingStatsIntentionalWalkXml' directly.
 523 --
 524 instance XmlImportFk MLBBoxScoreMiscPitchingStatsIntentionalWalkXml
 525
 526
 527
 528 -- * MLBBoxScoreMiscPitchingStatsHitByPitchXml
 529
 530 data MLBBoxScoreMiscPitchingStatsHitByPitch =
 531   MLBBoxScoreMiscPitchingStatsHitByPitch {
 532     dbhbp_mlb_box_scores_id :: DefaultKey MLBBoxScore,
 533     dbhbp_batter_id :: Int,
 534     dbhbp_pitcher_id :: Int,
 535     dbhbp_number_of_times_hit :: Int }
 536
 537
 538 instance ToDb MLBBoxScoreMiscPitchingStatsHitByPitchXml where
 539   -- | The database analogue of a
 540   -- 'MLBBoxScoreMiscPitchingStatsHitByPitchXml' is a
 541   -- 'MLBBoxScoreMiscPitchingStatsHitByPitch'.
 542   --
 543   type Db MLBBoxScoreMiscPitchingStatsHitByPitchXml =
 544     MLBBoxScoreMiscPitchingStatsHitByPitch
 545
 546
 547 instance Child MLBBoxScoreMiscPitchingStatsHitByPitchXml where
 548   -- | Each 'MLBBoxScoreMiscPitchingStatsHitByPitchXml' is
 549   --   contained in (i.e. has a foreign key to) a 'MLBBoxScore'.
 550   --
 551   type Parent MLBBoxScoreMiscPitchingStatsHitByPitchXml =
 552     MLBBoxScore
 553
 554
 555 instance FromXmlFk MLBBoxScoreMiscPitchingStatsHitByPitchXml where
 556   -- | To convert an 'MLBBoxScoreMiscPitchingStatsHitByPitchXml'
 557   --   to an 'MLBBoxScoreMiscPitchingStatsHitByPitch', we add the
 558   --   foreign key and copy everything else verbatim.
 559   --
 560   from_xml_fk fk MLBBoxScoreMiscPitchingStatsHitByPitchXml{..} =
 561     MLBBoxScoreMiscPitchingStatsHitByPitch {
 562     dbhbp_mlb_box_scores_id = fk,
 563     dbhbp_batter_id = xml_hbp_batter_id,
 564     dbhbp_pitcher_id = xml_hbp_pitcher_id,
 565     dbhbp_number_of_times_hit = xml_hbp_number_of_times_hit }
 566
 567
 568 -- | This allows us to insert the XML representation
 569 --   'MLBBoxScoreMiscPitchingStatsHitByPitchXml' directly.
 570 --
 571 instance XmlImportFk MLBBoxScoreMiscPitchingStatsHitByPitchXml
 572
 573
 574 data MLBBoxScoreMiscPitchingStatsHitByPitchXml =
 575   MLBBoxScoreMiscPitchingStatsHitByPitchXml {
 576     xml_hbp_batter_id :: Int,
 577     xml_hbp_pitcher_id :: Int,
 578     xml_hbp_number_of_times_hit :: Int }
 579   deriving (Eq, GHC.Generic, Show)
 580
 581
 582 -- | For 'H.convert'.
 583 --
 584 instance H.HVector MLBBoxScoreMiscPitchingStatsHitByPitchXml
 585
 586
 587 --
 588 -- * Database
 589 --
 590
 591 instance DbImport Message where
 592   dbmigrate _ =
 593     run_dbmigrate $ do
 594       migrate (undefined :: MLBBoxScore)
 595
 596   -- | We insert the message.
 597   dbimport m = do
 598     -- First, get the vteam/hteam out of the XML message.
 599     let vteam = Team (xml_vteam_id m) Nothing (Just $ xml_vteam m)
 600     let hteam = Team (xml_hteam_id m) Nothing (Just $ xml_hteam m)
 601
 602     -- Insert them...
 603     vteam_fk <- insert vteam
 604     hteam_fk <- insert hteam
 605
 606     -- Now we can key the message to the teams/breakdowns we just
 607     -- inserted.
 608     let db_msg = from_xml_fk_teams undefined vteam_fk hteam_fk m
 609     msg_id <- insert db_msg
 610
 611     -- Next, the vteam/hteam breakdowns, also needed to construct the
 612     -- main message record
 613     let vteam_bd = xml_away_team $ xml_game_breakdown m
 614     let hteam_bd = xml_home_team $ xml_game_breakdown m
 615
 616     vteam_bd_fk <- insert_xml vteam_bd
 617     hteam_bd_fk <- insert_xml hteam_bd
 618
 619     -- Insert the runs-by-innings associated with the vteam/hteam
 620     -- breakdowns.
 621     forM_ (xml_runs_by_innings vteam_bd) $ insert_xml_fk_ vteam_bd_fk
 622     forM_ (xml_runs_by_innings hteam_bd) $ insert_xml_fk_ hteam_bd_fk
 623
 624     -- Now the join table record that ties the message to its two team
 625     -- breakdowns.
 626     let msg__breakdown = MLBBoxScore_MLBBoxScoreTeamBreakdown
 627                            msg_id
 628                            vteam_bd_fk
 629                            hteam_bd_fk
 630
 631     insert_ msg__breakdown
 632
 633     -- Now insert the homerun stats listings, keyed to the message.
 634     -- They need not be present, but we're going to loop through them
 635     -- all anyway, so if we have 'Nothing', we convert that to an
 636     -- empty list instead. This simplifies the `forM_` code.
 637     let listings = fromMaybe [] (xml_homerun_stats_listings m)
 638     forM_ listings $ \listing -> do
 639       -- Insert the listing itself.
 640       listing_id <- insert_xml_fk msg_id listing
 641       -- And all of its pitchers
 642       forM_ (xml_pitchers listing) $ insert_xml_fk listing_id
 643
 644     -- We have two tables of pitching stats that need to be keyed to
 645     -- the message, too.
 646     let iws = xml_intentional_walks (xml_misc_pitching_stats m)
 647     forM_ iws $ insert_xml_fk_ msg_id
 648
 649     let hbps = xml_hits_by_pitch (xml_misc_pitching_stats m)
 650     forM_ hbps $ insert_xml_fk_ msg_id
 651
 652     return ImportSucceeded
 653
 654
 655
 656 mkPersist tsn_codegen_config [groundhog|
 657 - entity: MLBBoxScore
 658   dbName: mlb_box_scores
 659   constructors:
 660     - name: MLBBoxScore
 661       uniques:
 662         - name: unique_mlb_box_scores
 663           type: constraint
 664           # Prevent multiple imports of the same message.
 665           fields: [db_xml_file_id]
 666
 667
 668
 669 - entity: MLBBoxScoreMiscPitchingStatsIntentionalWalk
 670   dbName: mlb_box_scores_misc_pitching_stats_intentional_walks
 671   constructors:
 672     - name: MLBBoxScoreMiscPitchingStatsIntentionalWalk
 673       fields:
 674         - name: dbiw_mlb_box_scores_id
 675           reference:
 676             onDelete: cascade
 677
 678
 679 - entity: MLBBoxScoreMiscPitchingStatsHitByPitch
 680   dbName: mlb_box_scores_misc_pitching_stats_hits_by_pitch
 681   constructors:
 682     - name: MLBBoxScoreMiscPitchingStatsHitByPitch
 683       fields:
 684         - name: dbhbp_mlb_box_scores_id
 685           reference:
 686             onDelete: cascade
 687
 688
 689 - embedded: MLBBoxScoreHomerunStatsListingBatter
 690   fields:
 691     - name: db_batter_first_name
 692       dbName: batter_first_name
 693     - name: db_batter_last_name
 694       dbName: batter_last_name
 695     - name: db_batter_rbis
 696       dbName: batter_rbis
 697     - name: db_batter_id
 698       dbName: batter_id
 699
 700 - entity: MLBBoxScoreHomerunStatsListing
 701   dbName: mlb_box_score_homerun_stats_listings
 702   constructors:
 703     - name: MLBBoxScoreHomerunStatsListing
 704       fields:
 705         - name: db_batter
 706           embeddedType:
 707             - {name: batter_first_name, dbName: batter_first_name}
 708             - {name: batter_last_name, dbName: batter_last_name}
 709             - {name: batter_rbis, dbName: batter_rbis}
 710             - {name: batter_id, dbName: batter_id}
 711
 712 - entity: MLBBoxScoreHomerunStatsListingPitcher
 713   dbName: mlb_box_score_homerun_stats_listing_pitchers
 714   constructors:
 715     - name: MLBBoxScoreHomerunStatsListingPitcher
 716       fields:
 717         - name: db_mlb_box_score_homerun_stats_listings_id
 718           reference:
 719             onDelete: cascade
 720
 721 - entity: MLBBoxScoreTeamBreakdown
 722   dbName: mlb_box_scores_team_breakdowns
 723   constructors:
 724     - name: MLBBoxScoreTeamBreakdown
 725
 726 - entity: MLBBoxScoreRunsByInnings
 727   dbName: mlb_box_scores_team_breakdowns_runs_by_innings
 728   constructors:
 729     - name: MLBBoxScoreRunsByInnings
 730       fields:
 731         - name: db_mlb_box_scores_team_breakdowns_id
 732           reference:
 733             onDelete: cascade
 734
 735
 736 - entity: MLBBoxScore_MLBBoxScoreTeamBreakdown
 737   dbName: mlb_box_scores__mlb_box_scores_team_breakdowns
 738   constructors:
 739     - name: MLBBoxScore_MLBBoxScoreTeamBreakdown
 740       fields:
 741         - name: mLBBoxScore_MLBBoxScoreTeamBreakdown0
 742           dbName: mlb_box_scores_id
 743           reference:
 744             onDelete: cascade
 745         - name: mLBBoxScore_MLBBoxScoreTeamBreakdown1
 746           dbName: mlb_box_scores_team_breakdowns_away_team_id
 747           reference:
 748             onDelete: cascade
 749         - name: mLBBoxScore_MLBBoxScoreTeamBreakdown2
 750           dbName: db_mlb_box_scores_team_breakdowns_home_team_id
 751           reference:
 752             onDelete: cascade
 753 |]
 754
 755
 756
 757 --
 758 -- * Pickling
 759 --
 760
 761 pickle_message :: PU Message
 762 pickle_message =
 763   xpElem "message" $
 764     xpWrap (from_tuple, H.convert) $
 765       xp23Tuple (xpElem "XML_File_ID" xpInt)
 766                 (xpElem "heading" xpText)
 767                 (xpElem "category" xpText)
 768                 (xpElem "sport" xpText)
 769                 (xpElem "game_id" xpInt)
 770                 (xpElem "schedule_id" xpInt)
 771                 (xpElem "vteam" xpText)
 772                 (xpElem "hteam" xpText)
 773                 (xpElem "vteam_id" xpText)
 774                 (xpElem "hteam_id" xpText)
 775                 (xpElem "Season" xpText)
 776                 (xpElem "SeasonType" xpText)
 777                 (xpElem "title" xpText)
 778                 (xpElem "Game_Date" xp_date)
 779                 (xpElem "Game_Time" xp_time)
 780                 (xpElem "GameNumber" xpInt)
 781                 (xpElem "Capacity" xpInt)
 782                 pickle_game_breakdown
 783                 (xpList pickle_team_summary)
 784                 pickle_misc_pitching_stats
 785                 (xpOption pickle_homerun_stats_listings)
 786                 pickle_miscellaneous_game_info
 787                 (xpElem "time_stamp" xp_time_stamp)
 788   where
 789     from_tuple = uncurryN Message
 790
 791
 792 pickle_team_summary :: PU MLBBoxScoreTeamSummaryXml
 793 pickle_team_summary =
 794   xpElem "Team_Summary" $ xpWrap (from_tuple, to_tuple') $ xpUnit
 795   where
 796     from_tuple _ = MLBBoxScoreTeamSummaryXml
 797     to_tuple'   _ = ()
 798
 799 pickle_game_breakdown :: PU MLBBoxScoreGameBreakdownXml
 800 pickle_game_breakdown =
 801   xpElem "Game_Breakdown" $
 802     xpWrap (from_tuple, H.convert) $
 803       xpPair pickle_away_team
 804              pickle_home_team
 805   where
 806     from_tuple = uncurry MLBBoxScoreGameBreakdownXml
 807
 808
 809 pickle_runs_by_innings :: PU MLBBoxScoreRunsByInningsXml
 810 pickle_runs_by_innings =
 811   xpElem "Runs_By_Innings" $
 812     xpWrap (from_tuple, H.convert) $
 813       xpPair (xpAttr "Inning" xpInt)
 814              xpInt
 815   where
 816     from_tuple = uncurry MLBBoxScoreRunsByInningsXml
 817
 818
 819 pickle_team :: PU MLBBoxScoreTeamBreakdownXml
 820 pickle_team =
 821   xpWrap (from_tuple, H.convert) $
 822     xp4Tuple (xpList pickle_runs_by_innings)
 823              (xpElem "Runs" xpInt)
 824              (xpElem "Hits" xpInt)
 825              (xpElem "Errors" xpInt)
 826   where
 827     from_tuple = uncurryN MLBBoxScoreTeamBreakdownXml
 828
 829
 830 pickle_away_team :: PU MLBBoxScoreTeamBreakdownXml
 831 pickle_away_team =
 832   xpElem "AwayTeam" pickle_team
 833
 834 pickle_home_team :: PU MLBBoxScoreTeamBreakdownXml
 835 pickle_home_team =
 836   xpElem "HomeTeam" pickle_team
 837
 838
 839 pickle_batter :: PU MLBBoxScoreHomerunStatsListingBatter
 840 pickle_batter =
 841   xpElem "HRS_Batter_ID" $
 842     xpWrap (from_tuple, H.convert) $
 843     xp4Tuple (xpAttr "HRS_Batter_FirstName" $ xpText)
 844              (xpAttr "HRS_Batter_LastName" $ xpText)
 845              (xpAttr "RBIs" $ xpInt)
 846              xpInt
 847   where
 848     from_tuple = uncurryN MLBBoxScoreHomerunStatsListingBatter
 849
 850
 851 pickle_pitcher :: PU MLBBoxScoreHomerunStatsListingPitcherXml
 852 pickle_pitcher =
 853   xpElem "HRS_Pitcher_ID" $
 854     xpWrap (from_tuple, H.convert) $
 855     xp4Tuple (xpAttr "HRS_Homeruns_Off_Pitcher" $ xpInt)
 856              (xpAttr "HRS_Pitcher_FirstName" $ xpText)
 857              (xpAttr "HRS_Pitcher_LastName" $ xpText)
 858              xpInt
 859   where
 860     from_tuple = uncurryN MLBBoxScoreHomerunStatsListingPitcherXml
 861
 862
 863 pickle_homerun_stats_listing :: PU MLBBoxScoreHomerunStatsListingXml
 864 pickle_homerun_stats_listing =
 865   xpElem "HRS_Listing" $
 866     xpWrap (from_tuple, H.convert) $
 867     xpTriple pickle_batter
 868              (xpElem "Season_Homeruns" xpInt)
 869              (xpList pickle_pitcher)
 870   where
 871     from_tuple = uncurryN MLBBoxScoreHomerunStatsListingXml
 872
 873
 874 pickle_homerun_stats_listings :: PU [MLBBoxScoreHomerunStatsListingXml]
 875 pickle_homerun_stats_listings =
 876   xpElem "Homerun_Stats" $ xpList pickle_homerun_stats_listing
 877
 878
 879 pickle_misc_pitching_stats :: PU MLBBoxScoreMiscPitchingStatsXml
 880 pickle_misc_pitching_stats =
 881   xpElem "Misc_Pitching_Stats" $
 882     xpWrap (from_tuple, H.convert) $
 883       xpTriple (xpOption $ xpElem "Wild_Pitches" xpInt)
 884                pickle_intentional_walks
 885                pickle_hits_by_pitch
 886   where
 887     from_tuple = uncurryN MLBBoxScoreMiscPitchingStatsXml
 888
 889
 890
 891 pickle_intentional_walks :: PU [MLBBoxScoreMiscPitchingStatsIntentionalWalkXml]
 892 pickle_intentional_walks =
 893   xpElem "Intentional_Walks" $ xpList $ xpElem "IW_Listing" $
 894     xpWrap (from_tuple, H.convert) $
 895       xpTriple (xpElem "IW_Batter_ID" xpInt)
 896                (xpElem "IW_Pitcher_ID" xpInt)
 897                (xpElem "IW_Number_Of_Times_Walked" xpInt)
 898   where
 899     from_tuple = uncurryN MLBBoxScoreMiscPitchingStatsIntentionalWalkXml
 900
 901
 902
 903 pickle_hits_by_pitch :: PU [MLBBoxScoreMiscPitchingStatsHitByPitchXml]
 904 pickle_hits_by_pitch =
 905   xpElem "Hit_By_Pitch" $ xpList $ xpElem "HBP_Listing" $
 906     xpWrap (from_tuple, H.convert) $
 907       xpTriple (xpElem "HBP_Batter_ID" xpInt)
 908                (xpElem "HBP_Pitcher_ID" xpInt)
 909                (xpElem "HBP_Number_Of_Times_Hit" xpInt)
 910   where
 911     from_tuple = uncurryN MLBBoxScoreMiscPitchingStatsHitByPitchXml
 912
 913
 914
 915 pickle_miscellaneous_game_info :: PU MLBBoxScoreMiscellaneousGameInfoXml
 916 pickle_miscellaneous_game_info =
 917   xpElem "Miscelaneous_Game_Info" $ xpWrap (from_tuple, to_tuple') $ xpUnit
 918   where
 919     from_tuple _ = MLBBoxScoreMiscellaneousGameInfoXml
 920     to_tuple'  _ = ()