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 Data.Typeable ( Typeable )
  38 import Database.Groundhog (
  39   insert,
  40   insert_,
  41   migrate )
  42 import Database.Groundhog.Core ( DefaultKey )
  43 import Database.Groundhog.TH (
  44   groundhog,
  45   mkPersist )
  46 import qualified GHC.Generics as GHC ( Generic )
  47 import Text.XML.HXT.Core (
  48   PU,
  49   xp4Tuple,
  50   xp23Tuple,
  51   xpAttr,
  52   xpElem,
  53   xpInt,
  54   xpList,
  55   xpOption,
  56   xpPair,
  57   xpText,
  58   xpTriple,
  59   xpUnit,
  60   xpWrap )
  61
  62 -- Local imports.
  63 import Generics ( Generic(..), to_tuple )
  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 'Generics.to_tuple'.
 152 --
 153 instance Generic 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 'Generics.to_tuple'
 210 --
 211 instance Generic 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 'Generics.to_tuple'
 223 --
 224 instance Generic 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 'Generics.to_tuple'
 241 --
 242 instance Generic 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 'Generics.to_tuple'
 294 --
 295 instance Generic 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 'Generics.to_tuple'.
 355 instance Generic 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 'Generics.to_tuple'.
 410 --
 411 instance Generic 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 'Generics.to_tuple'.
 461 --
 462 instance Generic 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 'Generics.to_tuple'.
 487 instance Generic MLBBoxScoreMiscPitchingStatsIntentionalWalkXml
 488
 489
 490 instance ToDb MLBBoxScoreMiscPitchingStatsIntentionalWalkXml where
 491   -- | The database analogue of a
 492   -- 'MLBBoxScoreMiscPitchingStatsIntentionalWalkXml' is a
 493   -- 'MLBBoxScoreMiscPitchingStatsIntentionalWalk'.
 494   --
 495   type Db MLBBoxScoreMiscPitchingStatsIntentionalWalkXml =
 496     MLBBoxScoreMiscPitchingStatsIntentionalWalk
 497
 498
 499 instance Child MLBBoxScoreMiscPitchingStatsIntentionalWalkXml where
 500   -- | Each 'MLBBoxScoreMiscPitchingStatsIntentionalWalkXml' is
 501   --   contained in (i.e. has a foreign key to) a 'MLBBoxScore'.
 502   --
 503   type Parent MLBBoxScoreMiscPitchingStatsIntentionalWalkXml =
 504     MLBBoxScore
 505
 506
 507 instance FromXmlFk MLBBoxScoreMiscPitchingStatsIntentionalWalkXml where
 508   -- | To convert an 'MLBBoxScoreMiscPitchingStatsIntentionalWalkXml'
 509   --   to an 'MLBBoxScoreMiscPitchingStatsIntentionalWalk', we add the
 510   --   foreign key and copy everything else verbatim.
 511   --
 512   from_xml_fk fk MLBBoxScoreMiscPitchingStatsIntentionalWalkXml{..} =
 513     MLBBoxScoreMiscPitchingStatsIntentionalWalk {
 514     dbiw_mlb_box_scores_id = fk,
 515     dbiw_batter_id = xml_iw_batter_id,
 516     dbiw_pitcher_id = xml_iw_pitcher_id,
 517     dbiw_number_of_times_walked = xml_iw_number_of_times_walked }
 518
 519
 520 -- | This allows us to insert the XML representation
 521 --   'MLBBoxScoreMiscPitchingStatsIntentionalWalkXml' directly.
 522 --
 523 instance XmlImportFk MLBBoxScoreMiscPitchingStatsIntentionalWalkXml
 524
 525
 526
 527 -- * MLBBoxScoreMiscPitchingStatsHitByPitchXml
 528
 529 data MLBBoxScoreMiscPitchingStatsHitByPitch =
 530   MLBBoxScoreMiscPitchingStatsHitByPitch {
 531     dbhbp_mlb_box_scores_id :: DefaultKey MLBBoxScore,
 532     dbhbp_batter_id :: Int,
 533     dbhbp_pitcher_id :: Int,
 534     dbhbp_number_of_times_hit :: Int }
 535
 536
 537 instance ToDb MLBBoxScoreMiscPitchingStatsHitByPitchXml where
 538   -- | The database analogue of a
 539   -- 'MLBBoxScoreMiscPitchingStatsHitByPitchXml' is a
 540   -- 'MLBBoxScoreMiscPitchingStatsHitByPitch'.
 541   --
 542   type Db MLBBoxScoreMiscPitchingStatsHitByPitchXml =
 543     MLBBoxScoreMiscPitchingStatsHitByPitch
 544
 545
 546 instance Child MLBBoxScoreMiscPitchingStatsHitByPitchXml where
 547   -- | Each 'MLBBoxScoreMiscPitchingStatsHitByPitchXml' is
 548   --   contained in (i.e. has a foreign key to) a 'MLBBoxScore'.
 549   --
 550   type Parent MLBBoxScoreMiscPitchingStatsHitByPitchXml =
 551     MLBBoxScore
 552
 553
 554 instance FromXmlFk MLBBoxScoreMiscPitchingStatsHitByPitchXml where
 555   -- | To convert an 'MLBBoxScoreMiscPitchingStatsHitByPitchXml'
 556   --   to an 'MLBBoxScoreMiscPitchingStatsHitByPitch', we add the
 557   --   foreign key and copy everything else verbatim.
 558   --
 559   from_xml_fk fk MLBBoxScoreMiscPitchingStatsHitByPitchXml{..} =
 560     MLBBoxScoreMiscPitchingStatsHitByPitch {
 561     dbhbp_mlb_box_scores_id = fk,
 562     dbhbp_batter_id = xml_hbp_batter_id,
 563     dbhbp_pitcher_id = xml_hbp_pitcher_id,
 564     dbhbp_number_of_times_hit = xml_hbp_number_of_times_hit }
 565
 566
 567 -- | This allows us to insert the XML representation
 568 --   'MLBBoxScoreMiscPitchingStatsHitByPitchXml' directly.
 569 --
 570 instance XmlImportFk MLBBoxScoreMiscPitchingStatsHitByPitchXml
 571
 572
 573 data MLBBoxScoreMiscPitchingStatsHitByPitchXml =
 574   MLBBoxScoreMiscPitchingStatsHitByPitchXml {
 575     xml_hbp_batter_id :: Int,
 576     xml_hbp_pitcher_id :: Int,
 577     xml_hbp_number_of_times_hit :: Int }
 578   deriving (Eq, GHC.Generic, Show)
 579
 580
 581 -- | For 'Generics.to_tuple'.
 582 --
 583 instance Generic MLBBoxScoreMiscPitchingStatsHitByPitchXml
 584
 585
 586 --
 587 -- * Database
 588 --
 589
 590 instance DbImport Message where
 591   dbmigrate _ =
 592     run_dbmigrate $ do
 593       migrate (undefined :: MLBBoxScore)
 594
 595   -- | We insert the message.
 596   dbimport m = do
 597     -- First, get the vteam/hteam out of the XML message.
 598     let vteam = Team (xml_vteam_id m) Nothing (Just $ xml_vteam m)
 599     let hteam = Team (xml_hteam_id m) Nothing (Just $ xml_hteam m)
 600
 601     -- Insert them...
 602     vteam_fk <- insert vteam
 603     hteam_fk <- insert hteam
 604
 605     -- Now we can key the message to the teams/breakdowns we just
 606     -- inserted.
 607     let db_msg = from_xml_fk_teams undefined vteam_fk hteam_fk m
 608     msg_id <- insert db_msg
 609
 610     -- Next, the vteam/hteam breakdowns, also needed to construct the
 611     -- main message record
 612     let vteam_bd = xml_away_team $ xml_game_breakdown m
 613     let hteam_bd = xml_home_team $ xml_game_breakdown m
 614
 615     vteam_bd_fk <- insert_xml vteam_bd
 616     hteam_bd_fk <- insert_xml hteam_bd
 617
 618     -- Insert the runs-by-innings associated with the vteam/hteam
 619     -- breakdowns.
 620     forM_ (xml_runs_by_innings vteam_bd) $ insert_xml_fk_ vteam_bd_fk
 621     forM_ (xml_runs_by_innings hteam_bd) $ insert_xml_fk_ hteam_bd_fk
 622
 623     -- Now the join table record that ties the message to its two team
 624     -- breakdowns.
 625     let msg__breakdown = MLBBoxScore_MLBBoxScoreTeamBreakdown
 626                            msg_id
 627                            vteam_bd_fk
 628                            hteam_bd_fk
 629
 630     insert_ msg__breakdown
 631
 632     -- Now insert the homerun stats listings, keyed to the message.
 633     -- They need not be present, but we're going to loop through them
 634     -- all anyway, so if we have 'Nothing', we convert that to an
 635     -- empty list instead. This simplifies the `forM_` code.
 636     let listings = fromMaybe [] (xml_homerun_stats_listings m)
 637     forM_ listings $ \listing -> do
 638       -- Insert the listing itself.
 639       listing_id <- insert_xml_fk msg_id listing
 640       -- And all of its pitchers
 641       forM_ (xml_pitchers listing) $ insert_xml_fk listing_id
 642
 643     -- We have two tables of pitching stats that need to be keyed to
 644     -- the message, too.
 645     let iws = xml_intentional_walks (xml_misc_pitching_stats m)
 646     forM_ iws $ insert_xml_fk_ msg_id
 647
 648     let hbps = xml_hits_by_pitch (xml_misc_pitching_stats m)
 649     forM_ hbps $ insert_xml_fk_ msg_id
 650
 651     return ImportSucceeded
 652
 653
 654
 655 mkPersist tsn_codegen_config [groundhog|
 656 - entity: MLBBoxScore
 657   dbName: mlb_box_scores
 658   constructors:
 659     - name: MLBBoxScore
 660       uniques:
 661         - name: unique_mlb_box_scores
 662           type: constraint
 663           # Prevent multiple imports of the same message.
 664           fields: [db_xml_file_id]
 665
 666
 667
 668 - entity: MLBBoxScoreMiscPitchingStatsIntentionalWalk
 669   dbName: mlb_box_scores_misc_pitching_stats_intentional_walks
 670   constructors:
 671     - name: MLBBoxScoreMiscPitchingStatsIntentionalWalk
 672       fields:
 673         - name: dbiw_mlb_box_scores_id
 674           reference:
 675             onDelete: cascade
 676
 677
 678 - entity: MLBBoxScoreMiscPitchingStatsHitByPitch
 679   dbName: mlb_box_scores_misc_pitching_stats_hits_by_pitch
 680   constructors:
 681     - name: MLBBoxScoreMiscPitchingStatsHitByPitch
 682       fields:
 683         - name: dbhbp_mlb_box_scores_id
 684           reference:
 685             onDelete: cascade
 686
 687
 688 - embedded: MLBBoxScoreHomerunStatsListingBatter
 689   fields:
 690     - name: db_batter_first_name
 691       dbName: batter_first_name
 692     - name: db_batter_last_name
 693       dbName: batter_last_name
 694     - name: db_batter_rbis
 695       dbName: batter_rbis
 696     - name: db_batter_id
 697       dbName: batter_id
 698
 699 - entity: MLBBoxScoreHomerunStatsListing
 700   dbName: mlb_box_score_homerun_stats_listings
 701   constructors:
 702     - name: MLBBoxScoreHomerunStatsListing
 703       fields:
 704         - name: db_batter
 705           embeddedType:
 706             - {name: batter_first_name, dbName: batter_first_name}
 707             - {name: batter_last_name, dbName: batter_last_name}
 708             - {name: batter_rbis, dbName: batter_rbis}
 709             - {name: batter_id, dbName: batter_id}
 710
 711 - entity: MLBBoxScoreHomerunStatsListingPitcher
 712   dbName: mlb_box_score_homerun_stats_listing_pitchers
 713   constructors:
 714     - name: MLBBoxScoreHomerunStatsListingPitcher
 715       fields:
 716         - name: db_mlb_box_score_homerun_stats_listings_id
 717           reference:
 718             onDelete: cascade
 719
 720 - entity: MLBBoxScoreTeamBreakdown
 721   dbName: mlb_box_scores_team_breakdowns
 722   constructors:
 723     - name: MLBBoxScoreTeamBreakdown
 724
 725 - entity: MLBBoxScoreRunsByInnings
 726   dbName: mlb_box_scores_team_breakdowns_runs_by_innings
 727   constructors:
 728     - name: MLBBoxScoreRunsByInnings
 729       fields:
 730         - name: db_mlb_box_scores_team_breakdowns_id
 731           reference:
 732             onDelete: cascade
 733
 734
 735 - entity: MLBBoxScore_MLBBoxScoreTeamBreakdown
 736   dbName: mlb_box_scores__mlb_box_scores_team_breakdowns
 737   constructors:
 738     - name: MLBBoxScore_MLBBoxScoreTeamBreakdown
 739       fields:
 740         - name: mLBBoxScore_MLBBoxScoreTeamBreakdown0
 741           dbName: mlb_box_scores_id
 742           reference:
 743             onDelete: cascade
 744         - name: mLBBoxScore_MLBBoxScoreTeamBreakdown1
 745           dbName: mlb_box_scores_team_breakdowns_away_team_id
 746           reference:
 747             onDelete: cascade
 748         - name: mLBBoxScore_MLBBoxScoreTeamBreakdown2
 749           dbName: db_mlb_box_scores_team_breakdowns_home_team_id
 750           reference:
 751             onDelete: cascade
 752 |]
 753
 754
 755
 756 --
 757 -- * Pickling
 758 --
 759
 760 pickle_message :: PU Message
 761 pickle_message =
 762   xpElem "message" $
 763     xpWrap (from_tuple, to_tuple) $
 764       xp23Tuple (xpElem "XML_File_ID" xpInt)
 765                 (xpElem "heading" xpText)
 766                 (xpElem "category" xpText)
 767                 (xpElem "sport" xpText)
 768                 (xpElem "game_id" xpInt)
 769                 (xpElem "schedule_id" xpInt)
 770                 (xpElem "vteam" xpText)
 771                 (xpElem "hteam" xpText)
 772                 (xpElem "vteam_id" xpText)
 773                 (xpElem "hteam_id" xpText)
 774                 (xpElem "Season" xpText)
 775                 (xpElem "SeasonType" xpText)
 776                 (xpElem "title" xpText)
 777                 (xpElem "Game_Date" xp_date)
 778                 (xpElem "Game_Time" xp_time)
 779                 (xpElem "GameNumber" xpInt)
 780                 (xpElem "Capacity" xpInt)
 781                 pickle_game_breakdown
 782                 (xpList pickle_team_summary)
 783                 pickle_misc_pitching_stats
 784                 (xpOption pickle_homerun_stats_listings)
 785                 pickle_miscellaneous_game_info
 786                 (xpElem "time_stamp" xp_time_stamp)
 787   where
 788     from_tuple = uncurryN Message
 789
 790
 791 pickle_team_summary :: PU MLBBoxScoreTeamSummaryXml
 792 pickle_team_summary =
 793   xpElem "Team_Summary" $ xpWrap (from_tuple, to_tuple') $ xpUnit
 794   where
 795     from_tuple _ = MLBBoxScoreTeamSummaryXml
 796     to_tuple'   _ = ()
 797
 798 pickle_game_breakdown :: PU MLBBoxScoreGameBreakdownXml
 799 pickle_game_breakdown =
 800   xpElem "Game_Breakdown" $
 801     xpWrap (from_tuple, to_tuple) $
 802       xpPair pickle_away_team
 803              pickle_home_team
 804   where
 805     from_tuple = uncurry MLBBoxScoreGameBreakdownXml
 806
 807
 808 pickle_runs_by_innings :: PU MLBBoxScoreRunsByInningsXml
 809 pickle_runs_by_innings =
 810   xpElem "Runs_By_Innings" $
 811     xpWrap (from_tuple, to_tuple) $
 812       xpPair (xpAttr "Inning" xpInt)
 813              xpInt
 814   where
 815     from_tuple = uncurry MLBBoxScoreRunsByInningsXml
 816
 817
 818 pickle_team :: PU MLBBoxScoreTeamBreakdownXml
 819 pickle_team =
 820   xpWrap (from_tuple, to_tuple) $
 821     xp4Tuple (xpList pickle_runs_by_innings)
 822              (xpElem "Runs" xpInt)
 823              (xpElem "Hits" xpInt)
 824              (xpElem "Errors" xpInt)
 825   where
 826     from_tuple = uncurryN MLBBoxScoreTeamBreakdownXml
 827
 828
 829 pickle_away_team :: PU MLBBoxScoreTeamBreakdownXml
 830 pickle_away_team =
 831   xpElem "AwayTeam" pickle_team
 832
 833 pickle_home_team :: PU MLBBoxScoreTeamBreakdownXml
 834 pickle_home_team =
 835   xpElem "HomeTeam" pickle_team
 836
 837
 838 pickle_batter :: PU MLBBoxScoreHomerunStatsListingBatter
 839 pickle_batter =
 840   xpElem "HRS_Batter_ID" $
 841     xpWrap (from_tuple, to_tuple) $
 842     xp4Tuple (xpAttr "HRS_Batter_FirstName" $ xpText)
 843              (xpAttr "HRS_Batter_LastName" $ xpText)
 844              (xpAttr "RBIs" $ xpInt)
 845              xpInt
 846   where
 847     from_tuple = uncurryN MLBBoxScoreHomerunStatsListingBatter
 848
 849
 850 pickle_pitcher :: PU MLBBoxScoreHomerunStatsListingPitcherXml
 851 pickle_pitcher =
 852   xpElem "HRS_Pitcher_ID" $
 853     xpWrap (from_tuple, to_tuple) $
 854     xp4Tuple (xpAttr "HRS_Homeruns_Off_Pitcher" $ xpInt)
 855              (xpAttr "HRS_Pitcher_FirstName" $ xpText)
 856              (xpAttr "HRS_Pitcher_LastName" $ xpText)
 857              xpInt
 858   where
 859     from_tuple = uncurryN MLBBoxScoreHomerunStatsListingPitcherXml
 860
 861
 862 pickle_homerun_stats_listing :: PU MLBBoxScoreHomerunStatsListingXml
 863 pickle_homerun_stats_listing =
 864   xpElem "HRS_Listing" $
 865     xpWrap (from_tuple, to_tuple) $
 866     xpTriple pickle_batter
 867              (xpElem "Season_Homeruns" xpInt)
 868              (xpList pickle_pitcher)
 869   where
 870     from_tuple = uncurryN MLBBoxScoreHomerunStatsListingXml
 871
 872
 873 pickle_homerun_stats_listings :: PU [MLBBoxScoreHomerunStatsListingXml]
 874 pickle_homerun_stats_listings =
 875   xpElem "Homerun_Stats" $ xpList pickle_homerun_stats_listing
 876
 877
 878 pickle_misc_pitching_stats :: PU MLBBoxScoreMiscPitchingStatsXml
 879 pickle_misc_pitching_stats =
 880   xpElem "Misc_Pitching_Stats" $
 881     xpWrap (from_tuple, to_tuple) $
 882       xpTriple (xpOption $ xpElem "Wild_Pitches" xpInt)
 883                pickle_intentional_walks
 884                pickle_hits_by_pitch
 885   where
 886     from_tuple = uncurryN MLBBoxScoreMiscPitchingStatsXml
 887
 888
 889
 890 pickle_intentional_walks :: PU [MLBBoxScoreMiscPitchingStatsIntentionalWalkXml]
 891 pickle_intentional_walks =
 892   xpElem "Intentional_Walks" $ xpList $ xpElem "IW_Listing" $
 893     xpWrap (from_tuple, to_tuple) $
 894       xpTriple (xpElem "IW_Batter_ID" xpInt)
 895                (xpElem "IW_Pitcher_ID" xpInt)
 896                (xpElem "IW_Number_Of_Times_Walked" xpInt)
 897   where
 898     from_tuple = uncurryN MLBBoxScoreMiscPitchingStatsIntentionalWalkXml
 899
 900
 901
 902 pickle_hits_by_pitch :: PU [MLBBoxScoreMiscPitchingStatsHitByPitchXml]
 903 pickle_hits_by_pitch =
 904   xpElem "Hit_By_Pitch" $ xpList $ xpElem "HBP_Listing" $
 905     xpWrap (from_tuple, to_tuple) $
 906       xpTriple (xpElem "HBP_Batter_ID" xpInt)
 907                (xpElem "HBP_Pitcher_ID" xpInt)
 908                (xpElem "HBP_Number_Of_Times_Hit" xpInt)
 909   where
 910     from_tuple = uncurryN MLBBoxScoreMiscPitchingStatsHitByPitchXml
 911
 912
 913
 914 pickle_miscellaneous_game_info :: PU MLBBoxScoreMiscellaneousGameInfoXml
 915 pickle_miscellaneous_game_info =
 916   xpElem "Miscelaneous_Game_Info" $ xpWrap (from_tuple, to_tuple') $ xpUnit
 917   where
 918     from_tuple _ = MLBBoxScoreMiscellaneousGameInfoXml
 919     to_tuple'  _ = ()