]> gitweb.michael.orlitzky.com - dead/htsn-import.git/blobdiff - src/TSN/XML/MLBBoxScore.hs
Migrate TSN.Team and TSN.XML.MLBBoxScore to fixed-vector-hetero.
[dead/htsn-import.git] / src / TSN / XML / MLBBoxScore.hs
index 8a15a883e07910b12f66125e034563e2d14e2689..68891d30e555773c7a667bc9d77bea2f24bb5883 100644 (file)
@@ -20,7 +20,8 @@ module TSN.XML.MLBBoxScore (
   MLBBoxScoreHomerunStatsListingConstructor(..),
   MLBBoxScoreHomerunStatsListingPitcherConstructor(..),
   MLBBoxScoreMiscellaneousGameInfo(..),
-  MLBBoxScoreMiscPitchingStats(..), -- can go eventually
+  MLBBoxScoreMiscPitchingStatsHitByPitchConstructor(..),
+  MLBBoxScoreMiscPitchingStatsIntentionalWalkConstructor(..),
   MLBBoxScoreRunsByInningsConstructor(..),
   MLBBoxScoreTeamBreakdownConstructor(..),
   MLBBoxScoreTeamSummary(..) -- can go eventually
@@ -33,6 +34,7 @@ import Data.Data ( Data )
 import Data.Maybe ( fromMaybe )
 import Data.Time ( UTCTime(..) )
 import Data.Tuple.Curry ( uncurryN )
+import qualified Data.Vector.HFixed as H ( HVector, convert )
 import Data.Typeable ( Typeable )
 import Database.Groundhog (
   insert,
@@ -59,7 +61,6 @@ import Text.XML.HXT.Core (
   xpWrap )
 
 -- Local imports.
-import Generics ( Generic(..), to_tuple )
 import TSN.Codegen ( tsn_codegen_config )
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
 import TSN.Picklers (
@@ -107,6 +108,7 @@ data MLBBoxScore =
     db_game_time :: UTCTime,
     db_game_number :: Int,
     db_capacity :: Int,
+    db_wild_pitches :: Maybe Int, -- From misc pitching stats
     db_title :: String,
     db_time_stamp :: UTCTime }
 
@@ -146,9 +148,9 @@ data Message =
   deriving (Eq, GHC.Generic, Show)
 
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
 --
-instance Generic Message
+instance H.HVector Message
 
 instance ToDb Message where
   -- | The database analogue of a 'Message' is a 'MLBBoxScore'.
@@ -187,6 +189,7 @@ instance FromXmlFkTeams Message where
       db_game_time = make_game_time,
       db_game_number = xml_game_number,
       db_capacity = xml_capacity,
+      db_wild_pitches = xml_wild_pitches xml_misc_pitching_stats,
       db_title = xml_title,
       db_time_stamp = xml_time_stamp }
     where
@@ -203,9 +206,9 @@ data MLBBoxScoreGameBreakdownXml =
     xml_home_team :: MLBBoxScoreTeamBreakdownXml }
   deriving (Eq, GHC.Generic, Show)
 
--- | For 'Generics.to_tuple'
+-- | For 'H.convert'
 --
-instance Generic MLBBoxScoreGameBreakdownXml
+instance H.HVector MLBBoxScoreGameBreakdownXml
 
 
 data MLBBoxScoreHomerunStatsListingBatter =
@@ -216,9 +219,9 @@ data MLBBoxScoreHomerunStatsListingBatter =
     db_batter_id :: Int }
   deriving (Data, Eq, GHC.Generic, Show, Typeable)
 
--- | For 'Generics.to_tuple'
+-- | For 'H.convert'
 --
-instance Generic MLBBoxScoreHomerunStatsListingBatter
+instance H.HVector MLBBoxScoreHomerunStatsListingBatter
 
 
 data MLBBoxScoreHomerunStatsListing =
@@ -234,9 +237,9 @@ data MLBBoxScoreHomerunStatsListingXml =
     xml_pitchers :: [MLBBoxScoreHomerunStatsListingPitcherXml] }
   deriving (Eq, GHC.Generic, Show)
 
--- | For 'Generics.to_tuple'
+-- | For 'H.convert'
 --
-instance Generic MLBBoxScoreHomerunStatsListingXml
+instance H.HVector MLBBoxScoreHomerunStatsListingXml
 
 instance Child MLBBoxScoreHomerunStatsListingXml where
   -- | Each 'MLBBoxScoreHomerunStatsListingXml' is contained in (i.e. has a
@@ -287,9 +290,9 @@ data MLBBoxScoreHomerunStatsListingPitcherXml =
     xml_pitchers_pitcher_id :: Int }
   deriving (Eq, GHC.Generic, Show)
 
--- | For 'Generics.to_tuple'
+-- | For 'H.convert'
 --
