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, cons, convert, tail )
  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 -- | The leading underscores prevent unused field warnings.
 215 --
 216 data MLBBoxScoreHomerunStatsListingBatter =
 217   MLBBoxScoreHomerunStatsListingBatter {
 218     _db_batter_first_name :: String,
 219     _db_batter_last_name :: String,
 220     _db_batter_rbis :: Int,
 221     _db_batter_id :: Int }
 222   deriving (Data, Eq, GHC.Generic, Show, Typeable)
 223
 224 -- | For 'H.convert'
 225 --
 226 instance H.HVector MLBBoxScoreHomerunStatsListingBatter
 227
 228
 229 data MLBBoxScoreHomerunStatsListing =
 230   MLBBoxScoreHomerunStatsListing {
 231     db_mlb_box_scores_id :: DefaultKey MLBBoxScore,
 232     db_batter :: MLBBoxScoreHomerunStatsListingBatter, -- embedded
 233     db_season_homeruns :: Int }
 234
 235 data MLBBoxScoreHomerunStatsListingXml =
 236   MLBBoxScoreHomerunStatsListingXml {
 237     xml_batter :: MLBBoxScoreHomerunStatsListingBatter,
 238     xml_season_homeruns :: Int,
 239     xml_pitchers :: [MLBBoxScoreHomerunStatsListingPitcherXml] }
 240   deriving (Eq, GHC.Generic, Show)
 241
 242 -- | For 'H.convert'
 243 --
 244 instance H.HVector MLBBoxScoreHomerunStatsListingXml
 245
 246 instance Child MLBBoxScoreHomerunStatsListingXml where
 247   -- | Each 'MLBBoxScoreHomerunStatsListingXml' is contained in (i.e. has a
 248   --   foreign key to) a 'MLBBoxScore'.
 249   --
 250   type Parent MLBBoxScoreHomerunStatsListingXml = MLBBoxScore
 251
 252
 253 instance ToDb MLBBoxScoreHomerunStatsListingXml where
 254   -- | The database representation of
 255   --   'MLBBoxScoreHomerunStatsListingXml' is
 256   --   'MLBBoxScoreHomerunStatsListing'.
 257     --
 258   type Db MLBBoxScoreHomerunStatsListingXml = MLBBoxScoreHomerunStatsListing
 259
 260 instance FromXmlFk MLBBoxScoreHomerunStatsListingXml where
 261   -- | To convert an 'MLBBoxScoreHomerunStatsListingXml' to an
 262   --   'MLBBoxScoreHomerunStatsListing', we add the foreign key and
 263   --   drop the pitchers.
 264   --
 265   from_xml_fk fk MLBBoxScoreHomerunStatsListingXml{..} =
 266     MLBBoxScoreHomerunStatsListing {
 267       db_mlb_box_scores_id = fk,
 268       db_batter = xml_batter,
 269       db_season_homeruns = xml_season_homeruns }
 270
 271
 272 -- | This allows us to insert the XML representation
 273 --   'MLBBoxScoreHomerunStatsListingXml' directly.
 274 --
 275 instance XmlImportFk MLBBoxScoreHomerunStatsListingXml
 276
 277
 278 -- | The leading underscores prevent unused field warnings.
 279 --
 280 data MLBBoxScoreHomerunStatsListingPitcher =
 281   MLBBoxScoreHomerunStatsListingPitcher {
 282     _db_mlb_box_score_homerun_stats_listings_id ::
 283       DefaultKey MLBBoxScoreHomerunStatsListing,
 284     _db_homeruns_off_pitcher :: Int,
 285     _db_pitcher_first_name :: String,
 286     _db_pitcher_last_name :: String,
 287     _db_pitchers_pitcher_id :: Int }
 288   deriving ( GHC.Generic )
 289
 290
 291 -- | For 'H.cons' and 'H.convert'.
 292 --
 293 instance H.HVector MLBBoxScoreHomerunStatsListingPitcher
 294
 295
 296 -- | The leading underscores prevent unused field warnings.
 297 --
 298 data MLBBoxScoreHomerunStatsListingPitcherXml =
 299   MLBBoxScoreHomerunStatsListingPitcherXml {
 300     _xml_homeruns_off_pitcher :: Int,
 301     _xml_pitcher_first_name :: String,
 302     _xml_pitcher_last_name :: String,
 303     _xml_pitchers_pitcher_id :: Int }
 304   deriving (Eq, GHC.Generic, Show)
 305
 306 -- | For 'H.convert'
 307 --
 308 instance H.HVector MLBBoxScoreHomerunStatsListingPitcherXml
 309
 310 instance Child MLBBoxScoreHomerunStatsListingPitcherXml where
 311   -- | Each 'MLBBoxScoreHomerunStatsListingPitcherXml' is contained in
 312   --   (i.e. has a foreign key to) a 'MLBBoxScoreHomerunStatsListing'.
 313   --
 314   type Parent MLBBoxScoreHomerunStatsListingPitcherXml =
 315     MLBBoxScoreHomerunStatsListing
 316
 317
 318 instance ToDb MLBBoxScoreHomerunStatsListingPitcherXml where
 319   -- | The database representation of
 320   --   'MLBBoxScoreHomerunStatsListingPitcherXml' is
 321   --   'MLBBoxScoreHomerunStatsListingPitcher'.
 322   --
 323   type Db MLBBoxScoreHomerunStatsListingPitcherXml = MLBBoxScoreHomerunStatsListingPitcher
 324
 325
 326 instance FromXmlFk MLBBoxScoreHomerunStatsListingPitcherXml where
 327   -- | To convert an 'MLBBoxScoreHomerunStatsListingPitcherXml' to an
 328   --   'MLBBoxScoreHomerunStatsListingPitcher', we add the foreign key.
 329   --
 330   from_xml_fk = H.cons
 331
 332
 333 -- | This allows us to insert the XML representation
 334 --   'MLBBoxScoreHomerunStatsListingPitcherXml' directly.
 335 --
 336 instance XmlImportFk MLBBoxScoreHomerunStatsListingPitcherXml
 337
 338
 339
 340
 341 data MLBBoxScoreMiscellaneousGameInfo = MLBBoxScoreMiscellaneousGameInfo
 342 data MLBBoxScoreMiscellaneousGameInfoXml = MLBBoxScoreMiscellaneousGameInfoXml
 343   deriving (Eq, Show)
 344
 345
 346 -- Team Breakdown
 347
 348 -- | The leading underscores prevent unused field warnings.
 349 --
 350 data MLBBoxScoreTeamBreakdown =
 351   MLBBoxScoreTeamBreakdown {
 352     _db_runs :: Int,
 353     _db_hits :: Int,
 354     _db_errors :: Int }
 355   deriving ( GHC.Generic )
 356
 357 -- | For 'H.cons' and 'H.convert'.
 358 --
 359 instance H.HVector MLBBoxScoreTeamBreakdown
 360
 361 -- | The leading underscores prevent unused field warnings.
 362 --
 363 data MLBBoxScoreTeamBreakdownXml =
 364   MLBBoxScoreTeamBreakdownXml {
 365     xml_runs_by_innings :: [MLBBoxScoreRunsByInningsXml],
 366     _xml_runs :: Int,
 367     _xml_hits :: Int,
 368     _xml_errors :: Int }
 369   deriving (Eq, GHC.Generic, Show)
 370
 371
 372 -- | For 'H.convert'.
 373 instance H.HVector MLBBoxScoreTeamBreakdownXml
 374
 375 instance ToDb MLBBoxScoreTeamBreakdownXml where
 376   -- | The database analogue of a 'MLBBoxScoreTeamBreakdownXml' is
 377   --   a 'MLBBoxScoreTeamBreakdown'.
 378   --
 379   type Db MLBBoxScoreTeamBreakdownXml = MLBBoxScoreTeamBreakdown
 380
 381
 382 -- | The 'FromXml' instance for 'MLBBoxScoreTeamBreakdownXml' is
 383 --   required for the 'XmlImport' instance.
 384 --
 385 instance FromXml MLBBoxScoreTeamBreakdownXml where
 386   -- | To convert a 'MLBBoxScoreTeamBreakdownXml' to an
 387   --   'MLBBoxScoreTeamBreakdown', we just drop the
 388   --   'xml_runs_by_innings'.
 389   --
 390   from_xml = H.tail
 391
 392 instance XmlImport MLBBoxScoreTeamBreakdownXml
 393
 394 -- Runs by innings
 395
 396 -- | The leading underscores prevent unused field warnings.
 397 --
 398 data MLBBoxScoreRunsByInnings =
 399   MLBBoxScoreRunsByInnings {
 400     _db_mlb_box_scores_team_breakdowns_id :: DefaultKey
 401                                            MLBBoxScoreTeamBreakdown,
 402     _db_runs_by_innings_inning_number :: Int,
 403     _db_runs_by_innings_runs   :: Int }
 404   deriving ( GHC.Generic )
 405
 406
 407 -- | For 'H.cons' and 'H.convert'.
 408 instance H.HVector MLBBoxScoreRunsByInnings
 409
 410
 411 -- | The leading underscores prevent unused field warnings.
 412 --
 413 data MLBBoxScoreRunsByInningsXml =
 414   MLBBoxScoreRunsByInningsXml {
 415     _xml_runs_by_innings_inning_number :: Int,
 416     _xml_runs_by_innings_runs   :: Int }
 417   deriving (Eq, GHC.Generic, Show)
 418
 419
 420 -- * MLBBoxScore_MLBBoxScoreTeamSummary
 421
 422 -- | Mapping between 'MLBBoxScore' records and
 423 --   'MLBBoxScoreTeamSummary' records in the database. We don't use
 424 --   the names anywhere, so we let Groundhog choose them.
 425 --
 426 data MLBBoxScore_MLBBoxScoreTeamBreakdown =
 427   MLBBoxScore_MLBBoxScoreTeamBreakdown
 428     (DefaultKey MLBBoxScore)
 429     (DefaultKey MLBBoxScoreTeamBreakdown) -- Away team
 430     (DefaultKey MLBBoxScoreTeamBreakdown) -- Home team
 431
 432
 433
 434 -- | For 'H.convert'.
 435 --
 436 instance H.HVector MLBBoxScoreRunsByInningsXml
 437
 438
 439 instance ToDb MLBBoxScoreRunsByInningsXml where
 440   -- | The database analogue of a 'MLBBoxScoreRunsByInningsXml' is
 441   --   a 'MLBBoxScoreRunsByInnings'.
 442   --
 443   type Db MLBBoxScoreRunsByInningsXml = MLBBoxScoreRunsByInnings
 444
 445
 446 instance Child MLBBoxScoreRunsByInningsXml where
 447   -- | Each 'MLBBoxScoreRunsByInningsXml' is contained in (i.e. has a
 448   --   foreign key to) a 'MLBBoxScoreTeamBreakdownXml'.
 449   --
 450   type Parent MLBBoxScoreRunsByInningsXml = MLBBoxScoreTeamBreakdown
 451
 452
 453 instance FromXmlFk MLBBoxScoreRunsByInningsXml where
 454   -- | To convert an 'MLBBoxScoreRunsByInningsXml' to an
 455   --   'MLBBoxScoreRunsByInnings', we add the foreign key and copy
 456   --   everything else verbatim.
 457   --
 458   from_xml_fk = H.cons
 459
 460
 461 -- | This allows us to insert the XML representation
 462 --   'MLBBoxScoreRunsByInningsXml' directly.
 463 --
 464 instance XmlImportFk MLBBoxScoreRunsByInningsXml
 465
 466
 467
 468 -- | The type representing \<Misc_Pitching_Stats\> XML elements. It
 469 --   has no associated database type; the 'xml_wild_pitches' are
 470 --   stored directly in the 'MLBBoxScore', and the two linked tables
 471 --   are treated as children of the 'MLBBoxScore'.
 472 --
 473 data MLBBoxScoreMiscPitchingStatsXml =
 474   MLBBoxScoreMiscPitchingStatsXml {
 475     xml_wild_pitches :: Maybe Int,
 476     xml_intentional_walks :: [MLBBoxScoreMiscPitchingStatsIntentionalWalkXml],
 477     xml_hits_by_pitch :: [MLBBoxScoreMiscPitchingStatsHitByPitchXml] }
 478   deriving (Eq, GHC.Generic, Show)
 479
 480
 481 -- | For 'H.convert'.
 482 --
 483 instance H.HVector MLBBoxScoreMiscPitchingStatsXml
 484
 485
 486 -- * MLBBoxScoreMiscPitchingStatsIntentionalWalk
 487
 488 -- | Database representation of an intentional walk. The weird
 489 --   prefixes avoid collisions with the other batter/pitcher_ids, and
 490 --   still get mangled properly by Groundhog.
 491 --
 492 --   The leading underscores prevent unused field warnings.
 493 --
 494 data MLBBoxScoreMiscPitchingStatsIntentionalWalk =
 495   MLBBoxScoreMiscPitchingStatsIntentionalWalk {
 496     _dbiw_mlb_box_scores_id :: DefaultKey MLBBoxScore,
 497     _dbiw_batter_id :: Int,
 498     _dbiw_pitcher_id :: Int,
 499     _dbiw_number_of_times_walked :: Int }
 500   deriving ( GHC.Generic )
 501
 502
 503 -- | For 'H.cons' and 'H.convert'.
 504 --
 505 instance H.HVector MLBBoxScoreMiscPitchingStatsIntentionalWalk
 506
 507 -- | The leading underscores prevent unused field warnings.
 508 --
 509 data MLBBoxScoreMiscPitchingStatsIntentionalWalkXml =
 510   MLBBoxScoreMiscPitchingStatsIntentionalWalkXml {
 511     _xml_iw_batter_id :: Int,
 512     _xml_iw_pitcher_id :: Int,
 513     _xml_iw_number_of_times_walked :: Int }
 514   deriving (Eq, GHC.Generic, Show)
 515
 516 -- | For 'H.convert'.
 517 --
 518 instance H.HVector MLBBoxScoreMiscPitchingStatsIntentionalWalkXml
 519
 520
 521 instance ToDb MLBBoxScoreMiscPitchingStatsIntentionalWalkXml where
 522   -- | The database analogue of a
 523   -- 'MLBBoxScoreMiscPitchingStatsIntentionalWalkXml' is a
 524   -- 'MLBBoxScoreMiscPitchingStatsIntentionalWalk'.
 525   --
 526   type Db MLBBoxScoreMiscPitchingStatsIntentionalWalkXml =
 527     MLBBoxScoreMiscPitchingStatsIntentionalWalk
 528
 529
 530 instance Child MLBBoxScoreMiscPitchingStatsIntentionalWalkXml where
 531   -- | Each 'MLBBoxScoreMiscPitchingStatsIntentionalWalkXml' is
 532   --   contained in (i.e. has a foreign key to) a 'MLBBoxScore'.
 533   --
 534   type Parent MLBBoxScoreMiscPitchingStatsIntentionalWalkXml =
 535     MLBBoxScore
 536
 537
 538 instance FromXmlFk MLBBoxScoreMiscPitchingStatsIntentionalWalkXml where
 539   -- | To convert an 'MLBBoxScoreMiscPitchingStatsIntentionalWalkXml'
 540   --   to an 'MLBBoxScoreMiscPitchingStatsIntentionalWalk', we add the
 541   --   foreign key and copy everything else verbatim.
 542   --
 543   from_xml_fk = H.cons
 544
 545
 546 -- | This allows us to insert the XML representation
 547 --   'MLBBoxScoreMiscPitchingStatsIntentionalWalkXml' directly.
 548 --
 549 instance XmlImportFk MLBBoxScoreMiscPitchingStatsIntentionalWalkXml
 550
 551
 552
 553 -- * MLBBoxScoreMiscPitchingStatsHitByPitchXml
 554
 555 -- | The leading underscores prevent unused field warnings.
 556 --
 557 data MLBBoxScoreMiscPitchingStatsHitByPitch =
 558   MLBBoxScoreMiscPitchingStatsHitByPitch {
 559     _dbhbp_mlb_box_scores_id :: DefaultKey MLBBoxScore,
 560     _dbhbp_batter_id :: Int,
 561     _dbhbp_pitcher_id :: Int,
 562     _dbhbp_number_of_times_hit :: Int }
 563   deriving ( GHC.Generic )
 564
 565 -- | For 'H.cons' and 'H.convert'.
 566 --
 567 instance H.HVector MLBBoxScoreMiscPitchingStatsHitByPitch
 568
 569 instance ToDb MLBBoxScoreMiscPitchingStatsHitByPitchXml where
 570   -- | The database analogue of a
 571   -- 'MLBBoxScoreMiscPitchingStatsHitByPitchXml' is a
 572   -- 'MLBBoxScoreMiscPitchingStatsHitByPitch'.
 573   --
 574   type Db MLBBoxScoreMiscPitchingStatsHitByPitchXml =
 575     MLBBoxScoreMiscPitchingStatsHitByPitch
 576
 577
 578 instance Child MLBBoxScoreMiscPitchingStatsHitByPitchXml where
 579   -- | Each 'MLBBoxScoreMiscPitchingStatsHitByPitchXml' is
 580   --   contained in (i.e. has a foreign key to) a 'MLBBoxScore'.
 581   --
 582   type Parent MLBBoxScoreMiscPitchingStatsHitByPitchXml =
 583     MLBBoxScore
 584
 585
 586 instance FromXmlFk MLBBoxScoreMiscPitchingStatsHitByPitchXml where
 587   -- | To convert an 'MLBBoxScoreMiscPitchingStatsHitByPitchXml'
 588   --   to an 'MLBBoxScoreMiscPitchingStatsHitByPitch', we add the
 589   --   foreign key and copy everything else verbatim.
 590   --
 591   from_xml_fk = H.cons
 592
 593
 594 -- | This allows us to insert the XML representation
 595 --   'MLBBoxScoreMiscPitchingStatsHitByPitchXml' directly.
 596 --
 597 instance XmlImportFk MLBBoxScoreMiscPitchingStatsHitByPitchXml
 598
 599
 600 -- | The leading underscores prevent unused field warnings.
 601 --
 602 data MLBBoxScoreMiscPitchingStatsHitByPitchXml =
 603   MLBBoxScoreMiscPitchingStatsHitByPitchXml {
 604     _xml_hbp_batter_id :: Int,
 605     _xml_hbp_pitcher_id :: Int,
 606     _xml_hbp_number_of_times_hit :: Int }
 607   deriving (Eq, GHC.Generic, Show)
 608
 609
 610 -- | For 'H.convert'.
 611 --
 612 instance H.HVector MLBBoxScoreMiscPitchingStatsHitByPitchXml
 613
 614
 615 --
 616 -- * Database
 617 --
 618
 619 instance DbImport Message where
 620   dbmigrate _ =
 621     run_dbmigrate $ do
 622       migrate (undefined :: MLBBoxScore)
 623
 624   -- | We insert the message.
 625   dbimport m = do
 626     -- First, get the vteam/hteam out of the XML message.
 627     let vteam = Team (xml_vteam_id m) Nothing (Just $ xml_vteam m)
 628     let hteam = Team (xml_hteam_id m) Nothing (Just $ xml_hteam m)
 629
 630     -- Insert them...
 631     vteam_fk <- insert vteam
 632     hteam_fk <- insert hteam
 633
 634     -- Now we can key the message to the teams/breakdowns we just
 635     -- inserted.
 636     let db_msg = from_xml_fk_teams undefined vteam_fk hteam_fk m
 637     msg_id <- insert db_msg
 638
 639     -- Next, the vteam/hteam breakdowns, also needed to construct the
 640     -- main message record
 641     let vteam_bd = xml_away_team $ xml_game_breakdown m
 642     let hteam_bd = xml_home_team $ xml_game_breakdown m
 643
 644     vteam_bd_fk <- insert_xml vteam_bd
 645     hteam_bd_fk <- insert_xml hteam_bd
 646
 647     -- Insert the runs-by-innings associated with the vteam/hteam
 648     -- breakdowns.
 649     forM_ (xml_runs_by_innings vteam_bd) $ insert_xml_fk_ vteam_bd_fk
 650     forM_ (xml_runs_by_innings hteam_bd) $ insert_xml_fk_ hteam_bd_fk
 651
 652     -- Now the join table record that ties the message to its two team
 653     -- breakdowns.
 654     let msg__breakdown = MLBBoxScore_MLBBoxScoreTeamBreakdown
 655                            msg_id
 656                            vteam_bd_fk
 657                            hteam_bd_fk
 658
 659     insert_ msg__breakdown
 660
 661     -- Now insert the homerun stats listings, keyed to the message.
 662     -- They need not be present, but we're going to loop through them
 663     -- all anyway, so if we have 'Nothing', we convert that to an
 664     -- empty list instead. This simplifies the `forM_` code.
 665     let listings = fromMaybe [] (xml_homerun_stats_listings m)
 666     forM_ listings $ \listing -> do
 667       -- Insert the listing itself.
 668       listing_id <- insert_xml_fk msg_id listing
 669       -- And all of its pitchers
 670       forM_ (xml_pitchers listing) $ insert_xml_fk listing_id
 671
 672     -- We have two tables of pitching stats that need to be keyed to
 673     -- the message, too.
 674     let iws = xml_intentional_walks (xml_misc_pitching_stats m)
 675     forM_ iws $ insert_xml_fk_ msg_id
 676
 677     let hbps = xml_hits_by_pitch (xml_misc_pitching_stats m)
 678     forM_ hbps $ insert_xml_fk_ msg_id
 679
 680     return ImportSucceeded
 681
 682
 683
 684 mkPersist tsn_codegen_config [groundhog|
 685 - entity: MLBBoxScore
 686   dbName: mlb_box_scores
 687   constructors:
 688     - name: MLBBoxScore
 689       uniques:
 690         - name: unique_mlb_box_scores
 691           type: constraint
 692           # Prevent multiple imports of the same message.
 693           fields: [db_xml_file_id]
 694
 695
 696
 697 - entity: MLBBoxScoreMiscPitchingStatsIntentionalWalk
 698   dbName: mlb_box_scores_misc_pitching_stats_intentional_walks
 699   constructors:
 700     - name: MLBBoxScoreMiscPitchingStatsIntentionalWalk
 701       fields:
 702         - name: _dbiw_mlb_box_scores_id
 703           reference:
 704             onDelete: cascade
 705
 706
 707 - entity: MLBBoxScoreMiscPitchingStatsHitByPitch
 708   dbName: mlb_box_scores_misc_pitching_stats_hits_by_pitch
 709   constructors:
 710     - name: MLBBoxScoreMiscPitchingStatsHitByPitch
 711       fields:
 712         - name: _dbhbp_mlb_box_scores_id
 713           reference:
 714             onDelete: cascade
 715
 716
 717 - embedded: MLBBoxScoreHomerunStatsListingBatter
 718   fields:
 719     - name: _db_batter_first_name
 720       dbName: batter_first_name
 721     - name: _db_batter_last_name
 722       dbName: batter_last_name
 723     - name: _db_batter_rbis
 724       dbName: batter_rbis
 725     - name: _db_batter_id
 726       dbName: batter_id
 727
 728 - entity: MLBBoxScoreHomerunStatsListing
 729   dbName: mlb_box_score_homerun_stats_listings
 730   constructors:
 731     - name: MLBBoxScoreHomerunStatsListing
 732       fields:
 733         - name: db_batter
 734           embeddedType:
 735             - {name: batter_first_name, dbName: batter_first_name}
 736             - {name: batter_last_name, dbName: batter_last_name}
 737             - {name: batter_rbis, dbName: batter_rbis}
 738             - {name: batter_id, dbName: batter_id}
 739
 740 - entity: MLBBoxScoreHomerunStatsListingPitcher
 741   dbName: mlb_box_score_homerun_stats_listing_pitchers
 742   constructors:
 743     - name: MLBBoxScoreHomerunStatsListingPitcher
 744       fields:
 745         - name: _db_mlb_box_score_homerun_stats_listings_id
 746           reference:
 747             onDelete: cascade
 748
 749 - entity: MLBBoxScoreTeamBreakdown
 750   dbName: mlb_box_scores_team_breakdowns
 751   constructors:
 752     - name: MLBBoxScoreTeamBreakdown
 753
 754 - entity: MLBBoxScoreRunsByInnings
 755   dbName: mlb_box_scores_team_breakdowns_runs_by_innings
 756   constructors:
 757     - name: MLBBoxScoreRunsByInnings
 758       fields:
 759         - name: _db_mlb_box_scores_team_breakdowns_id
 760           reference:
 761             onDelete: cascade
 762
 763
 764 - entity: MLBBoxScore_MLBBoxScoreTeamBreakdown
 765   dbName: mlb_box_scores__mlb_box_scores_team_breakdowns
 766   constructors:
 767     - name: MLBBoxScore_MLBBoxScoreTeamBreakdown
 768       fields:
 769         - name: mLBBoxScore_MLBBoxScoreTeamBreakdown0
 770           dbName: mlb_box_scores_id
 771           reference:
 772             onDelete: cascade
 773         - name: mLBBoxScore_MLBBoxScoreTeamBreakdown1
 774           dbName: mlb_box_scores_team_breakdowns_away_team_id
 775           reference:
 776             onDelete: cascade
 777         - name: mLBBoxScore_MLBBoxScoreTeamBreakdown2
 778           dbName: db_mlb_box_scores_team_breakdowns_home_team_id
 779           reference:
 780             onDelete: cascade
 781 |]
 782
 783
 784
 785 --
 786 -- * Pickling
 787 --
 788
 789 pickle_message :: PU Message
 790 pickle_message =
 791   xpElem "message" $
 792     xpWrap (from_tuple, H.convert) $
 793       xp23Tuple (xpElem "XML_File_ID" xpInt)
 794                 (xpElem "heading" xpText)
 795                 (xpElem "category" xpText)
 796                 (xpElem "sport" xpText)
 797                 (xpElem "game_id" xpInt)
 798                 (xpElem "schedule_id" xpInt)
 799                 (xpElem "vteam" xpText)
 800                 (xpElem "hteam" xpText)
 801                 (xpElem "vteam_id" xpText)
 802                 (xpElem "hteam_id" xpText)
 803                 (xpElem "Season" xpText)
 804                 (xpElem "SeasonType" xpText)
 805                 (xpElem "title" xpText)
 806                 (xpElem "Game_Date" xp_date)
 807                 (xpElem "Game_Time" xp_time)
 808                 (xpElem "GameNumber" xpInt)
 809                 (xpElem "Capacity" xpInt)
 810                 pickle_game_breakdown
 811                 (xpList pickle_team_summary)
 812                 pickle_misc_pitching_stats
 813                 (xpOption pickle_homerun_stats_listings)
 814                 pickle_miscellaneous_game_info
 815                 (xpElem "time_stamp" xp_time_stamp)
 816   where
 817     from_tuple = uncurryN Message
 818
 819
 820 pickle_team_summary :: PU MLBBoxScoreTeamSummaryXml
 821 pickle_team_summary =
 822   xpElem "Team_Summary" $ xpWrap (from_tuple, to_tuple') $ xpUnit
 823   where
 824     from_tuple _ = MLBBoxScoreTeamSummaryXml
 825     to_tuple'   _ = ()
 826
 827 pickle_game_breakdown :: PU MLBBoxScoreGameBreakdownXml
 828 pickle_game_breakdown =
 829   xpElem "Game_Breakdown" $
 830     xpWrap (from_tuple, H.convert) $
 831       xpPair pickle_away_team
 832              pickle_home_team
 833   where
 834     from_tuple = uncurry MLBBoxScoreGameBreakdownXml
 835
 836
 837 pickle_runs_by_innings :: PU MLBBoxScoreRunsByInningsXml
 838 pickle_runs_by_innings =
 839   xpElem "Runs_By_Innings" $
 840     xpWrap (from_tuple, H.convert) $
 841       xpPair (xpAttr "Inning" xpInt)
 842              xpInt
 843   where
 844     from_tuple = uncurry MLBBoxScoreRunsByInningsXml
 845
 846
 847 pickle_team :: PU MLBBoxScoreTeamBreakdownXml
 848 pickle_team =
 849   xpWrap (from_tuple, H.convert) $
 850     xp4Tuple (xpList pickle_runs_by_innings)
 851              (xpElem "Runs" xpInt)
 852              (xpElem "Hits" xpInt)
 853              (xpElem "Errors" xpInt)
 854   where
 855     from_tuple = uncurryN MLBBoxScoreTeamBreakdownXml
 856
 857
 858 pickle_away_team :: PU MLBBoxScoreTeamBreakdownXml
 859 pickle_away_team =
 860   xpElem "AwayTeam" pickle_team
 861
 862 pickle_home_team :: PU MLBBoxScoreTeamBreakdownXml
 863 pickle_home_team =
 864   xpElem "HomeTeam" pickle_team
 865
 866
 867 pickle_batter :: PU MLBBoxScoreHomerunStatsListingBatter
 868 pickle_batter =
 869   xpElem "HRS_Batter_ID" $
 870     xpWrap (from_tuple, H.convert) $
 871     xp4Tuple (xpAttr "HRS_Batter_FirstName" $ xpText)
 872              (xpAttr "HRS_Batter_LastName" $ xpText)
 873              (xpAttr "RBIs" $ xpInt)
 874              xpInt
 875   where
 876     from_tuple = uncurryN MLBBoxScoreHomerunStatsListingBatter
 877
 878
 879 pickle_pitcher :: PU MLBBoxScoreHomerunStatsListingPitcherXml
 880 pickle_pitcher =
 881   xpElem "HRS_Pitcher_ID" $
 882     xpWrap (from_tuple, H.convert) $
 883     xp4Tuple (xpAttr "HRS_Homeruns_Off_Pitcher" $ xpInt)
 884              (xpAttr "HRS_Pitcher_FirstName" $ xpText)
 885              (xpAttr "HRS_Pitcher_LastName" $ xpText)
 886              xpInt
 887   where
 888     from_tuple = uncurryN MLBBoxScoreHomerunStatsListingPitcherXml
 889
 890
 891 pickle_homerun_stats_listing :: PU MLBBoxScoreHomerunStatsListingXml
 892 pickle_homerun_stats_listing =
 893   xpElem "HRS_Listing" $
 894     xpWrap (from_tuple, H.convert) $
 895     xpTriple pickle_batter
 896              (xpElem "Season_Homeruns" xpInt)
 897              (xpList pickle_pitcher)
 898   where
 899     from_tuple = uncurryN MLBBoxScoreHomerunStatsListingXml
 900
 901
 902 pickle_homerun_stats_listings :: PU [MLBBoxScoreHomerunStatsListingXml]
 903 pickle_homerun_stats_listings =
 904   xpElem "Homerun_Stats" $ xpList pickle_homerun_stats_listing
 905
 906
 907 pickle_misc_pitching_stats :: PU MLBBoxScoreMiscPitchingStatsXml
 908 pickle_misc_pitching_stats =
 909   xpElem "Misc_Pitching_Stats" $
 910     xpWrap (from_tuple, H.convert) $
 911       xpTriple (xpOption $ xpElem "Wild_Pitches" xpInt)
 912                pickle_intentional_walks
 913                pickle_hits_by_pitch
 914   where
 915     from_tuple = uncurryN MLBBoxScoreMiscPitchingStatsXml
 916
 917
 918
 919 pickle_intentional_walks :: PU [MLBBoxScoreMiscPitchingStatsIntentionalWalkXml]
 920 pickle_intentional_walks =
 921   xpElem "Intentional_Walks" $ xpList $ xpElem "IW_Listing" $
 922     xpWrap (from_tuple, H.convert) $
 923       xpTriple (xpElem "IW_Batter_ID" xpInt)
 924                (xpElem "IW_Pitcher_ID" xpInt)
 925                (xpElem "IW_Number_Of_Times_Walked" xpInt)
 926   where
 927     from_tuple = uncurryN MLBBoxScoreMiscPitchingStatsIntentionalWalkXml
 928
 929
 930
 931 pickle_hits_by_pitch :: PU [MLBBoxScoreMiscPitchingStatsHitByPitchXml]
 932 pickle_hits_by_pitch =
 933   xpElem "Hit_By_Pitch" $ xpList $ xpElem "HBP_Listing" $
 934     xpWrap (from_tuple, H.convert) $
 935       xpTriple (xpElem "HBP_Batter_ID" xpInt)
 936                (xpElem "HBP_Pitcher_ID" xpInt)
 937                (xpElem "HBP_Number_Of_Times_Hit" xpInt)
 938   where
 939     from_tuple = uncurryN MLBBoxScoreMiscPitchingStatsHitByPitchXml
 940
 941
 942
 943 pickle_miscellaneous_game_info :: PU MLBBoxScoreMiscellaneousGameInfoXml
 944 pickle_miscellaneous_game_info =
 945   xpElem "Miscelaneous_Game_Info" $ xpWrap (from_tuple, to_tuple') $ xpUnit
 946   where
 947     from_tuple _ = MLBBoxScoreMiscellaneousGameInfoXml
 948     to_tuple'  _ = ()