1 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE QuasiQuotes #-}
4 {-# LANGUAGE RecordWildCards #-}
5 {-# LANGUAGE TemplateHaskell #-}
6 {-# LANGUAGE TypeFamilies #-}
8 -- | SportInfo represents a collection of DTDs that we don't really
9 -- handle but want to make available. The raw XML gets stored in the
10 -- database along with the XML_File_ID, but we don't parse any of it.
12 -- This is almost completely redundant with "TSN.XML.GameInfo", but
13 -- the redundancy is necessary: we need separate 'Message' types so
14 -- that we can have separate 'DbImport' instances. It would take
15 -- more code/work to abstract (if it's even possible) than to
18 module TSN.XML.SportInfo (
22 -- * WARNING: these are private but exported to silence warnings
23 SportInfoConstructor(..) )
27 import Data.Either ( rights )
28 import Data.Time.Clock ( UTCTime )
29 import Database.Groundhog (
33 silentMigrationLogger )
34 import Database.Groundhog.Generic ( runDbConn )
35 import Database.Groundhog.Sqlite ( withSqliteConn )
36 import Database.Groundhog.TH (
39 import Test.Tasty ( TestTree, testGroup )
40 import Test.Tasty.HUnit ( (@?=), testCase )
41 import Text.XML.HXT.Core ( XmlTree )
42 import Text.XML.HXT.DOM.ShowXml ( xshow )
45 import TSN.Codegen ( tsn_codegen_config )
53 parse_xml_time_stamp )
54 import TSN.XmlImport ( XmlImport(..) )
58 unsafe_read_document )
61 -- | The DTDs for everything that we consider \"Sport Info.\"
63 -- TODO: This is the list from the old implementation. We need to
64 -- make sure that we are really receiving XML for these DTDs
65 -- (i.e. the names are correct).
69 [ "CBASK_3PPctXML.dtd",
70 "Cbask_All_Tourn_Teams_XML.dtd",
71 "CBASK_AssistsXML.dtd",
72 "Cbask_Awards_XML.dtd",
73 "CBASK_BlocksXML.dtd",
74 "Cbask_Conf_Standings_XML.dtd",
75 "Cbask_DivII_III_Indv_Stats_XML.dtd",
76 "Cbask_DivII_Team_Stats_XML.dtd",
77 "Cbask_DivIII_Team_Stats_XML.dtd",
81 "Cbask_Indv_No_Avg_XML.dtd", -- no dtd
82 "Cbask_Indv_Scoring_XML.dtd",
83 "Cbask_Indv_Shooting_XML.dtd", -- no dtd
84 "CBASK_MinutesXML.dtd",
85 "Cbask_Polls_XML.dtd",
86 "CBASK_ReboundsXML.dtd",
87 "CBASK_ScoringLeadersXML.dtd",
88 "CBASK_StealsXML.dtd", -- no dtd
89 "Cbask_Team_Scoring_Rebound_Margin_XML.dtd", -- no dtd
90 "Cbask_Team_Scoring_XML.dtd", -- no dtd
91 "Cbask_Team_Shooting_Pct_XML.dtd", -- no dtd
92 "Cbask_Team_ThreePT_Made_XML.dtd",
93 "Cbask_Team_ThreePT_PCT_XML.dtd",
94 "Cbask_Team_Win_Pct_XML.dtd",
95 "Cbask_Top_Twenty_Five_XML.dtd",
96 "CBASK_TopTwentyFiveResult_XML.dtd",
97 "Cbask_Tourn_Awards_XML.dtd",
98 "Cbask_Tourn_Champs_XML.dtd",
99 "Cbask_Tourn_Indiv_XML.dtd",
100 "Cbask_Tourn_Leaders_XML.dtd",
101 "Cbask_Tourn_MVP_XML.dtd",
102 "Cbask_Tourn_Records_XML.dtd",
103 "LeagueScheduleXML.dtd",
104 "minorscoresxml.dtd",
105 "Minor_Baseball_League_Leaders_XML.dtd",
106 "Minor_Baseball_Standings_XML.dtd",
107 "Minor_Baseball_Transactions_XML.dtd",
108 "mlbbattingavgxml.dtd",
109 "mlbdoublesleadersxml.dtd",
110 "MLBGamesPlayedXML.dtd",
112 "MLBHitByPitchXML.dtd",
113 "mlbhitsleadersxml.dtd",
114 "mlbhomerunsxml.dtd",
116 "MLBIntWalksXML.dtd",
118 "mlbonbasepctxml.dtd",
120 "MLBPlateAppsXML.dtd",
122 "mlbrunsleadersxml.dtd",
123 "MLBSacFliesXML.dtd",
124 "MLBSacrificesXML.dtd",
125 "MLBSBSuccessXML.dtd",
126 "mlbsluggingpctxml.dtd",
128 "mlbstandxml_preseason.dtd",
129 "mlbstolenbasexml.dtd",
130 "mlbtotalbasesleadersxml.dtd",
131 "mlbtriplesleadersxml.dtd",
132 "MLBWalkRateXML.dtd",
133 "mlbwalksleadersxml.dtd",
134 "MLBXtraBaseHitsXML.dtd",
135 "MLB_ERA_Leaders.dtd",
136 "MLB_Fielding_XML.dtd",
137 "MLB_Pitching_Appearances_Leaders.dtd",
138 "MLB_Pitching_Balks_Leaders.dtd",
139 "MLB_Pitching_CG_Leaders.dtd",
140 "MLB_Pitching_ER_Allowed_Leaders.dtd",
141 "MLB_Pitching_Hits_Allowed_Leaders.dtd",
142 "MLB_Pitching_Hit_Batters_Leaders.dtd",
143 "MLB_Pitching_HR_Allowed_Leaders.dtd",
144 "MLB_Pitching_IP_Leaders.dtd",
145 "MLB_Pitching_Runs_Allowed_Leaders.dtd",
146 "MLB_Pitching_Saves_Leaders.dtd",
147 "MLB_Pitching_Shut_Outs_Leaders.dtd",
148 "MLB_Pitching_Starts_Leaders.dtd",
149 "MLB_Pitching_Strike_Outs_Leaders.dtd",
150 "MLB_Pitching_Walks_Leaders.dtd",
151 "MLB_Pitching_WHIP_Leaders.dtd",
152 "MLB_Pitching_Wild_Pitches_Leaders.dtd",
153 "MLB_Pitching_Win_Percentage_Leaders.dtd",
154 "MLB_Pitching_WL_Leaders.dtd",
155 "NBA_Team_Stats_XML.dtd",
161 "nbadivisionsxml.dtd",
166 "NBAReboundsXML.dtd",
170 "nbateamleadersxml.dtd",
171 "nbatripledoublexml.dtd",
172 "NBATurnoversXML.dtd",
173 "NCAA_Conference_Schedule_XML.dtd",
174 "nflfirstdownxml.dtd",
175 "NFLFumbleLeaderXML.dtd", -- no dtd
176 "NFLGiveTakeXML.dtd", -- no dtd
177 "NFLGrassTurfDomeOutsideXML.dtd", -- no dtd
178 "NFLInside20XML.dtd", -- no dtd
179 "NFLInterceptionLeadersXML.dtd", -- no dtd
180 "NFLKickoffsXML.dtd", -- no dtd
181 "NFLMondayNightXML.dtd", -- no dtd
182 "NFLPassingLeadersXML.dtd", -- no dtd
183 "NFLPassLeadXML.dtd", -- no dtd
184 "NFLQBStartsXML.dtd", -- no dtd
185 "NFLReceivingLeadersXML.dtd", -- no dtd
186 "NFLRushingLeadersXML.dtd", -- no dtd
187 "NFLSackLeadersXML.dtd", -- no dtd
188 "nflstandxml.dtd", -- no dtd
189 "NFLTackleFFLeadersXML.dtd", -- no dtd
190 "NFLTeamRankingsXML.dtd", -- no dtd
191 "NFLTopKickoffReturnXML.dtd", -- no dtd
192 "NFLTopPerformanceXML.dtd", -- no dtd
193 "NFLTopPuntReturnXML.dtd", -- no dtd
194 "NFLTotalYardageXML.dtd", -- no dtd
195 "NFLYardsXML.dtd", -- no dtd
196 "NFL_KickingLeaders_XML.dtd", -- no dtd
197 "NFL_NBA_Draft_XML.dtd", -- no dtd
198 "NFL_PuntingLeaders_XML.dtd", -- no dtd
199 "NFL_Roster_XML.dtd", -- no dtd
200 "NFL_Team_Stats_XML.dtd", -- no dtd
201 "Transactions_XML.dtd", -- no dtd
202 "Weekly_Sched_XML.dtd", -- no dtd
203 "WNBA_Team_Leaders_XML.dtd", -- no dtd
204 "WNBA3PPctXML.dtd", -- no dtd
205 "WNBAAssistsXML.dtd", -- no dtd
206 "WNBABlocksXML.dtd", -- no dtd
207 "WNBAFGPctXML.dtd", -- no dtd
208 "WNBAFoulsXML.dtd", -- no dtd
209 "WNBAFTPctXML.dtd", -- no dtd
210 "WNBAMinutesXML.dtd", -- no dtd
211 "WNBAReboundsXML.dtd", -- no dtd
212 "WNBAScorersXML.dtd", -- no dtd
213 "wnbastandxml.dtd", -- no dtd
214 "WNBAStealsXML.dtd", -- no dtd
215 "WNBATurnoversXML.dtd" -- no dtd
219 -- | XML representation of a SportInfo \<message\>.
224 xml_xml_file_id :: Int,
225 xml_time_stamp :: UTCTime,
230 -- | Attempt to parse a 'Message' from an 'XmlTree'. If we cannot,
231 -- we fail with an error message.
233 parse_xml :: String -> XmlTree -> Either String Message
234 parse_xml dtdname xmltree = do
235 xmlfid <- parse_xmlfid xmltree
236 timestamp <- parse_xml_time_stamp xmltree
237 message <- parse_message xmltree
238 return $ Message dtdname (fromInteger xmlfid) timestamp (xshow [message])
241 -- | Database representation of a 'Message'.
246 db_xml_file_id :: Int,
247 db_time_stamp :: UTCTime,
251 instance ToDb Message where
252 -- | The database analogue of a 'Message' is an 'SportInfo'.
253 type Db Message = SportInfo
255 instance FromXml Message where
256 -- | The XML to DB conversion is trivial here.
258 from_xml Message{..} = SportInfo {
260 db_xml_file_id = xml_xml_file_id,
261 db_time_stamp = xml_time_stamp,
265 -- | This allows us to insert the XML representation 'Message'
268 instance XmlImport Message
275 instance DbImport Message where
277 run_dbmigrate $ migrate (undefined :: SportInfo)
279 -- | We import a 'Message' by inserting the whole thing at
280 -- once. Nothing fancy going on here.
283 return ImportSucceeded
286 -- | The database schema for SportInfo is trivial; all we need is for
287 -- the XML_File_ID to be unique.
289 mkPersist tsn_codegen_config [groundhog|
294 - name: unique_sport_info
296 # Prevent multiple imports of the same message.
297 fields: [db_xml_file_id]
305 -- | A list of all tests for this module.
307 sport_info_tests :: TestTree
311 [ test_parse_xml_succeeds,
312 test_dbimport_succeeds ]
315 -- | Sample XML documents for SportInfo types.
317 sport_info_test_files :: [FilePath]
318 sport_info_test_files =
319 map ("test/xml/sportinfo/" ++) [
320 "CBASK_3PPctXML.xml",
321 "Cbask_All_Tourn_Teams_XML.xml",
322 "CBASK_AssistsXML.xml",
323 "Cbask_Awards_XML.xml",
324 "CBASK_BlocksXML.xml",
325 "Cbask_Conf_Standings_XML.xml",
326 "Cbask_DivII_III_Indv_Stats_XML.xml",
327 "Cbask_DivII_Team_Stats_XML.xml",
328 "Cbask_DivIII_Team_Stats_XML.xml",
329 "CBASK_FGPctXML.xml",
330 "CBASK_FoulsXML.xml",
331 "CBASK_FTPctXML.xml",
332 "Cbask_Indv_Scoring_XML.xml",
333 "CBASK_MinutesXML.xml",
334 "Cbask_Polls_XML.xml",
335 "CBASK_ReboundsXML.xml",
336 "CBASK_ScoringLeadersXML.xml",
337 "Cbask_Team_ThreePT_Made_XML.xml",
338 "Cbask_Team_ThreePT_PCT_XML.xml",
339 "Cbask_Team_Win_Pct_XML.xml",
340 "Cbask_Top_Twenty_Five_XML.xml",
341 "CBASK_TopTwentyFiveResult_XML.xml",
342 "Cbask_Tourn_Awards_XML.xml",
343 "Cbask_Tourn_Champs_XML.xml",
344 "Cbask_Tourn_Indiv_XML.xml",
345 "Cbask_Tourn_Leaders_XML.xml",
346 "Cbask_Tourn_MVP_XML.xml",
347 "Cbask_Tourn_Records_XML.xml",
348 "LeagueScheduleXML.xml",
349 "minorscoresxml.xml",
350 "Minor_Baseball_League_Leaders_XML.xml",
351 "Minor_Baseball_Standings_XML.xml",
352 "Minor_Baseball_Transactions_XML.xml",
353 "mlbbattingavgxml.xml",
354 "mlbdoublesleadersxml.xml",
355 "MLBGamesPlayedXML.xml",
357 "MLBHitByPitchXML.xml",
358 "mlbhitsleadersxml.xml",
359 "mlbhomerunsxml.xml",
361 "MLBIntWalksXML.xml",
363 "mlbonbasepctxml.xml",
365 "MLBPlateAppsXML.xml",
367 "mlbrunsleadersxml.xml",
368 "MLBSacFliesXML.xml",
369 "MLBSacrificesXML.xml",
370 "MLBSBSuccessXML.xml",
371 "mlbsluggingpctxml.xml",
373 "mlbstandxml_preseason.xml",
374 "mlbstolenbasexml.xml",
375 "mlbtotalbasesleadersxml.xml",
376 "mlbtriplesleadersxml.xml",
377 "MLBWalkRateXML.xml",
378 "mlbwalksleadersxml.xml",
379 "MLBXtraBaseHitsXML.xml",
380 "MLB_ERA_Leaders.xml",
381 "MLB_Pitching_Appearances_Leaders.xml",
382 "MLB_Pitching_Balks_Leaders.xml",
383 "MLB_Pitching_CG_Leaders.xml",
384 "MLB_Pitching_ER_Allowed_Leaders.xml",
385 "MLB_Pitching_Hits_Allowed_Leaders.xml",
386 "MLB_Pitching_Hit_Batters_Leaders.xml",
387 "MLB_Pitching_HR_Allowed_Leaders.xml",
388 "MLB_Pitching_IP_Leaders.xml",
389 "MLB_Pitching_Runs_Allowed_Leaders.xml",
390 "MLB_Pitching_Saves_Leaders.xml",
391 "MLB_Pitching_Shut_Outs_Leaders.xml",
392 "MLB_Pitching_Starts_Leaders.xml",
393 "MLB_Pitching_Strike_Outs_Leaders.xml",
394 "MLB_Pitching_Walks_Leaders.xml",
395 "MLB_Pitching_WHIP_Leaders.xml",
396 "MLB_Pitching_Wild_Pitches_Leaders.xml",
397 "MLB_Pitching_Win_Percentage_Leaders.xml",
398 "MLB_Pitching_WL_Leaders.xml",
399 "NBA_Team_Stats_XML.xml",
405 "nbadivisionsxml.xml",
410 "NBAReboundsXML.xml",
414 "nbateamleadersxml.xml",
415 "nbatripledoublexml.xml",
416 "NBATurnoversXML.xml",
417 "NCAA_Conference_Schedule_XML.xml",
418 "nflfirstdownxml.xml"
423 -- | Make sure we can parse every element of 'sport_info_test_files'.
425 test_parse_xml_succeeds :: TestTree
426 test_parse_xml_succeeds =
427 testGroup "parse_xml" $ map check sport_info_test_files
429 check t = testCase t $ do
430 x <- unsafe_read_document t
431 let result = parse_xml "dummy" x
432 let actual = case result of -- isRight appears in base-4.7
439 -- | Ensure that each element of 'sport_info_test_files' can be imported
440 -- by counting the total number of database records (after
441 -- importing) and comparing it against the length of
442 -- 'sport_info_test_files'.
444 test_dbimport_succeeds :: TestTree
445 test_dbimport_succeeds = testCase "dbimport succeeds" $ do
446 xmltrees <- mapM unsafe_read_document sport_info_test_files
447 let msgs = rights $ map (parse_xml "dummy") xmltrees
448 actual <- withSqliteConn ":memory:" $ runDbConn $ do
449 runMigration silentMigrationLogger $ do
450 migrate (undefined :: SportInfo)
452 countAll (undefined :: SportInfo)
456 expected = length sport_info_test_files