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 xml
82 "Cbask_Indv_Scoring_XML.dtd",
83 "Cbask_Indv_Shooting_XML.dtd", -- no xml
84 "CBASK_MinutesXML.dtd",
85 "Cbask_Polls_XML.dtd",
86 "CBASK_ReboundsXML.dtd",
87 "CBASK_ScoringLeadersXML.dtd",
88 "CBASK_StealsXML.dtd", -- no xml
89 "Cbask_Team_Scoring_Rebound_Margin_XML.dtd", -- no xml
90 "Cbask_Team_Scoring_XML.dtd", -- no xml
91 "Cbask_Team_Shooting_Pct_XML.dtd", -- no xml
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",
176 "NFLGiveTakeXML.dtd",
177 "NFLGrassTurfDomeOutsideXML.dtd", -- no xml
178 "NFLInside20XML.dtd",
179 "NFLInterceptionLeadersXML.dtd", -- no xml
180 "NFLKickoffsXML.dtd",
181 "NFLMondayNightXML.dtd",
182 "NFLPassingLeadersXML.dtd", -- no xml
183 "NFLPassLeadXML.dtd",
184 "NFLQBStartsXML.dtd",
185 "NFLReceivingLeadersXML.dtd", -- no xml
186 "NFLRushingLeadersXML.dtd", -- no xml
187 "NFLSackLeadersXML.dtd",
189 "NFLTackleFFLeadersXML.dtd", -- no xml
190 "NFLTeamRankingsXML.dtd",
191 "NFLTopKickoffReturnXML.dtd", -- no xml
192 "NFLTopPerformanceXML.dtd",
193 "NFLTopPuntReturnXML.dtd", -- no xml
194 "NFLTotalYardageXML.dtd",
195 "NFLYardsXML.dtd", -- no xml
196 "NFL_KickingLeaders_XML.dtd",
197 "NFL_NBA_Draft_XML.dtd",
198 "NFL_PuntingLeaders_XML.dtd", -- no xml
199 "NFL_Roster_XML.dtd",
200 "NFL_Team_Stats_XML.dtd",
201 "Transactions_XML.dtd",
202 "Weekly_Sched_XML.dtd",
203 "WNBA_Team_Leaders_XML.dtd",
205 "WNBAAssistsXML.dtd",
210 "WNBAMinutesXML.dtd",
211 "WNBAReboundsXML.dtd",
212 "WNBAScorersXML.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",
419 "NFLFumbleLeaderXML.xml",
420 "NFLGiveTakeXML.xml",
421 "NFLInside20XML.xml",
422 "NFLKickoffsXML.xml",
423 "NFLMondayNightXML.xml",
424 "NFLPassLeadXML.xml",
425 "NFLQBStartsXML.xml",
426 "NFLSackLeadersXML.xml",
428 "NFLTeamRankingsXML.xml",
429 "NFLTopPerformanceXML.xml",
430 "NFLTotalYardageXML.xml",
431 "NFL_KickingLeaders_XML.xml",
432 "NFL_NBA_Draft_XML.xml",
433 "NFL_Roster_XML.xml",
434 "NFL_Team_Stats_XML.xml",
435 "Transactions_XML.xml",
436 "Weekly_Sched_XML.xml",
437 "WNBA_Team_Leaders_XML.xml",
439 "WNBAAssistsXML.xml",
444 "WNBAMinutesXML.xml",
445 "WNBAReboundsXML.xml",
446 "WNBAScorersXML.xml",
452 -- | Make sure we can parse every element of 'sport_info_test_files'.
454 test_parse_xml_succeeds :: TestTree
455 test_parse_xml_succeeds =
456 testGroup "parse_xml" $ map check sport_info_test_files
458 check t = testCase t $ do
459 x <- unsafe_read_document t
460 let result = parse_xml "dummy" x
461 let actual = case result of -- isRight appears in base-4.7
468 -- | Ensure that each element of 'sport_info_test_files' can be imported
469 -- by counting the total number of database records (after
470 -- importing) and comparing it against the length of
471 -- 'sport_info_test_files'.
473 test_dbimport_succeeds :: TestTree
474 test_dbimport_succeeds = testCase "dbimport succeeds" $ do
475 xmltrees <- mapM unsafe_read_document sport_info_test_files
476 let msgs = rights $ map (parse_xml "dummy") xmltrees
477 actual <- withSqliteConn ":memory:" $ runDbConn $ do
478 runMigration silentMigrationLogger $ do
479 migrate (undefined :: SportInfo)
481 countAll (undefined :: SportInfo)
485 expected = length sport_info_test_files