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.String.Utils ( replace )
29 import Data.Time.Clock ( UTCTime )
30 import Database.Groundhog (
35 silentMigrationLogger )
36 import Database.Groundhog.Generic ( runDbConn )
37 import Database.Groundhog.Sqlite ( withSqliteConn )
38 import Database.Groundhog.TH (
42 import Test.Tasty ( TestTree, testGroup )
43 import Test.Tasty.HUnit ( (@?=), testCase )
44 import Text.XML.HXT.Core ( XmlTree )
45 import Text.XML.HXT.DOM.ShowXml ( xshow )
56 parse_xml_time_stamp )
57 import Xml ( unsafe_read_document )
60 -- | The DTDs for everything that we consider \"Sport Info.\"
64 [ "CBASK_3PPctXML.dtd",
65 "Cbask_All_Tourn_Teams_XML.dtd",
66 "CBASK_AssistsXML.dtd",
67 "Cbask_Awards_XML.dtd",
68 "CBASK_BlocksXML.dtd",
69 "Cbask_Conf_Standings_XML.dtd",
70 "Cbask_DivII_III_Indv_Stats_XML.dtd",
71 "Cbask_DivII_Team_Stats_XML.dtd",
72 "Cbask_DivIII_Team_Stats_XML.dtd",
76 "Cbask_Indv_No_Avg_XML.dtd",
77 "Cbask_Indv_Scoring_XML.dtd",
78 "Cbask_Indv_Shooting_XML.dtd",
79 "CBASK_MinutesXML.dtd",
80 "Cbask_Polls_XML.dtd",
81 "CBASK_ReboundsXML.dtd",
82 "CBASK_ScoringLeadersXML.dtd",
83 "Cbask_Team_Scoring_Rebound_Margin_XML.dtd",
84 "Cbask_Team_Scoring_XML.dtd",
85 "Cbask_Team_Shooting_Pct_XML.dtd",
86 "Cbask_Team_ThreePT_Made_XML.dtd",
87 "Cbask_Team_ThreePT_PCT_XML.dtd",
88 "Cbask_Team_Win_Pct_XML.dtd",
89 "Cbask_Top_Twenty_Five_XML.dtd",
90 "CBASK_TopTwentyFiveResult_XML.dtd",
91 "Cbask_Tourn_Awards_XML.dtd",
92 "Cbask_Tourn_Champs_XML.dtd",
93 "Cbask_Tourn_Indiv_XML.dtd",
94 "Cbask_Tourn_Leaders_XML.dtd",
95 "Cbask_Tourn_MVP_XML.dtd",
96 "Cbask_Tourn_Records_XML.dtd",
97 "LeagueScheduleXML.dtd",
99 "Minor_Baseball_League_Leaders_XML.dtd",
100 "Minor_Baseball_Standings_XML.dtd",
101 "Minor_Baseball_Transactions_XML.dtd",
102 "mlbbattingavgxml.dtd",
103 "mlbdoublesleadersxml.dtd",
104 "MLBGamesPlayedXML.dtd",
106 "MLBHitByPitchXML.dtd",
107 "mlbhitsleadersxml.dtd",
108 "mlbhomerunsxml.dtd",
110 "MLBIntWalksXML.dtd",
112 "mlbonbasepctxml.dtd",
114 "MLBPlateAppsXML.dtd",
116 "mlbrunsleadersxml.dtd",
117 "MLBSacFliesXML.dtd",
118 "MLBSacrificesXML.dtd",
119 "MLBSBSuccessXML.dtd",
120 "mlbsluggingpctxml.dtd",
122 "mlbstandxml_preseason.dtd",
123 "mlbstolenbasexml.dtd",
124 "mlbtotalbasesleadersxml.dtd",
125 "mlbtriplesleadersxml.dtd",
126 "MLBWalkRateXML.dtd",
127 "mlbwalksleadersxml.dtd",
128 "MLBXtraBaseHitsXML.dtd",
129 "MLB_ERA_Leaders.dtd",
130 "MLB_Fielding_XML.dtd",
131 "MLB_Pitching_Appearances_Leaders.dtd",
132 "MLB_Pitching_Balks_Leaders.dtd",
133 "MLB_Pitching_CG_Leaders.dtd",
134 "MLB_Pitching_ER_Allowed_Leaders.dtd",
135 "MLB_Pitching_Hits_Allowed_Leaders.dtd",
136 "MLB_Pitching_Hit_Batters_Leaders.dtd",
137 "MLB_Pitching_HR_Allowed_Leaders.dtd",
138 "MLB_Pitching_IP_Leaders.dtd",
139 "MLB_Pitching_Runs_Allowed_Leaders.dtd",
140 "MLB_Pitching_Saves_Leaders.dtd",
141 "MLB_Pitching_Shut_Outs_Leaders.dtd",
142 "MLB_Pitching_Starts_Leaders.dtd",
143 "MLB_Pitching_Strike_Outs_Leaders.dtd",
144 "MLB_Pitching_Walks_Leaders.dtd",
145 "MLB_Pitching_WHIP_Leaders.dtd",
146 "MLB_Pitching_Wild_Pitches_Leaders.dtd",
147 "MLB_Pitching_Win_Percentage_Leaders.dtd",
148 "MLB_Pitching_WL_Leaders.dtd",
149 "NBA_Team_Stats_XML.dtd",
155 "nbadivisionsxml.dtd",
160 "NBAReboundsXML.dtd",
164 "nbateamleadersxml.dtd",
165 "nbatripledoublexml.dtd",
166 "NBATurnoversXML.dtd",
167 "NCAA_Conference_Schedule_XML.dtd",
168 "nflfirstdownxml.dtd",
169 "NFLFumbleLeaderXML.dtd",
170 "NFLGrassTurfDomeOutsideXML.dtd",
171 "NFLGiveTakeXML.dtd",
172 "NFLInside20XML.dtd",
173 "NFLInterceptionLeadersXML.dtd",
174 "NFLKickoffsXML.dtd",
175 "NFLMondayNightXML.dtd",
176 "NFLPassingLeadersXML.dtd",
177 "NFLPassLeadXML.dtd",
178 "NFLQBStartsXML.dtd",
179 "NFLReceivingLeadersXML.dtd",
180 "NFLRushingLeadersXML.dtd",
181 "NFLSackLeadersXML.dtd",
183 "NFLTackleFFLeadersXML.dtd",
184 "NFLTeamRankingsXML.dtd",
185 "NFLTopKickoffReturnXML.dtd",
186 "NFLTopPerformanceXML.dtd",
187 "NFLTopPuntReturnXML.dtd",
188 "NFLTotalYardageXML.dtd",
190 "NFL_KickingLeaders_XML.dtd",
191 "NFL_NBA_Draft_XML.dtd",
192 "NFL_PuntingLeaders_XML.dtd",
193 "NFL_Roster_XML.dtd",
194 "NFL_Team_Stats_XML.dtd",
195 "Transactions_XML.dtd",
196 "Weekly_Sched_XML.dtd",
197 "WNBA_Team_Leaders_XML.dtd",
199 "WNBAAssistsXML.dtd",
204 "WNBAMinutesXML.dtd",
205 "WNBAReboundsXML.dtd",
206 "WNBAScorersXML.dtd",
209 "WNBATurnoversXML.dtd" ]
212 -- | This serves as both the database and XML representation of a
213 -- SportInfo \<message\>.
219 time_stamp :: UTCTime,
224 -- | Attempt to parse a 'SportInfo' from an 'XmlTree'. If we cannot,
225 -- we fail with an error message.
227 parse_xml :: String -> XmlTree -> Either ParseError SportInfo
228 parse_xml dtdname xmltree = do
229 xmlfid <- parse_xmlfid xmltree
230 timestamp <- parse_xml_time_stamp xmltree
231 message <- parse_message xmltree
232 return $ SportInfo dtdname xmlfid timestamp (xshow [message])
239 instance DbImport SportInfo where
241 run_dbmigrate $ migrate (undefined :: SportInfo)
243 -- | We import a 'SportInfo' by inserting the whole thing at
244 -- once. Nothing fancy going on here.
247 return ImportSucceeded
250 -- | The database schema for SportInfo is trivial; all we need is for
251 -- the XML_File_ID to be unique.
253 mkPersist defaultCodegenConfig [groundhog|
259 - name: unique_sport_info
261 # Prevent multiple imports of the same message.
262 fields: [xml_file_id]
270 -- | A list of all tests for this module.
272 sport_info_tests :: TestTree
277 test_parse_xml_succeeds,
278 test_dbimport_succeeds ]
281 -- | Make sure the accessors work and that we can parse one file. Ok,
282 -- so the real point of this is to make the unused fields (dtd, xml,
283 -- ...) warning go away without having to mangle the groundhog code.
285 test_accessors :: TestTree
286 test_accessors = testCase "we can access a parsed sport_info" $ do
287 xmltree <- unsafe_read_document "test/xml/sportinfo/wnbastandxml.xml"
288 let Right t = parse_xml "wnbastandxml.dtd" xmltree
290 let ex1 = "wnbastandxml.dtd"
291 let a2 = xml_file_id t
293 let a3 = show $ time_stamp t
294 let ex3 = "2009-09-27 19:50:00 UTC"
295 let a4 = take 9 (xml t)
296 let ex4 = "<message>"
297 let actual = (a1,a2,a3,a4)
298 let expected = (ex1,ex2,ex3,ex4)
302 -- | Sample XML documents for SportInfo types.
304 sport_info_test_files :: [FilePath]
305 sport_info_test_files =
306 map (change_suffix . add_path) dtds
308 add_path = ("test/xml/sportinfo/" ++ )
309 change_suffix = replace ".dtd" ".xml"
312 -- | Make sure we can parse every element of 'sport_info_test_files'.
314 test_parse_xml_succeeds :: TestTree
315 test_parse_xml_succeeds =
316 testGroup "parse_xml" $ map check sport_info_test_files
318 check t = testCase t $ do
319 x <- unsafe_read_document t
320 let result = parse_xml "dummy" x
321 let actual = case result of -- isRight appears in base-4.7
328 -- | Ensure that each element of 'sport_info_test_files' can be imported
329 -- by counting the total number of database records (after
330 -- importing) and comparing it against the length of
331 -- 'sport_info_test_files'.
333 test_dbimport_succeeds :: TestTree
334 test_dbimport_succeeds = testCase "dbimport succeeds" $ do
335 xmltrees <- mapM unsafe_read_document sport_info_test_files
336 let msgs = rights $ map (parse_xml "dummy") xmltrees
337 actual <- withSqliteConn ":memory:" $ runDbConn $ do
338 runMigration silentMigrationLogger $
339 migrate (undefined :: SportInfo)
341 countAll (undefined :: SportInfo)
345 expected = length sport_info_test_files