1 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE QuasiQuotes #-}
4 {-# LANGUAGE RecordWildCards #-}
5 {-# LANGUAGE TemplateHaskell #-}
6 {-# LANGUAGE TypeFamilies #-}
8 -- | GameInfo 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 -- See also: TSN.XML.SportInfo
14 module TSN.XML.GameInfo (
18 -- * WARNING: these are private but exported to silence warnings
19 GameInfoConstructor(..) )
23 import Data.Either ( rights )
24 import Data.String.Utils ( replace )
25 import Data.Time.Clock ( UTCTime )
26 import Database.Groundhog (
31 silentMigrationLogger )
32 import Database.Groundhog.Generic ( runDbConn )
33 import Database.Groundhog.Sqlite ( withSqliteConn )
34 import Database.Groundhog.TH (
38 import Test.Tasty ( TestTree, testGroup )
39 import Test.Tasty.HUnit ( (@?=), testCase )
40 import Text.XML.HXT.Core ( XmlTree )
41 import Text.XML.HXT.DOM.ShowXml ( xshow )
51 parse_xml_time_stamp )
52 import Xml ( unsafe_read_document )
55 -- | The DTDs for everything that we consider \"Game Info.\"
57 -- TODO: This is the list from the old implementation. We need to
58 -- make sure that we are really receiving XML for these DTDs
59 -- (i.e. the names are correct).
63 [ "CBASK_Lineup_XML.dtd",
64 "cbaskpreviewxml.dtd",
66 "Matchup_NBA_NHL_XML.dtd",
68 "MLB_Gaming_Matchup_XML.dtd",
70 "MLB_Matchup_XML.dtd",
71 "MLS_Preview_XML.dtd",
72 "NBA_Gaming_Matchup_XML.dtd",
73 "NBA_Playoff_Matchup_XML.dtd",
76 "NCAA_FB_Preview_XML.dtd",
78 "NFL_NCAA_FB_Matchup_XML.dtd",
81 "WorldBaseballPreviewXML.dtd" ]
84 -- | This serves as both the database and XML representation of a
85 -- GameInfo \<message\>.
91 time_stamp :: UTCTime,
96 -- | Attempt to parse a 'GameInfo' from an 'XmlTree'. If we cannot,
97 -- we fail with an error message.
99 parse_xml :: String -> XmlTree -> Either String GameInfo
100 parse_xml dtdname xmltree = do
101 xmlfid <- parse_xmlfid xmltree
102 timestamp <- parse_xml_time_stamp xmltree
103 message <- parse_message xmltree
104 return $ GameInfo dtdname (fromInteger xmlfid) timestamp (xshow [message])
110 instance DbImport GameInfo where
112 run_dbmigrate $ migrate (undefined :: GameInfo)
114 -- | We import a 'GameInfo' by inserting the whole thing at
115 -- once. Nothing fancy going on here.
118 return ImportSucceeded
121 -- | The database schema for GameInfo is trivial; all we need is for
122 -- the XML_File_ID to be unique.
124 mkPersist defaultCodegenConfig [groundhog|
130 - name: unique_game_info
132 # Prevent multiple imports of the same message.
133 fields: [xml_file_id]
141 -- | A list of all tests for this module.
143 game_info_tests :: TestTree
148 test_parse_xml_succeeds,
149 test_dbimport_succeeds ]
152 -- | Make sure the accessors work and that we can parse one file. Ok,
153 -- so the real point of this is to make the unused fields (dtd, xml,
154 -- ...) warning go away without having to mangle the groundhog code.
156 test_accessors :: TestTree
157 test_accessors = testCase "we can access a parsed game_info" $ do
158 xmltree <- unsafe_read_document "test/xml/gameinfo/recapxml.xml"
159 let Right t = parse_xml "recapxml.dtd" xmltree
161 let ex1 = "recapxml.dtd"
162 let a2 = xml_file_id t
164 let a3 = show $ time_stamp t
165 let ex3 = "2014-05-31 20:13:00 UTC"
166 let a4 = take 9 (xml t)
167 let ex4 = "<message>"
168 let actual = (a1,a2,a3,a4)
169 let expected = (ex1,ex2,ex3,ex4)
173 -- | Sample XML documents for GameInfo types.
175 game_info_test_files :: [FilePath]
176 game_info_test_files =
177 map (change_suffix . add_path) dtds
179 add_path = ("test/xml/gameinfo/" ++ )
180 change_suffix = replace ".dtd" ".xml"
182 -- | Make sure we can parse every element of 'game_info_test_files'.
184 test_parse_xml_succeeds :: TestTree
185 test_parse_xml_succeeds =
186 testGroup "parse_xml" $ map check game_info_test_files
188 check t = testCase t $ do
189 x <- unsafe_read_document t
190 let result = parse_xml "dummy" x
191 let actual = case result of -- isRight appears in base-4.7
198 -- | Ensure that each element of 'game_info_test_files' can be imported
199 -- by counting the total number of database records (after
200 -- importing) and comparing it against the length of
201 -- 'game_info_test_files'.
203 test_dbimport_succeeds :: TestTree
204 test_dbimport_succeeds = testCase "dbimport succeeds" $ do
205 xmltrees <- mapM unsafe_read_document game_info_test_files
206 let msgs = rights $ map (parse_xml "dummy") xmltrees
207 actual <- withSqliteConn ":memory:" $ runDbConn $ do
208 runMigration silentMigrationLogger $
209 migrate (undefined :: GameInfo)
211 countAll (undefined :: GameInfo)
215 expected = length game_info_test_files