-instance Generic MLBBoxScoreHomerunStatsListingPitcherXml
+instance H.HVector MLBBoxScoreHomerunStatsListingPitcherXml
 
 instance Child MLBBoxScoreHomerunStatsListingPitcherXml where
   -- | Each 'MLBBoxScoreHomerunStatsListingPitcherXml' is contained in
@@ -348,8 +351,8 @@ data MLBBoxScoreTeamBreakdownXml =
   deriving (Eq, GHC.Generic, Show)
 
 
--- | For 'Generics.to_tuple'.
-instance Generic MLBBoxScoreTeamBreakdownXml
+-- | For 'H.convert'.
+instance H.HVector MLBBoxScoreTeamBreakdownXml
 
 instance ToDb MLBBoxScoreTeamBreakdownXml where
   -- | The database analogue of a 'MLBBoxScoreTeamBreakdownXml' is
@@ -403,9 +406,9 @@ data MLBBoxScore_MLBBoxScoreTeamBreakdown =
 
 
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
 --
-instance Generic MLBBoxScoreRunsByInningsXml
+instance H.HVector MLBBoxScoreRunsByInningsXml
 
 
 instance ToDb MLBBoxScoreRunsByInningsXml where
@@ -441,8 +444,11 @@ instance XmlImportFk MLBBoxScoreRunsByInningsXml
 
 
 
-
-data MLBBoxScoreMiscPitchingStats = MLBBoxScoreMiscPitchingStats
+-- | The type representing \<Misc_Pitching_Stats\> XML elements. It
+--   has no associated database type; the 'xml_wild_pitches' are
+--   stored directly in the 'MLBBoxScore', and the two linked tables
+--   are treated as children of the 'MLBBoxScore'.
+--
 data MLBBoxScoreMiscPitchingStatsXml =
   MLBBoxScoreMiscPitchingStatsXml {
     xml_wild_pitches :: Maybe Int,
@@ -451,8 +457,23 @@ data MLBBoxScoreMiscPitchingStatsXml =
   deriving (Eq, GHC.Generic, Show)
 
 
--- | For 'Generics.to_tuple'.
-instance Generic MLBBoxScoreMiscPitchingStatsXml
+-- | For 'H.convert'.
+--
+instance H.HVector MLBBoxScoreMiscPitchingStatsXml
+
+
+-- * MLBBoxScoreMiscPitchingStatsIntentionalWalk
+
+-- | Database representation of an intentional walk. The weird
+--   prefixes avoid collisiont with the other batter/pitcher_ids, and
+--   still get mangled properly by Groundhog.
+--
+data MLBBoxScoreMiscPitchingStatsIntentionalWalk =
+  MLBBoxScoreMiscPitchingStatsIntentionalWalk {
+    dbiw_mlb_box_scores_id :: DefaultKey MLBBoxScore,
+    dbiw_batter_id :: Int,
+    dbiw_pitcher_id :: Int,
+    dbiw_number_of_times_walked :: Int }
 
 
 data MLBBoxScoreMiscPitchingStatsIntentionalWalkXml =
@@ -462,9 +483,92 @@ data MLBBoxScoreMiscPitchingStatsIntentionalWalkXml =
     xml_iw_number_of_times_walked :: Int }
   deriving (Eq, GHC.Generic, Show)
 
+-- | For 'H.convert'.
+--
+instance H.HVector MLBBoxScoreMiscPitchingStatsIntentionalWalkXml
+
+
+instance ToDb MLBBoxScoreMiscPitchingStatsIntentionalWalkXml where
+  -- | The database analogue of a
+  -- 'MLBBoxScoreMiscPitchingStatsIntentionalWalkXml' is a
+  -- 'MLBBoxScoreMiscPitchingStatsIntentionalWalk'.
+  --
+  type Db MLBBoxScoreMiscPitchingStatsIntentionalWalkXml =
+    MLBBoxScoreMiscPitchingStatsIntentionalWalk
+
+
+instance Child MLBBoxScoreMiscPitchingStatsIntentionalWalkXml where
+  -- | Each 'MLBBoxScoreMiscPitchingStatsIntentionalWalkXml' is
+  --   contained in (i.e. has a foreign key to) a 'MLBBoxScore'.
+  --
+  type Parent MLBBoxScoreMiscPitchingStatsIntentionalWalkXml =
+    MLBBoxScore
+
+
+instance FromXmlFk MLBBoxScoreMiscPitchingStatsIntentionalWalkXml where
+  -- | To convert an 'MLBBoxScoreMiscPitchingStatsIntentionalWalkXml'
+  --   to an 'MLBBoxScoreMiscPitchingStatsIntentionalWalk', we add the
+  --   foreign key and copy everything else verbatim.
+  --
+  from_xml_fk fk MLBBoxScoreMiscPitchingStatsIntentionalWalkXml{..} =
+    MLBBoxScoreMiscPitchingStatsIntentionalWalk {
+    dbiw_mlb_box_scores_id = fk,
+    dbiw_batter_id = xml_iw_batter_id,
+    dbiw_pitcher_id = xml_iw_pitcher_id,
+    dbiw_number_of_times_walked = xml_iw_number_of_times_walked }
+
+
+-- | This allows us to insert the XML representation
+--   'MLBBoxScoreMiscPitchingStatsIntentionalWalkXml' directly.
+--
+instance XmlImportFk MLBBoxScoreMiscPitchingStatsIntentionalWalkXml
+
+
+
+-- * MLBBoxScoreMiscPitchingStatsHitByPitchXml
+
+data MLBBoxScoreMiscPitchingStatsHitByPitch =
+  MLBBoxScoreMiscPitchingStatsHitByPitch {
+    dbhbp_mlb_box_scores_id :: DefaultKey MLBBoxScore,
+    dbhbp_batter_id :: Int,
+    dbhbp_pitcher_id :: Int,
+    dbhbp_number_of_times_hit :: Int }
+
 
