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 (
34 silentMigrationLogger )
35 import Database.Groundhog.Generic ( runDbConn )
36 import Database.Groundhog.Sqlite ( withSqliteConn )
37 import Database.Groundhog.TH (
40 import Test.Tasty ( TestTree, testGroup )
41 import Test.Tasty.HUnit ( (@?=), testCase )
42 import Text.XML.HXT.Core ( XmlTree )
43 import Text.XML.HXT.DOM.ShowXml ( xshow )
46 import TSN.Codegen ( tsn_codegen_config )
54 parse_xml_time_stamp )
55 import TSN.XmlImport ( XmlImport(..) )
59 unsafe_read_document )
62 -- | The DTDs for everything that we consider \"Sport Info.\"
66 [ "CBASK_3PPctXML.dtd",
67 "Cbask_All_Tourn_Teams_XML.dtd",
68 "CBASK_AssistsXML.dtd",
69 "Cbask_Awards_XML.dtd",
70 "CBASK_BlocksXML.dtd",
71 "Cbask_Conf_Standings_XML.dtd",
72 "Cbask_DivII_III_Indv_Stats_XML.dtd",
73 "Cbask_DivII_Team_Stats_XML.dtd",
74 "Cbask_DivIII_Team_Stats_XML.dtd",
78 "Cbask_Indv_Scoring_XML.dtd",
79 "CBASK_MinutesXML.dtd",
80 "Cbask_Polls_XML.dtd",
81 "CBASK_ReboundsXML.dtd",
82 "CBASK_ScoringLeadersXML.dtd",
83 "Cbask_Team_ThreePT_Made_XML.dtd",
84 "Cbask_Team_ThreePT_PCT_XML.dtd",
85 "Cbask_Team_Win_Pct_XML.dtd",
86 "Cbask_Top_Twenty_Five_XML.dtd",
87 "CBASK_TopTwentyFiveResult_XML.dtd",
88 "Cbask_Tourn_Awards_XML.dtd",
89 "Cbask_Tourn_Champs_XML.dtd",
90 "Cbask_Tourn_Indiv_XML.dtd",
91 "Cbask_Tourn_Leaders_XML.dtd",
92 "Cbask_Tourn_MVP_XML.dtd",
93 "Cbask_Tourn_Records_XML.dtd",
94 "LeagueScheduleXML.dtd",
96 "Minor_Baseball_League_Leaders_XML.dtd",
97 "Minor_Baseball_Standings_XML.dtd",
98 "Minor_Baseball_Transactions_XML.dtd",
99 "mlbbattingavgxml.dtd",
100 "mlbdoublesleadersxml.dtd",
101 "MLBGamesPlayedXML.dtd",
103 "MLBHitByPitchXML.dtd",
104 "mlbhitsleadersxml.dtd",
105 "mlbhomerunsxml.dtd",
107 "MLBIntWalksXML.dtd",
109 "mlbonbasepctxml.dtd",
111 "MLBPlateAppsXML.dtd",
113 "mlbrunsleadersxml.dtd",
114 "MLBSacFliesXML.dtd",
115 "MLBSacrificesXML.dtd",
116 "MLBSBSuccessXML.dtd",
117 "mlbsluggingpctxml.dtd",
119 "mlbstandxml_preseason.dtd",
120 "mlbstolenbasexml.dtd",
121 "mlbtotalbasesleadersxml.dtd",
122 "mlbtriplesleadersxml.dtd",
123 "MLBWalkRateXML.dtd",
124 "mlbwalksleadersxml.dtd",
125 "MLBXtraBaseHitsXML.dtd",
126 "MLB_ERA_Leaders.dtd",
127 "MLB_Fielding_XML.dtd",
128 "MLB_Pitching_Appearances_Leaders.dtd",
129 "MLB_Pitching_Balks_Leaders.dtd",
130 "MLB_Pitching_CG_Leaders.dtd",
131 "MLB_Pitching_ER_Allowed_Leaders.dtd",
132 "MLB_Pitching_Hits_Allowed_Leaders.dtd",
133 "MLB_Pitching_Hit_Batters_Leaders.dtd",
134 "MLB_Pitching_HR_Allowed_Leaders.dtd",
135 "MLB_Pitching_IP_Leaders.dtd",
136 "MLB_Pitching_Runs_Allowed_Leaders.dtd",
137 "MLB_Pitching_Saves_Leaders.dtd",
138 "MLB_Pitching_Shut_Outs_Leaders.dtd",
139 "MLB_Pitching_Starts_Leaders.dtd",
140 "MLB_Pitching_Strike_Outs_Leaders.dtd",
141 "MLB_Pitching_Walks_Leaders.dtd",
142 "MLB_Pitching_WHIP_Leaders.dtd",
143 "MLB_Pitching_Wild_Pitches_Leaders.dtd",
144 "MLB_Pitching_Win_Percentage_Leaders.dtd",
145 "MLB_Pitching_WL_Leaders.dtd",
146 "NBA_Team_Stats_XML.dtd",
152 "nbadivisionsxml.dtd",
157 "NBAReboundsXML.dtd",
161 "nbateamleadersxml.dtd",
162 "nbatripledoublexml.dtd",
163 "NBATurnoversXML.dtd",
164 "NCAA_Conference_Schedule_XML.dtd",
165 "nflfirstdownxml.dtd",
166 "NFLFumbleLeaderXML.dtd",
167 "NFLGiveTakeXML.dtd",
168 "NFLInside20XML.dtd",
169 "NFLKickoffsXML.dtd",
170 "NFLMondayNightXML.dtd",
171 "NFLPassLeadXML.dtd",
172 "NFLQBStartsXML.dtd",
173 "NFLSackLeadersXML.dtd",
175 "NFLTeamRankingsXML.dtd",
176 "NFLTopPerformanceXML.dtd",
177 "NFLTotalYardageXML.dtd",
178 "NFL_KickingLeaders_XML.dtd",
179 "NFL_NBA_Draft_XML.dtd",
180 "NFL_Roster_XML.dtd",
181 "NFL_Team_Stats_XML.dtd",
182 "Transactions_XML.dtd",
183 "Weekly_Sched_XML.dtd",
184 "WNBA_Team_Leaders_XML.dtd",
186 "WNBAAssistsXML.dtd",
191 "WNBAMinutesXML.dtd",
192 "WNBAReboundsXML.dtd",
193 "WNBAScorersXML.dtd",
196 "WNBATurnoversXML.dtd" ]
199 -- | XML representation of a SportInfo \<message\>.
204 xml_xml_file_id :: Int,
205 xml_time_stamp :: UTCTime,
210 -- | Attempt to parse a 'Message' from an 'XmlTree'. If we cannot,
211 -- we fail with an error message.
213 parse_xml :: String -> XmlTree -> Either String Message
214 parse_xml dtdname xmltree = do
215 xmlfid <- parse_xmlfid xmltree
216 timestamp <- parse_xml_time_stamp xmltree
217 message <- parse_message xmltree
218 return $ Message dtdname (fromInteger xmlfid) timestamp (xshow [message])
221 -- | Database representation of a 'Message'.
226 db_xml_file_id :: Int,
227 db_time_stamp :: UTCTime,
231 instance ToDb Message where
232 -- | The database analogue of a 'Message' is an 'SportInfo'.
233 type Db Message = SportInfo
235 instance FromXml Message where
236 -- | The XML to DB conversion is trivial here.
238 from_xml Message{..} = SportInfo {
240 db_xml_file_id = xml_xml_file_id,
241 db_time_stamp = xml_time_stamp,
245 -- | This allows us to insert the XML representation 'Message'
248 instance XmlImport Message
255 instance DbImport Message where
257 run_dbmigrate $ migrate (undefined :: SportInfo)
259 -- | We import a 'Message' by inserting the whole thing at
260 -- once. Nothing fancy going on here.
263 return ImportSucceeded
266 -- | The database schema for SportInfo is trivial; all we need is for
267 -- the XML_File_ID to be unique.
269 mkPersist tsn_codegen_config [groundhog|
274 - name: unique_sport_info
276 # Prevent multiple imports of the same message.
277 fields: [db_xml_file_id]
285 -- | A list of all tests for this module.
287 sport_info_tests :: TestTree
291 [ test_parse_xml_succeeds,
292 test_dbimport_succeeds ]
295 -- | Sample XML documents for SportInfo types.
297 sport_info_test_files :: [FilePath]
298 sport_info_test_files =
299 map (change_suffix . add_path) dtds
301 add_path = ("test/xml/sportinfo/" ++ )
302 change_suffix = replace ".dtd" ".xml"
305 -- | Make sure we can parse every element of 'sport_info_test_files'.
307 test_parse_xml_succeeds :: TestTree
308 test_parse_xml_succeeds =
309 testGroup "parse_xml" $ map check sport_info_test_files
311 check t = testCase t $ do
312 x <- unsafe_read_document t
313 let result = parse_xml "dummy" x
314 let actual = case result of -- isRight appears in base-4.7
321 -- | Ensure that each element of 'sport_info_test_files' can be imported
322 -- by counting the total number of database records (after
323 -- importing) and comparing it against the length of
324 -- 'sport_info_test_files'.
326 test_dbimport_succeeds :: TestTree
327 test_dbimport_succeeds = testCase "dbimport succeeds" $ do
328 xmltrees <- mapM unsafe_read_document sport_info_test_files
329 let msgs = rights $ map (parse_xml "dummy") xmltrees
330 actual <- withSqliteConn ":memory:" $ runDbConn $ do
331 runMigration silentMigrationLogger $ do
332 migrate (undefined :: SportInfo)
334 countAll (undefined :: SportInfo)
338 expected = length sport_info_test_files