From 2bf6ea31afc5d87e2c953d44ff89ff7e4ec73c32 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Sat, 5 Jul 2014 20:49:34 -0400 Subject: [PATCH] Remove redundant XML representations of Game/SportInfo. Add silly Game/SportInfo tests to mask unused field warnings. --- src/TSN/XML/GameInfo.hs | 95 ++++++++++++++++++--------------------- src/TSN/XML/SportInfo.hs | 96 ++++++++++++++++++---------------------- 2 files changed, 85 insertions(+), 106 deletions(-) diff --git a/src/TSN/XML/GameInfo.hs b/src/TSN/XML/GameInfo.hs index b13edd7..bc68f42 100644 --- a/src/TSN/XML/GameInfo.hs +++ b/src/TSN/XML/GameInfo.hs @@ -25,12 +25,14 @@ import Data.String.Utils ( replace ) import Data.Time.Clock ( UTCTime ) import Database.Groundhog ( countAll, + insert_, migrate, runMigration, silentMigrationLogger ) import Database.Groundhog.Generic ( runDbConn ) import Database.Groundhog.Sqlite ( withSqliteConn ) import Database.Groundhog.TH ( + defaultCodegenConfig, groundhog, mkPersist ) import Test.Tasty ( TestTree, testGroup ) @@ -39,7 +41,6 @@ import Text.XML.HXT.Core ( XmlTree ) import Text.XML.HXT.DOM.ShowXml ( xshow ) -- Local imports. -import TSN.Codegen ( tsn_codegen_config ) import TSN.DbImport ( DbImport(..), ImportResult(..), @@ -48,11 +49,7 @@ import TSN.Parse ( parse_message, parse_xmlfid, parse_xml_time_stamp ) -import TSN.XmlImport ( XmlImport(..) ) -import Xml ( - FromXml(..), - ToDb(..), - unsafe_read_document ) +import Xml ( unsafe_read_document ) -- | The DTDs for everything that we consider \"Game Info.\" @@ -84,77 +81,47 @@ dtds = "WorldBaseballPreviewXML.dtd" ] --- | XML representation of a GameInfo \. +-- | This serves as both the database and XML representation of a +-- GameInfo \. -- -data Message = - Message { - xml_dtd :: String, - xml_xml_file_id :: Int, - xml_time_stamp :: UTCTime, - xml_xml :: String } +data GameInfo = + GameInfo { + dtd :: String, + xml_file_id :: Int, + time_stamp :: UTCTime, + xml :: String } deriving (Eq, Show) --- | Attempt to parse a 'Message' from an 'XmlTree'. If we cannot, +-- | Attempt to parse a 'GameInfo' from an 'XmlTree'. If we cannot, -- we fail with an error message. -- -parse_xml :: String -> XmlTree -> Either String Message +parse_xml :: String -> XmlTree -> Either String GameInfo parse_xml dtdname xmltree = do xmlfid <- parse_xmlfid xmltree timestamp <- parse_xml_time_stamp xmltree message <- parse_message xmltree - return $ Message dtdname (fromInteger xmlfid) timestamp (xshow [message]) - - --- | Database representation of a 'Message'. --- -data GameInfo = - GameInfo { - db_dtd :: String, - db_xml_file_id :: Int, - db_time_stamp :: UTCTime, - db_xml :: String } - - -instance ToDb Message where - -- | The database analogue of a 'Message' is an 'GameInfo'. - type Db Message = GameInfo - -instance FromXml Message where - -- | The XML to DB conversion is trivial here. - -- - from_xml Message{..} = GameInfo { - db_dtd = xml_dtd, - db_xml_file_id = xml_xml_file_id, - db_time_stamp = xml_time_stamp, - db_xml = xml_xml } - - --- | This allows us to insert the XML representation 'Message' --- directly. --- -instance XmlImport Message - + return $ GameInfo dtdname (fromInteger xmlfid) timestamp (xshow [message]) -- -- Database code -- -instance DbImport Message where +instance DbImport GameInfo where dbmigrate _ = run_dbmigrate $ migrate (undefined :: GameInfo) - -- | We import a 'Message' by inserting the whole thing at + -- | We import a 'GameInfo' by inserting the whole thing at -- once. Nothing fancy going on here. dbimport msg = do - insert_xml_ msg + insert_ msg return ImportSucceeded -- | The database schema for GameInfo is trivial; all we need is for -- the XML_File_ID to be unique. -- -mkPersist tsn_codegen_config [groundhog| +mkPersist defaultCodegenConfig [groundhog| - entity: GameInfo constructors: - name: GameInfo @@ -162,7 +129,7 @@ mkPersist tsn_codegen_config [groundhog| - name: unique_game_info type: constraint # Prevent multiple imports of the same message. - fields: [db_xml_file_id] + fields: [xml_file_id] |] @@ -176,10 +143,32 @@ game_info_tests :: TestTree game_info_tests = testGroup "GameInfo tests" - [ test_parse_xml_succeeds, + [ test_accessors, + test_parse_xml_succeeds, test_dbimport_succeeds ] +-- | Make sure the accessors work and that we can parse one file. Ok, +-- so the real point of this is to make the unused fields (dtd, xml, +-- ...) warning go away without having to mangle the groundhog code. +-- +test_accessors :: TestTree +test_accessors = testCase "we can access a parsed game_info" $ do + xmltree <- unsafe_read_document "test/xml/gameinfo/recapxml.xml" + let Right t = parse_xml "recapxml.dtd" xmltree + let a1 = dtd t + let ex1 = "recapxml.dtd" + let a2 = xml_file_id t + let ex2 = 21201550 + let a3 = show $ time_stamp t + let ex3 = "2014-05-31 20:13:00 UTC" + let a4 = take 9 (xml t) + let ex4 = "" + let actual = (a1,a2,a3,a4) + let expected = (ex1,ex2,ex3,ex4) + actual @?= expected + + -- | Sample XML documents for GameInfo types. -- game_info_test_files :: [FilePath] diff --git a/src/TSN/XML/SportInfo.hs b/src/TSN/XML/SportInfo.hs index 7c5f1ac..0ceba41 100644 --- a/src/TSN/XML/SportInfo.hs +++ b/src/TSN/XML/SportInfo.hs @@ -10,7 +10,7 @@ -- database along with the XML_File_ID, but we don't parse any of it. -- -- This is almost completely redundant with "TSN.XML.GameInfo", but --- the redundancy is necessary: we need separate 'Message' types so +-- the redundancy is necessary: we need separate message types so -- that we can have separate 'DbImport' instances. It would take -- more code/work to abstract (if it's even possible) than to -- duplicate. @@ -29,12 +29,14 @@ import Data.String.Utils ( replace ) import Data.Time.Clock ( UTCTime ) import Database.Groundhog ( countAll, + insert_, migrate, runMigration, silentMigrationLogger ) import Database.Groundhog.Generic ( runDbConn ) import Database.Groundhog.Sqlite ( withSqliteConn ) import Database.Groundhog.TH ( + defaultCodegenConfig, groundhog, mkPersist ) import Test.Tasty ( TestTree, testGroup ) @@ -43,7 +45,6 @@ import Text.XML.HXT.Core ( XmlTree ) import Text.XML.HXT.DOM.ShowXml ( xshow ) -- Local imports. -import TSN.Codegen ( tsn_codegen_config ) import TSN.DbImport ( DbImport(..), ImportResult(..), @@ -52,11 +53,7 @@ import TSN.Parse ( parse_message, parse_xmlfid, parse_xml_time_stamp ) -import TSN.XmlImport ( XmlImport(..) ) -import Xml ( - FromXml(..), - ToDb(..), - unsafe_read_document ) +import Xml ( unsafe_read_document ) -- | The DTDs for everything that we consider \"Sport Info.\" @@ -196,77 +193,48 @@ dtds = "WNBATurnoversXML.dtd" ] --- | XML representation of a SportInfo \. +-- | This serves as both the database and XML representation of a +-- SportInfo \. -- -data Message = - Message { - xml_dtd :: String, - xml_xml_file_id :: Int, - xml_time_stamp :: UTCTime, - xml_xml :: String } +data SportInfo = + SportInfo { + dtd :: String, + xml_file_id :: Int, + time_stamp :: UTCTime, + xml :: String } deriving (Eq, Show) --- | Attempt to parse a 'Message' from an 'XmlTree'. If we cannot, +-- | Attempt to parse a 'SportInfo' from an 'XmlTree'. If we cannot, -- we fail with an error message. -- -parse_xml :: String -> XmlTree -> Either String Message +parse_xml :: String -> XmlTree -> Either String SportInfo parse_xml dtdname xmltree = do xmlfid <- parse_xmlfid xmltree timestamp <- parse_xml_time_stamp xmltree message <- parse_message xmltree - return $ Message dtdname (fromInteger xmlfid) timestamp (xshow [message]) - - --- | Database representation of a 'Message'. --- -data SportInfo = - SportInfo { - db_dtd :: String, - db_xml_file_id :: Int, - db_time_stamp :: UTCTime, - db_xml :: String } - - -instance ToDb Message where - -- | The database analogue of a 'Message' is an 'SportInfo'. - type Db Message = SportInfo - -instance FromXml Message where - -- | The XML to DB conversion is trivial here. - -- - from_xml Message{..} = SportInfo { - db_dtd = xml_dtd, - db_xml_file_id = xml_xml_file_id, - db_time_stamp = xml_time_stamp, - db_xml = xml_xml } - - --- | This allows us to insert the XML representation 'Message' --- directly. --- -instance XmlImport Message + return $ SportInfo dtdname (fromInteger xmlfid) timestamp (xshow [message]) -- -- Database code -- -instance DbImport Message where +instance DbImport SportInfo where dbmigrate _ = run_dbmigrate $ migrate (undefined :: SportInfo) - -- | We import a 'Message' by inserting the whole thing at + -- | We import a 'SportInfo' by inserting the whole thing at -- once. Nothing fancy going on here. dbimport msg = do - insert_xml_ msg + insert_ msg return ImportSucceeded -- | The database schema for SportInfo is trivial; all we need is for -- the XML_File_ID to be unique. -- -mkPersist tsn_codegen_config [groundhog| +mkPersist defaultCodegenConfig [groundhog| - entity: SportInfo constructors: - name: SportInfo @@ -274,7 +242,7 @@ mkPersist tsn_codegen_config [groundhog| - name: unique_sport_info type: constraint # Prevent multiple imports of the same message. - fields: [db_xml_file_id] + fields: [xml_file_id] |] @@ -288,10 +256,32 @@ sport_info_tests :: TestTree sport_info_tests = testGroup "SportInfo tests" - [ test_parse_xml_succeeds, + [ test_accessors, + test_parse_xml_succeeds, test_dbimport_succeeds ] +-- | Make sure the accessors work and that we can parse one file. Ok, +-- so the real point of this is to make the unused fields (dtd, xml, +-- ...) warning go away without having to mangle the groundhog code. +-- +test_accessors :: TestTree +test_accessors = testCase "we can access a parsed sport_info" $ do + xmltree <- unsafe_read_document "test/xml/sportinfo/wnbastandxml.xml" + let Right t = parse_xml "wnbastandxml.dtd" xmltree + let a1 = dtd t + let ex1 = "wnbastandxml.dtd" + let a2 = xml_file_id t + let ex2 = 2011 + let a3 = show $ time_stamp t + let ex3 = "2009-09-28 00:50:00 UTC" + let a4 = take 9 (xml t) + let ex4 = "" + let actual = (a1,a2,a3,a4) + let expected = (ex1,ex2,ex3,ex4) + actual @?= expected + + -- | Sample XML documents for SportInfo types. -- sport_info_test_files :: [FilePath] -- 2.43.2