--- | For 'Generics.to_tuple'.
-instance Generic MLBBoxScoreMiscPitchingStatsIntentionalWalkXml
+instance ToDb MLBBoxScoreMiscPitchingStatsHitByPitchXml where
+  -- | The database analogue of a
+  -- 'MLBBoxScoreMiscPitchingStatsHitByPitchXml' is a
+  -- 'MLBBoxScoreMiscPitchingStatsHitByPitch'.
+  --
+  type Db MLBBoxScoreMiscPitchingStatsHitByPitchXml =
+    MLBBoxScoreMiscPitchingStatsHitByPitch
+
+
+instance Child MLBBoxScoreMiscPitchingStatsHitByPitchXml where
+  -- | Each 'MLBBoxScoreMiscPitchingStatsHitByPitchXml' is
+  --   contained in (i.e. has a foreign key to) a 'MLBBoxScore'.
+  --
+  type Parent MLBBoxScoreMiscPitchingStatsHitByPitchXml =
+    MLBBoxScore
+
+
+instance FromXmlFk MLBBoxScoreMiscPitchingStatsHitByPitchXml where
+  -- | To convert an 'MLBBoxScoreMiscPitchingStatsHitByPitchXml'
+  --   to an 'MLBBoxScoreMiscPitchingStatsHitByPitch', we add the
+  --   foreign key and copy everything else verbatim.
+  --
+  from_xml_fk fk MLBBoxScoreMiscPitchingStatsHitByPitchXml{..} =
+    MLBBoxScoreMiscPitchingStatsHitByPitch {
+    dbhbp_mlb_box_scores_id = fk,
+    dbhbp_batter_id = xml_hbp_batter_id,
+    dbhbp_pitcher_id = xml_hbp_pitcher_id,
+    dbhbp_number_of_times_hit = xml_hbp_number_of_times_hit }
+
+
+-- | This allows us to insert the XML representation
+--   'MLBBoxScoreMiscPitchingStatsHitByPitchXml' directly.
+--
+instance XmlImportFk MLBBoxScoreMiscPitchingStatsHitByPitchXml
 
 
 data MLBBoxScoreMiscPitchingStatsHitByPitchXml =
@@ -475,9 +579,9 @@ data MLBBoxScoreMiscPitchingStatsHitByPitchXml =
   deriving (Eq, GHC.Generic, Show)
 
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
 --
-instance Generic MLBBoxScoreMiscPitchingStatsHitByPitchXml
+instance H.HVector MLBBoxScoreMiscPitchingStatsHitByPitchXml
 
 
 --
@@ -537,6 +641,14 @@ instance DbImport Message where
       -- And all of its pitchers
       forM_ (xml_pitchers listing) $ insert_xml_fk listing_id
 
+    -- We have two tables of pitching stats that need to be keyed to
+    -- the message, too.
+    let iws = xml_intentional_walks (xml_misc_pitching_stats m)
+    forM_ iws $ insert_xml_fk_ msg_id
+
+    let hbps = xml_hits_by_pitch (xml_misc_pitching_stats m)
+    forM_ hbps $ insert_xml_fk_ msg_id
+
     return ImportSucceeded
 
 
