X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhtsn-import.git;a=blobdiff_plain;f=src%2FTSN%2FXML%2FMLBBoxScore.hs;h=39109b2ded73f1fe9ea2f390ba377764ef42fbfc;hp=6de054009073fca608ed4912a4724ca8fa094b4f;hb=c0dd6db82ddf70ab3cc940f23c0cfcc6d8bb9355;hpb=0fb33e421979003bec08430d550314bf95504eee diff --git a/src/TSN/XML/MLBBoxScore.hs b/src/TSN/XML/MLBBoxScore.hs index 6de0540..39109b2 100644 --- a/src/TSN/XML/MLBBoxScore.hs +++ b/src/TSN/XML/MLBBoxScore.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE QuasiQuotes #-} @@ -11,50 +12,47 @@ module TSN.XML.MLBBoxScore ( dtd, pickle_message, -- * Tests --- auto_racing_results_tests, + -- auto_racing_results_tests, -- * WARNING: these are private but exported to silence warnings - MLBBoxScoreConstructor(..) ) + MLBBoxScoreConstructor(..), + MLBBoxScoreGameBreakdown(..), + MLBBoxScoreHomerunStats(..), + MLBBoxScoreMiscellaneousGameInfo(..), + MLBBoxScoreMiscPitchingStats(..), + MLBBoxScoreTeamSummary(..) + ) -- AutoRacingResultsListingConstructor(..), -- AutoRacingResultsRaceInformationConstructor(..) ) where -- System imports. -import Control.Monad ( forM_ ) import Data.Time ( UTCTime(..) ) import Data.Tuple.Curry ( uncurryN ) import Database.Groundhog ( - countAll, - deleteAll, insert, - migrate, - runMigration, - silentMigrationLogger ) + migrate ) import Database.Groundhog.Core ( DefaultKey ) -import Database.Groundhog.Generic ( runDbConn ) -import Database.Groundhog.Sqlite ( withSqliteConn ) import Database.Groundhog.TH ( groundhog, mkPersist ) -import Test.Tasty ( TestTree, testGroup ) -import Test.Tasty.HUnit ( (@?=), testCase ) +import qualified GHC.Generics as GHC ( Generic ) import Text.XML.HXT.Core ( PU, - xp11Tuple, + xp4Tuple, xp23Tuple, xpAttr, - xpDefault, xpElem, xpInt, xpList, xpOption, xpPair, - xpPrim, xpText, xpTriple, xpUnit, xpWrap ) -- Local imports. +import Generics ( Generic(..), to_tuple ) import TSN.Codegen ( tsn_codegen_config ) import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate ) import TSN.Picklers ( @@ -62,15 +60,9 @@ import TSN.Picklers ( xp_time, xp_time_stamp ) import TSN.Team ( Team(..), FromXmlFkTeams(..) ) -import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) ) import Xml ( Child(..), - FromXml(..), - FromXmlFk(..), - ToDb(..), - pickle_unpickle, - unpickleable, - unsafe_unpickle ) + ToDb(..) ) -- | The DTD to which this module corresponds. Used to invoke dbimport. @@ -141,7 +133,12 @@ data Message = xml_homerun_stats :: Maybe MLBBoxScoreHomerunStatsXml, xml_miscellaneous_game_info :: MLBBoxScoreMiscellaneousGameInfoXml, xml_time_stamp :: UTCTime } - deriving (Eq, Show) + deriving (Eq, GHC.Generic, Show) + + +-- | For 'Generics.to_tuple'. +-- +instance Generic Message instance ToDb Message where @@ -198,8 +195,16 @@ data MLBBoxScoreTeamSummary = MLBBoxScoreTeamSummary data MLBBoxScoreTeamSummaryXml = MLBBoxScoreTeamSummaryXml deriving (Eq, Show) data MLBBoxScoreGameBreakdown = MLBBoxScoreGameBreakdown -data MLBBoxScoreGameBreakdownXml = MLBBoxScoreGameBreakdownXml - deriving (Eq, Show) +data MLBBoxScoreGameBreakdownXml = + MLBBoxScoreGameBreakdownXml { + xml_away_team :: MLBBoxScoreGameBreakdownTeamXml, + xml_home_team :: MLBBoxScoreGameBreakdownTeamXml } + deriving (Eq, GHC.Generic, Show) + +-- | For 'Generics.to_tuple' +-- +instance Generic MLBBoxScoreGameBreakdownXml + data MLBBoxScoreHomerunStats = MLBBoxScoreHomerunStats data MLBBoxScoreHomerunStatsXml = MLBBoxScoreHomerunStatsXml @@ -209,9 +214,68 @@ data MLBBoxScoreMiscellaneousGameInfo = MLBBoxScoreMiscellaneousGameInfo data MLBBoxScoreMiscellaneousGameInfoXml = MLBBoxScoreMiscellaneousGameInfoXml deriving (Eq, Show) +data MLBBoxScoreGameBreakdownTeamXml = + MLBBoxScoreGameBreakdownTeamXml { + xml_runs_by_innings :: [MLBBoxScoreRunsByInningsXml], + xml_runs :: Int, + xml_hits :: Int, + xml_errors :: Int } + deriving (Eq, GHC.Generic, Show) + + +-- | For 'Generics.to_tuple'. +instance Generic MLBBoxScoreGameBreakdownTeamXml + + +data MLBBoxScoreRunsByInningsXml = + MLBBoxScoreRunsByInningsXml { + xml_runs_by_innings_inning_number :: Int, + xml_runs_by_innings_runs :: Int } + deriving (Eq, GHC.Generic, Show) + + +-- | For 'Generics.to_tuple'. +-- +instance Generic MLBBoxScoreRunsByInningsXml + + data MLBBoxScoreMiscPitchingStats = MLBBoxScoreMiscPitchingStats -data MLBBoxScoreMiscPitchingStatsXml = MLBBoxScoreMiscPitchingStatsXml - deriving (Eq, Show) +data MLBBoxScoreMiscPitchingStatsXml = + MLBBoxScoreMiscPitchingStatsXml { + xml_wild_pitches :: Maybe Int, + xml_intentional_walks :: [MLBBoxScoreMiscPitchingStatsIntentionalWalkXml], + xml_hits_by_pitch :: [MLBBoxScoreMiscPitchingStatsHitByPitchXml] } + deriving (Eq, GHC.Generic, Show) + + +-- | For 'Generics.to_tuple'. +instance Generic MLBBoxScoreMiscPitchingStatsXml + + +data MLBBoxScoreMiscPitchingStatsIntentionalWalkXml = + MLBBoxScoreMiscPitchingStatsIntentionalWalkXml { + xml_iw_batter_id :: Int, + xml_iw_pitcher_id :: Int, + xml_iw_number_of_times_walked :: Int } + deriving (Eq, GHC.Generic, Show) + + +-- | For 'Generics.to_tuple'. +instance Generic MLBBoxScoreMiscPitchingStatsIntentionalWalkXml + + +data MLBBoxScoreMiscPitchingStatsHitByPitchXml = + MLBBoxScoreMiscPitchingStatsHitByPitchXml { + xml_hbp_batter_id :: Int, + xml_hbp_pitcher_id :: Int, + xml_hbp_number_of_times_hit :: Int } + deriving (Eq, GHC.Generic, Show) + + +-- | For 'Generics.to_tuple'. +-- +instance Generic MLBBoxScoreMiscPitchingStatsHitByPitchXml + -- -- * Database @@ -235,7 +299,7 @@ instance DbImport Message where -- Now we can key the message to the teams we just inserted. -- The message has no parent, so we pass in undefined. let db_msg = from_xml_fk_teams undefined vteam_fk hteam_fk m - msg_id <- insert db_msg + _ <- insert db_msg -- Now get the hteam return ImportSucceeded @@ -290,62 +354,101 @@ pickle_message = (xpElem "time_stamp" xp_time_stamp) where from_tuple = uncurryN Message - to_tuple m = (xml_xml_file_id m, - xml_heading m, - xml_category m, - xml_sport m, - xml_game_id m, - xml_schedule_id m, - xml_vteam m, - xml_hteam m, - xml_vteam_id m, - xml_hteam_id m, - xml_season m, - xml_season_type m, - xml_title m, - xml_game_date m, - xml_game_time m, - xml_game_number m, - xml_capacity m, - xml_game_breakdown m, - xml_team_summaries m, - xml_misc_pitching_stats m, - xml_homerun_stats m, - xml_miscellaneous_game_info m, - xml_time_stamp m) pickle_team_summary :: PU MLBBoxScoreTeamSummaryXml pickle_team_summary = - xpElem "Team_Summary" $ xpWrap (from_tuple, to_tuple) $ xpUnit + xpElem "Team_Summary" $ xpWrap (from_tuple, to_tuple') $ xpUnit where from_tuple _ = MLBBoxScoreTeamSummaryXml - to_tuple _ = () + to_tuple' _ = () pickle_game_breakdown :: PU MLBBoxScoreGameBreakdownXml pickle_game_breakdown = - xpElem "Game_Breakdown" $ xpWrap (from_tuple, to_tuple) $ xpUnit + xpElem "Game_Breakdown" $ + xpWrap (from_tuple, to_tuple) $ + xpPair pickle_away_team + pickle_home_team + where + from_tuple = uncurry MLBBoxScoreGameBreakdownXml + + +pickle_runs_by_innings :: PU MLBBoxScoreRunsByInningsXml +pickle_runs_by_innings = + xpElem "Runs_By_Innings" $ + xpWrap (from_tuple, to_tuple) $ + xpPair (xpAttr "Inning" xpInt) + xpInt where - from_tuple _ = MLBBoxScoreGameBreakdownXml - to_tuple _ = () + from_tuple = uncurry MLBBoxScoreRunsByInningsXml + + +pickle_team :: PU MLBBoxScoreGameBreakdownTeamXml +pickle_team = + xpWrap (from_tuple, to_tuple) $ + xp4Tuple (xpList pickle_runs_by_innings) + (xpElem "Runs" xpInt) + (xpElem "Hits" xpInt) + (xpElem "Errors" xpInt) + where + from_tuple = uncurryN MLBBoxScoreGameBreakdownTeamXml + + +pickle_away_team :: PU MLBBoxScoreGameBreakdownTeamXml +pickle_away_team = + xpElem "AwayTeam" pickle_team + +pickle_home_team :: PU MLBBoxScoreGameBreakdownTeamXml +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 + xpOption $ xpElem "Homerun_Stats" $ xpWrap (from_tuple, to_tuple') $ xpUnit where from_tuple _ = MLBBoxScoreHomerunStatsXml - to_tuple _ = () + to_tuple' _ = () + pickle_misc_pitching_stats :: PU MLBBoxScoreMiscPitchingStatsXml pickle_misc_pitching_stats = - xpElem "Misc_Pitching_Stats" $ xpWrap (from_tuple, to_tuple) $ xpUnit + xpElem "Misc_Pitching_Stats" $ + xpWrap (from_tuple, to_tuple) $ + xpTriple (xpOption $ xpElem "Wild_Pitches" xpInt) + pickle_intentional_walks + pickle_hits_by_pitch where - from_tuple _ = MLBBoxScoreMiscPitchingStatsXml - to_tuple _ = () + from_tuple = uncurryN MLBBoxScoreMiscPitchingStatsXml + + + +pickle_intentional_walks :: PU [MLBBoxScoreMiscPitchingStatsIntentionalWalkXml] +pickle_intentional_walks = + xpElem "Intentional_Walks" $ xpList $ xpElem "IW_Listing" $ + xpWrap (from_tuple, to_tuple) $ + xpTriple (xpElem "IW_Batter_ID" xpInt) + (xpElem "IW_Pitcher_ID" xpInt) + (xpElem "IW_Number_Of_Times_Walked" xpInt) + where + from_tuple = uncurryN MLBBoxScoreMiscPitchingStatsIntentionalWalkXml + + + +pickle_hits_by_pitch :: PU [MLBBoxScoreMiscPitchingStatsHitByPitchXml] +pickle_hits_by_pitch = + xpElem "Hit_By_Pitch" $ xpList $ xpElem "HBP_Listing" $ + xpWrap (from_tuple, to_tuple) $ + xpTriple (xpElem "HBP_Batter_ID" xpInt) + (xpElem "HBP_Pitcher_ID" xpInt) + (xpElem "HBP_Number_Of_Times_Hit" xpInt) + where + from_tuple = uncurryN MLBBoxScoreMiscPitchingStatsHitByPitchXml + + pickle_miscellaneous_game_info :: PU MLBBoxScoreMiscellaneousGameInfoXml pickle_miscellaneous_game_info = - xpElem "Miscelaneous_Game_Info" $ xpWrap (from_tuple, to_tuple) $ xpUnit + xpElem "Miscelaneous_Game_Info" $ xpWrap (from_tuple, to_tuple') $ xpUnit where from_tuple _ = MLBBoxScoreMiscellaneousGameInfoXml - to_tuple _ = () + to_tuple' _ = ()