{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE QuasiQuotes #-}
-- * WARNING: these are private but exported to silence warnings
MLBBoxScore_MLBBoxScoreTeamBreakdownConstructor(..),
MLBBoxScoreConstructor(..),
- MLBBoxScoreHomerunStats(..),
+ MLBBoxScoreHomerunStatsListingConstructor(..),
+ MLBBoxScoreHomerunStatsListingPitcherConstructor(..),
MLBBoxScoreMiscellaneousGameInfo(..),
- MLBBoxScoreMiscPitchingStats(..),
+ MLBBoxScoreMiscPitchingStats(..), -- can go eventually
MLBBoxScoreRunsByInningsConstructor(..),
MLBBoxScoreTeamBreakdownConstructor(..),
- MLBBoxScoreTeamSummary(..)
- )
--- AutoRacingResultsListingConstructor(..),
--- AutoRacingResultsRaceInformationConstructor(..) )
+ MLBBoxScoreTeamSummary(..) -- can go eventually
+ )
where
-- System imports.
import Control.Monad ( forM_ )
+import Data.Data ( Data )
+import Data.Maybe ( fromMaybe )
import Data.Time ( UTCTime(..) )
import Data.Tuple.Curry ( uncurryN )
+import Data.Typeable ( Typeable )
import Database.Groundhog (
insert,
insert_,
xml_game_breakdown :: MLBBoxScoreGameBreakdownXml,
xml_team_summaries :: [MLBBoxScoreTeamSummaryXml],
xml_misc_pitching_stats :: MLBBoxScoreMiscPitchingStatsXml,
- xml_homerun_stats :: Maybe MLBBoxScoreHomerunStatsXml,
+ xml_homerun_stats_listings :: Maybe [MLBBoxScoreHomerunStatsListingXml],
xml_miscellaneous_game_info :: MLBBoxScoreMiscellaneousGameInfoXml,
xml_time_stamp :: UTCTime }
deriving (Eq, GHC.Generic, Show)
instance Generic MLBBoxScoreGameBreakdownXml
-data MLBBoxScoreHomerunStats = MLBBoxScoreHomerunStats
-data MLBBoxScoreHomerunStatsXml = MLBBoxScoreHomerunStatsXml
- deriving (Eq, Show)
+data MLBBoxScoreHomerunStatsListingBatter =
+ MLBBoxScoreHomerunStatsListingBatter {
+ db_batter_first_name :: String,
+ db_batter_last_name :: String,
+ db_batter_rbis :: Int,
+ db_batter_id :: Int }
+ deriving (Data, Eq, GHC.Generic, Show, Typeable)
+
+-- | For 'Generics.to_tuple'
+--
+instance Generic MLBBoxScoreHomerunStatsListingBatter
+
+
+data MLBBoxScoreHomerunStatsListing =
+ MLBBoxScoreHomerunStatsListing {
+ db_mlb_box_scores_id :: DefaultKey MLBBoxScore,
+ db_batter :: MLBBoxScoreHomerunStatsListingBatter, -- embedded
+ db_season_homeruns :: Int }
+
+data MLBBoxScoreHomerunStatsListingXml =
+ MLBBoxScoreHomerunStatsListingXml {
+ xml_batter :: MLBBoxScoreHomerunStatsListingBatter,
+ xml_season_homeruns :: Int,
+ xml_pitchers :: [MLBBoxScoreHomerunStatsListingPitcherXml] }
+ deriving (Eq, GHC.Generic, Show)
+
+-- | For 'Generics.to_tuple'
+--
+instance Generic MLBBoxScoreHomerunStatsListingXml
+
+instance Child MLBBoxScoreHomerunStatsListingXml where
+ -- | Each 'MLBBoxScoreHomerunStatsListingXml' is contained in (i.e. has a
+ -- foreign key to) a 'MLBBoxScore'.
+ --
+ type Parent MLBBoxScoreHomerunStatsListingXml = MLBBoxScore
+
+
+instance ToDb MLBBoxScoreHomerunStatsListingXml where
+ -- | The database representation of
+ -- 'MLBBoxScoreHomerunStatsListingXml' is
+ -- 'MLBBoxScoreHomerunStatsListing'.
+ --
+ type Db MLBBoxScoreHomerunStatsListingXml = MLBBoxScoreHomerunStatsListing
+
+instance FromXmlFk MLBBoxScoreHomerunStatsListingXml where
+ -- | To convert an 'MLBBoxScoreHomerunStatsListingXml' to an
+ -- 'MLBBoxScoreHomerunStatsListing', we add the foreign key and
+ -- drop the pitchers.
+ --
+ from_xml_fk fk MLBBoxScoreHomerunStatsListingXml{..} =
+ MLBBoxScoreHomerunStatsListing {
+ db_mlb_box_scores_id = fk,
+ db_batter = xml_batter,
+ db_season_homeruns = xml_season_homeruns }
+
+
+-- | This allows us to insert the XML representation
+-- 'MLBBoxScoreHomerunStatsListingXml' directly.
+--
+instance XmlImportFk MLBBoxScoreHomerunStatsListingXml
+
+
+data MLBBoxScoreHomerunStatsListingPitcher =
+ MLBBoxScoreHomerunStatsListingPitcher {
+ db_mlb_box_score_homerun_stats_listings_id ::
+ DefaultKey MLBBoxScoreHomerunStatsListing,
+ db_homeruns_off_pitcher :: Int,
+ db_pitcher_first_name :: String,
+ db_pitcher_last_name :: String,
+ db_pitchers_pitcher_id :: Int }
+
+data MLBBoxScoreHomerunStatsListingPitcherXml =
+ MLBBoxScoreHomerunStatsListingPitcherXml {
+ xml_homeruns_off_pitcher :: Int,
+ xml_pitcher_first_name :: String,
+ xml_pitcher_last_name :: String,
+ xml_pitchers_pitcher_id :: Int }
+ deriving (Eq, GHC.Generic, Show)
+
+-- | For 'Generics.to_tuple'
+--
+instance Generic MLBBoxScoreHomerunStatsListingPitcherXml
+
+instance Child MLBBoxScoreHomerunStatsListingPitcherXml where
+ -- | Each 'MLBBoxScoreHomerunStatsListingPitcherXml' is contained in
+ -- (i.e. has a foreign key to) a 'MLBBoxScoreHomerunStatsListing'.
+ --
+ type Parent MLBBoxScoreHomerunStatsListingPitcherXml =
+ MLBBoxScoreHomerunStatsListing
+
+
+instance ToDb MLBBoxScoreHomerunStatsListingPitcherXml where
+ -- | The database representation of
+ -- 'MLBBoxScoreHomerunStatsListingPitcherXml' is
+ -- 'MLBBoxScoreHomerunStatsListingPitcher'.
+ --
+ type Db MLBBoxScoreHomerunStatsListingPitcherXml = MLBBoxScoreHomerunStatsListingPitcher
+
+
+instance FromXmlFk MLBBoxScoreHomerunStatsListingPitcherXml where
+ -- | To convert an 'MLBBoxScoreHomerunStatsListingPitcherXml' to an
+ -- 'MLBBoxScoreHomerunStatsListingPitcher', we add the foreign key.
+ --
+ from_xml_fk fk MLBBoxScoreHomerunStatsListingPitcherXml{..} =
+ MLBBoxScoreHomerunStatsListingPitcher {
+ db_mlb_box_score_homerun_stats_listings_id = fk,
+ db_homeruns_off_pitcher = xml_homeruns_off_pitcher,
+ db_pitcher_first_name = xml_pitcher_first_name,
+ db_pitcher_last_name = xml_pitcher_last_name,
+ db_pitchers_pitcher_id = xml_pitchers_pitcher_id }
+
+
+-- | This allows us to insert the XML representation
+-- 'MLBBoxScoreHomerunStatsListingPitcherXml' directly.
+--
+instance XmlImportFk MLBBoxScoreHomerunStatsListingPitcherXml
+
+
+
data MLBBoxScoreMiscellaneousGameInfo = MLBBoxScoreMiscellaneousGameInfo
data MLBBoxScoreMiscellaneousGameInfoXml = MLBBoxScoreMiscellaneousGameInfoXml
insert_ msg__breakdown
+ -- Now insert the homerun stats listings, keyed to the message.
+ -- They need not be present, but we're going to loop through them
+ -- all anyway, so if we have 'Nothing', we convert that to an
+ -- empty list instead. This simplifies the `forM_` code.
+ let listings = fromMaybe [] (xml_homerun_stats_listings m)
+ forM_ listings $ \listing -> do
+ -- Insert the listing itself.
+ listing_id <- insert_xml_fk msg_id listing
+ -- And all of its pitchers
+ forM_ (xml_pitchers listing) $ insert_xml_fk listing_id
+
return ImportSucceeded
fields: [db_xml_file_id]
+- embedded: MLBBoxScoreHomerunStatsListingBatter
+ fields:
+ - name: db_batter_first_name
+ dbName: batter_first_name
+ - name: db_batter_last_name
+ dbName: batter_last_name
+ - name: db_batter_rbis
+ dbName: batter_rbis
+ - name: db_batter_id
+ dbName: batter_id
+
+- entity: MLBBoxScoreHomerunStatsListing
+ dbName: mlb_box_score_homerun_stats_listings
+ constructors:
+ - name: MLBBoxScoreHomerunStatsListing
+ fields:
+ - name: db_batter
+ embeddedType:
+ - {name: batter_first_name, dbName: batter_first_name}
+ - {name: batter_last_name, dbName: batter_last_name}
+ - {name: batter_rbis, dbName: batter_rbis}
+ - {name: batter_id, dbName: batter_id}
+
+- entity: MLBBoxScoreHomerunStatsListingPitcher
+ dbName: mlb_box_score_homerun_stats_listing_pitchers
+ constructors:
+ - name: MLBBoxScoreHomerunStatsListingPitcher
+ fields:
+ - name: db_mlb_box_score_homerun_stats_listings_id
+ reference:
+ onDelete: cascade
+
- entity: MLBBoxScoreTeamBreakdown
dbName: mlb_box_scores_team_breakdowns
constructors:
pickle_game_breakdown
(xpList pickle_team_summary)
pickle_misc_pitching_stats
- pickle_homerun_stats
+ (xpOption pickle_homerun_stats_listings)
pickle_miscellaneous_game_info
(xpElem "time_stamp" xp_time_stamp)
where
pickle_home_team =
xpElem "HomeTeam" pickle_team
-pickle_homerun_stats :: PU (Maybe MLBBoxScoreHomerunStatsXml)
-pickle_homerun_stats =
- xpOption $ xpElem "Homerun_Stats" $ xpWrap (from_tuple, to_tuple') $ xpUnit
+
+pickle_batter :: PU MLBBoxScoreHomerunStatsListingBatter
+pickle_batter =
+ xpElem "HRS_Batter_ID" $
+ xpWrap (from_tuple, to_tuple) $
+ xp4Tuple (xpAttr "HRS_Batter_FirstName" $ xpText)
+ (xpAttr "HRS_Batter_LastName" $ xpText)
+ (xpAttr "RBIs" $ xpInt)
+ xpInt
where
- from_tuple _ = MLBBoxScoreHomerunStatsXml
- to_tuple' _ = ()
+ from_tuple = uncurryN MLBBoxScoreHomerunStatsListingBatter
+
+
+pickle_pitcher :: PU MLBBoxScoreHomerunStatsListingPitcherXml
+pickle_pitcher =
+ xpElem "HRS_Pitcher_ID" $
+ xpWrap (from_tuple, to_tuple) $
+ xp4Tuple (xpAttr "HRS_Homeruns_Off_Pitcher" $ xpInt)
+ (xpAttr "HRS_Pitcher_FirstName" $ xpText)
+ (xpAttr "HRS_Pitcher_LastName" $ xpText)
+ xpInt
+ where
+ from_tuple = uncurryN MLBBoxScoreHomerunStatsListingPitcherXml
+
+
+pickle_homerun_stats_listing :: PU MLBBoxScoreHomerunStatsListingXml
+pickle_homerun_stats_listing =
+ xpElem "HRS_Listing" $
+ xpWrap (from_tuple, to_tuple) $
+ xpTriple pickle_batter
+ (xpElem "Season_Homeruns" xpInt)
+ (xpList pickle_pitcher)
+ where
+ from_tuple = uncurryN MLBBoxScoreHomerunStatsListingXml
+
+
+pickle_homerun_stats_listings :: PU [MLBBoxScoreHomerunStatsListingXml]
+pickle_homerun_stats_listings =
+ xpElem "Homerun_Stats" $ xpList pickle_homerun_stats_listing
pickle_misc_pitching_stats :: PU MLBBoxScoreMiscPitchingStatsXml
projects / dead / htsn-import.git / commitdiff