-- * Tests
-- auto_racing_results_tests,
-- * WARNING: these are private but exported to silence warnings
+ MLBBoxScore_MLBBoxScoreTeamBreakdownConstructor(..),
MLBBoxScoreConstructor(..),
- MLBBoxScoreGameBreakdown(..),
MLBBoxScoreHomerunStats(..),
MLBBoxScoreMiscellaneousGameInfo(..),
MLBBoxScoreMiscPitchingStats(..),
+ MLBBoxScoreRunsByInningsConstructor(..),
+ MLBBoxScoreTeamBreakdownConstructor(..),
MLBBoxScoreTeamSummary(..)
)
-- AutoRacingResultsListingConstructor(..),
where
-- System imports.
+import Control.Monad ( forM_ )
import Data.Time ( UTCTime(..) )
import Data.Tuple.Curry ( uncurryN )
import Database.Groundhog (
insert,
+ insert_,
migrate )
import Database.Groundhog.Core ( DefaultKey )
import Database.Groundhog.TH (
xp_time,
xp_time_stamp )
import TSN.Team ( Team(..), FromXmlFkTeams(..) )
+import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) )
import Xml (
Child(..),
+ FromXml(..),
+ FromXmlFk(..),
ToDb(..) )
--
instance Generic Message
-
instance ToDb Message where
-- | The database analogue of a 'Message' is a 'MLBBoxScore'.
--
instance Child Message where
type Parent Message = MLBBoxScore
-
--- | The 'FromXml' instance for 'Message' is required for the
+-- | The 'FromXmlFk' instance for 'Message' is required for the
-- 'XmlImport' instance.
---
instance FromXmlFkTeams Message where
-- | To convert a 'Message' to an 'MLBBoxScore', we drop the
-- teams/summaries and combine the date/time. Also missing are the
-- embedded elements game_breakdown, homerun_stats, and
-- miscellaneous_game_info.
--
- -- The first \"missing\" argument is the foreign key to its
- -- parent, which it doesn't have. (See the 'Child' instance.)
- --
from_xml_fk_teams _ vteam_id hteam_id Message{..} =
MLBBoxScore {
db_xml_file_id = xml_xml_file_id,
UTCTime (utctDay xml_game_date) (utctDayTime xml_game_time)
-
data MLBBoxScoreTeamSummary = MLBBoxScoreTeamSummary
data MLBBoxScoreTeamSummaryXml = MLBBoxScoreTeamSummaryXml deriving (Eq, Show)
-data MLBBoxScoreGameBreakdown = MLBBoxScoreGameBreakdown
data MLBBoxScoreGameBreakdownXml =
MLBBoxScoreGameBreakdownXml {
- xml_away_team :: MLBBoxScoreGameBreakdownTeamXml,
- xml_home_team :: MLBBoxScoreGameBreakdownTeamXml }
+ xml_away_team :: MLBBoxScoreTeamBreakdownXml,
+ xml_home_team :: MLBBoxScoreTeamBreakdownXml }
deriving (Eq, GHC.Generic, Show)
-- | For 'Generics.to_tuple'
data MLBBoxScoreMiscellaneousGameInfoXml = MLBBoxScoreMiscellaneousGameInfoXml
deriving (Eq, Show)
-data MLBBoxScoreGameBreakdownTeamXml =
- MLBBoxScoreGameBreakdownTeamXml {
+
+-- Team Breakdown
+data MLBBoxScoreTeamBreakdown =
+ MLBBoxScoreTeamBreakdown {
+ db_runs :: Int,
+ db_hits :: Int,
+ db_errors :: Int }
+data MLBBoxScoreTeamBreakdownXml =
+ MLBBoxScoreTeamBreakdownXml {
xml_runs_by_innings :: [MLBBoxScoreRunsByInningsXml],
xml_runs :: Int,
xml_hits :: Int,
-- | For 'Generics.to_tuple'.
-instance Generic MLBBoxScoreGameBreakdownTeamXml
+instance Generic MLBBoxScoreTeamBreakdownXml
+instance ToDb MLBBoxScoreTeamBreakdownXml where
+ -- | The database analogue of a 'MLBBoxScoreTeamBreakdownXml' is
+ -- a 'MLBBoxScoreTeamBreakdown'.
+ --
+ type Db MLBBoxScoreTeamBreakdownXml = MLBBoxScoreTeamBreakdown
+
+
+-- | The 'FromXml' instance for 'MLBBoxScoreTeamBreakdownXml' is
+-- required for the 'XmlImport' instance.
+--
+instance FromXml MLBBoxScoreTeamBreakdownXml where
+ -- | To convert a 'MLBBoxScoreTeamBreakdownXml' to an
+ -- 'MLBBoxScoreTeamBreakdown', we just drop the
+ -- 'xml_runs_by_innings'.
+ --
+ from_xml MLBBoxScoreTeamBreakdownXml{..} =
+ MLBBoxScoreTeamBreakdown {
+ db_runs = xml_runs,
+ db_hits = xml_hits,
+ db_errors = xml_errors }
+
+instance XmlImport MLBBoxScoreTeamBreakdownXml
+
+-- Runs by innings
+data MLBBoxScoreRunsByInnings =
+ MLBBoxScoreRunsByInnings {
+ db_mlb_box_scores_team_breakdowns_id :: DefaultKey
+ MLBBoxScoreTeamBreakdown,
+ db_runs_by_innings_inning_number :: Int,
+ db_runs_by_innings_runs :: Int }
data MLBBoxScoreRunsByInningsXml =
MLBBoxScoreRunsByInningsXml {
deriving (Eq, GHC.Generic, Show)
+-- * MLBBoxScore_MLBBoxScoreTeamSummary
+
+-- | Mapping between 'MLBBoxScore' records and
+-- 'MLBBoxScoreTeamSummary' records in the database. We don't use
+-- the names anywhere, so we let Groundhog choose them.
+--
+data MLBBoxScore_MLBBoxScoreTeamBreakdown =
+ MLBBoxScore_MLBBoxScoreTeamBreakdown
+ (DefaultKey MLBBoxScore)
+ (DefaultKey MLBBoxScoreTeamBreakdown) -- Away team
+ (DefaultKey MLBBoxScoreTeamBreakdown) -- Home team
+
+
+
-- | For 'Generics.to_tuple'.
--
instance Generic MLBBoxScoreRunsByInningsXml
+instance ToDb MLBBoxScoreRunsByInningsXml where
+ -- | The database analogue of a 'MLBBoxScoreRunsByInningsXml' is
+ -- a 'MLBBoxScoreRunsByInnings'.
+ --
+ type Db MLBBoxScoreRunsByInningsXml = MLBBoxScoreRunsByInnings
+
+
+instance Child MLBBoxScoreRunsByInningsXml where
+ -- | Each 'MLBBoxScoreRunsByInningsXml' is contained in (i.e. has a
+ -- foreign key to) a 'MLBBoxScoreTeamBreakdownXml'.
+ --
+ type Parent MLBBoxScoreRunsByInningsXml = MLBBoxScoreTeamBreakdown
+
+
+instance FromXmlFk MLBBoxScoreRunsByInningsXml where
+ -- | To convert an 'MLBBoxScoreRunsByInningsXml' to an
+ -- 'MLBBoxScoreRunsByInnings', we add the foreign key and copy
+ -- everything else verbatim.
+ --
+ from_xml_fk fk MLBBoxScoreRunsByInningsXml{..} =
+ MLBBoxScoreRunsByInnings {
+ db_mlb_box_scores_team_breakdowns_id = fk,
+ db_runs_by_innings_inning_number = xml_runs_by_innings_inning_number,
+ db_runs_by_innings_runs = xml_runs_by_innings_runs }
+
+
+-- | This allows us to insert the XML representation
+-- 'MLBBoxScoreRunsByInningsXml' directly.
+--
+instance XmlImportFk MLBBoxScoreRunsByInningsXml
+
+
+
+
data MLBBoxScoreMiscPitchingStats = MLBBoxScoreMiscPitchingStats
data MLBBoxScoreMiscPitchingStatsXml =
MLBBoxScoreMiscPitchingStatsXml {
vteam_fk <- insert vteam
hteam_fk <- insert hteam
- -- Now we can key the message to the teams we just inserted.
- -- The message has no parent, so we pass in undefined.
+ -- Now we can key the message to the teams/breakdowns we just
+ -- inserted.
let db_msg = from_xml_fk_teams undefined vteam_fk hteam_fk m
- _ <- insert db_msg
+ msg_id <- insert db_msg
+
+ -- Next, the vteam/hteam breakdowns, also needed to construct the
+ -- main message record
+ let vteam_bd = xml_away_team $ xml_game_breakdown m
+ let hteam_bd = xml_home_team $ xml_game_breakdown m
+
+ vteam_bd_fk <- insert_xml vteam_bd
+ hteam_bd_fk <- insert_xml hteam_bd
+
+ -- Insert the runs-by-innings associated with the vteam/hteam
+ -- breakdowns.
+ forM_ (xml_runs_by_innings vteam_bd) $ insert_xml_fk_ vteam_bd_fk
+ forM_ (xml_runs_by_innings hteam_bd) $ insert_xml_fk_ hteam_bd_fk
+
+ -- Now the join table record that ties the message to its two team
+ -- breakdowns.
+ let msg__breakdown = MLBBoxScore_MLBBoxScoreTeamBreakdown
+ msg_id
+ vteam_bd_fk
+ hteam_bd_fk
+
+ insert_ msg__breakdown
- -- Now get the hteam
return ImportSucceeded
# Prevent multiple imports of the same message.
fields: [db_xml_file_id]
+
+- entity: MLBBoxScoreTeamBreakdown
+ dbName: mlb_box_scores_team_breakdowns
+ constructors:
+ - name: MLBBoxScoreTeamBreakdown
+
+- entity: MLBBoxScoreRunsByInnings
+ dbName: mlb_box_scores_team_breakdowns_runs_by_innings
+ constructors:
+ - name: MLBBoxScoreRunsByInnings
+ fields:
+ - name: db_mlb_box_scores_team_breakdowns_id
+ reference:
+ onDelete: cascade
+
+
+- entity: MLBBoxScore_MLBBoxScoreTeamBreakdown
+ dbName: mlb_box_scores__mlb_box_scores_team_breakdowns
+ constructors:
+ - name: MLBBoxScore_MLBBoxScoreTeamBreakdown
+ fields:
+ - name: mLBBoxScore_MLBBoxScoreTeamBreakdown0
+ dbName: mlb_box_scores_id
+ reference:
+ onDelete: cascade
+ - name: mLBBoxScore_MLBBoxScoreTeamBreakdown1
+ dbName: mlb_box_scores_team_breakdowns_away_team_id
+ reference:
+ onDelete: cascade
+ - name: mLBBoxScore_MLBBoxScoreTeamBreakdown2
+ dbName: db_mlb_box_scores_team_breakdowns_home_team_id
+ reference:
+ onDelete: cascade
|]
from_tuple = uncurry MLBBoxScoreRunsByInningsXml
-pickle_team :: PU MLBBoxScoreGameBreakdownTeamXml
+pickle_team :: PU MLBBoxScoreTeamBreakdownXml
pickle_team =
xpWrap (from_tuple, to_tuple) $
xp4Tuple (xpList pickle_runs_by_innings)
(xpElem "Hits" xpInt)
(xpElem "Errors" xpInt)
where
- from_tuple = uncurryN MLBBoxScoreGameBreakdownTeamXml
+ from_tuple = uncurryN MLBBoxScoreTeamBreakdownXml
-pickle_away_team :: PU MLBBoxScoreGameBreakdownTeamXml
+pickle_away_team :: PU MLBBoxScoreTeamBreakdownXml
pickle_away_team =
xpElem "AwayTeam" pickle_team
-pickle_home_team :: PU MLBBoxScoreGameBreakdownTeamXml
+pickle_home_team :: PU MLBBoxScoreTeamBreakdownXml
pickle_home_team =
xpElem "HomeTeam" pickle_team
projects / dead / htsn-import.git / commitdiff