@@ -553,6 +665,27 @@ mkPersist tsn_codegen_config [groundhog|
           fields: [db_xml_file_id]
 
 
+
+- entity: MLBBoxScoreMiscPitchingStatsIntentionalWalk
+  dbName: mlb_box_scores_misc_pitching_stats_intentional_walks
+  constructors:
+    - name: MLBBoxScoreMiscPitchingStatsIntentionalWalk
+      fields:
+        - name: dbiw_mlb_box_scores_id
+          reference:
+            onDelete: cascade
+
+
+- entity: MLBBoxScoreMiscPitchingStatsHitByPitch
+  dbName: mlb_box_scores_misc_pitching_stats_hits_by_pitch
+  constructors:
+    - name: MLBBoxScoreMiscPitchingStatsHitByPitch
+      fields:
+        - name: dbhbp_mlb_box_scores_id
+          reference:
+            onDelete: cascade
+
+
 - embedded: MLBBoxScoreHomerunStatsListingBatter
   fields:
     - name: db_batter_first_name
@@ -628,7 +761,7 @@ mkPersist tsn_codegen_config [groundhog|
 pickle_message :: PU Message
 pickle_message =
   xpElem "message" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
       xp23Tuple (xpElem "XML_File_ID" xpInt)
                 (xpElem "heading" xpText)
                 (xpElem "category" xpText)
@@ -666,7 +799,7 @@ pickle_team_summary =
 pickle_game_breakdown :: PU MLBBoxScoreGameBreakdownXml
 pickle_game_breakdown =
   xpElem "Game_Breakdown" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
       xpPair pickle_away_team
              pickle_home_team
   where
@@ -676,7 +809,7 @@ pickle_game_breakdown =
 pickle_runs_by_innings :: PU MLBBoxScoreRunsByInningsXml
 pickle_runs_by_innings =
   xpElem "Runs_By_Innings" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
       xpPair (xpAttr "Inning" xpInt)
              xpInt
   where
@@ -685,7 +818,7 @@ pickle_runs_by_innings =
 
 pickle_team :: PU MLBBoxScoreTeamBreakdownXml
 pickle_team =
-  xpWrap (from_tuple, to_tuple) $
+  xpWrap (from_tuple, H.convert) $
     xp4Tuple (xpList pickle_runs_by_innings)
              (xpElem "Runs" xpInt)
              (xpElem "Hits" xpInt)
@@ -706,7 +839,7 @@ pickle_home_team =
 pickle_batter :: PU MLBBoxScoreHomerunStatsListingBatter
 pickle_batter =
   xpElem "HRS_Batter_ID" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
     xp4Tuple (xpAttr "HRS_Batter_FirstName" $ xpText)
              (xpAttr "HRS_Batter_LastName" $ xpText)
              (xpAttr "RBIs" $ xpInt)
@@ -718,7 +851,7 @@ pickle_batter =
 pickle_pitcher :: PU MLBBoxScoreHomerunStatsListingPitcherXml
 pickle_pitcher =
   xpElem "HRS_Pitcher_ID" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
     xp4Tuple (xpAttr "HRS_Homeruns_Off_Pitcher" $ xpInt)
              (xpAttr "HRS_Pitcher_FirstName" $ xpText)
              (xpAttr "HRS_Pitcher_LastName" $ xpText)
@@ -730,7 +863,7 @@ pickle_pitcher =
 pickle_homerun_stats_listing :: PU MLBBoxScoreHomerunStatsListingXml
 pickle_homerun_stats_listing =
   xpElem "HRS_Listing" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
     xpTriple pickle_batter
              (xpElem "Season_Homeruns" xpInt)
              (xpList pickle_pitcher)
@@ -746,7 +879,7 @@ pickle_homerun_stats_listings =
 pickle_misc_pitching_stats :: PU MLBBoxScoreMiscPitchingStatsXml
 pickle_misc_pitching_stats =
   xpElem "Misc_Pitching_Stats" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
       xpTriple (xpOption $ xpElem "Wild_Pitches" xpInt)
                pickle_intentional_walks
                pickle_hits_by_pitch
@@ -758,7 +891,7 @@ pickle_misc_pitching_stats =
 pickle_intentional_walks :: PU [MLBBoxScoreMiscPitchingStatsIntentionalWalkXml]
 pickle_intentional_walks =
   xpElem "Intentional_Walks" $ xpList $ xpElem "IW_Listing" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
       xpTriple (xpElem "IW_Batter_ID" xpInt)
                (xpElem "IW_Pitcher_ID" xpInt)
                (xpElem "IW_Number_Of_Times_Walked" xpInt)
@@ -770,7 +903,7 @@ pickle_intentional_walks =
 pickle_hits_by_pitch :: PU [MLBBoxScoreMiscPitchingStatsHitByPitchXml]
 pickle_hits_by_pitch =
   xpElem "Hit_By_Pitch" $ xpList $ xpElem "HBP_Listing" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
       xpTriple (xpElem "HBP_Batter_ID" xpInt)
                (xpElem "HBP_Pitcher_ID" xpInt)
                (xpElem "HBP_Number_Of_Times_Hit" xpInt)