From: Michael Orlitzky Date: Sat, 25 Jan 2014 01:31:08 +0000 (-0500) Subject: Export a "dtd" function from each XML module and use that instead of hard-coding... X-Git-Tag: 0.0.4~7 X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=a0853ebe00e630b7d50f97949d4dd45c602bd454;p=dead%2Fhtsn-import.git Export a "dtd" function from each XML module and use that instead of hard-coding the DTD names in Main. --- diff --git a/src/Main.hs b/src/Main.hs index 853c64d..648ddae 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -46,14 +46,17 @@ import Network.Services.TSN.Report ( report_error ) import TSN.DbImport ( DbImport(..), ImportResult(..) ) import qualified TSN.XML.AutoRacingSchedule as AutoRacingSchedule ( + dtd, pickle_message ) -import qualified TSN.XML.Heartbeat as Heartbeat ( verify ) -import qualified TSN.XML.Injuries as Injuries ( pickle_message ) -import qualified TSN.XML.InjuriesDetail as InjuriesDetail ( pickle_message ) -import qualified TSN.XML.News as News ( pickle_message ) -import qualified TSN.XML.Odds as Odds ( pickle_message ) -import qualified TSN.XML.Scores as Scores ( pickle_message ) -import qualified TSN.XML.Weather as Weather ( pickle_message ) +import qualified TSN.XML.Heartbeat as Heartbeat ( dtd, verify ) +import qualified TSN.XML.Injuries as Injuries ( dtd, pickle_message ) +import qualified TSN.XML.InjuriesDetail as InjuriesDetail ( + dtd, + pickle_message ) +import qualified TSN.XML.News as News ( dtd, pickle_message ) +import qualified TSN.XML.Odds as Odds ( dtd, pickle_message ) +import qualified TSN.XML.Scores as Scores ( dtd, pickle_message ) +import qualified TSN.XML.Weather as Weather ( dtd, pickle_message ) import Xml ( DtdName(..), parse_opts ) @@ -139,7 +142,7 @@ import_file cfg path = do import_with_dtd (DtdName dtd,xml) -- We special-case the heartbeat so it doesn't have to run in -- the database monad. - | dtd == "Heartbeat.dtd" = Heartbeat.verify xml + | dtd == Heartbeat.dtd = Heartbeat.verify xml | otherwise = -- We need NoMonomorphismRestriction here. if backend cfg == Postgres @@ -147,42 +150,42 @@ import_file cfg path = do else withSqliteConn cs $ runDbConn importer where -- | Pull the real connection String out of the configuration. + -- cs :: String cs = get_connection_string $ connection_string cfg -- | Convenience; we use this everywhere below in 'importer'. + -- migrate_and_import m = dbmigrate m >> dbimport m importer - | dtd == "Auto_Racing_Schedule_XML.dtd" = do + | dtd == AutoRacingSchedule.dtd = do let m = unpickleDoc AutoRacingSchedule.pickle_message xml - let errmsg = "Could not unpickle Auto_Racing_Schedule_XML." maybe (return $ ImportFailed errmsg) migrate_and_import m - | dtd == "injuriesxml.dtd" = do + | dtd == Injuries.dtd = do let m = unpickleDoc Injuries.pickle_message xml - let errmsg = "Could not unpickle injuriesxml." maybe (return $ ImportFailed errmsg) migrate_and_import m - | dtd == "Injuries_Detail_XML.dtd" = do + | dtd == InjuriesDetail.dtd = do let m = unpickleDoc InjuriesDetail.pickle_message xml - let errmsg = "Could not unpickle Injuries_Detail_XML." maybe (return $ ImportFailed errmsg) migrate_and_import m - | dtd == "newsxml.dtd" = do + | dtd == News.dtd = do let m = unpickleDoc News.pickle_message xml - let errmsg = "Could not unpickle newsxml." maybe (return $ ImportFailed errmsg) migrate_and_import m - | dtd == "Odds_XML.dtd" = do + | dtd == Odds.dtd = do let m = unpickleDoc Odds.pickle_message xml - let errmsg = "Could not unpickle Odds_XML." maybe (return $ ImportFailed errmsg) migrate_and_import m - | dtd == "weatherxml.dtd" = do + | dtd == Scores.dtd = do + let m = unpickleDoc Scores.pickle_message xml + maybe (return $ ImportFailed errmsg) migrate_and_import m + + | dtd == Weather.dtd = do let m = unpickleDoc Weather.pickle_message xml - let errmsg = "Could not unpickle weatherxml." maybe (return $ ImportFailed errmsg) migrate_and_import m | otherwise = do @@ -190,6 +193,9 @@ import_file cfg path = do "Unrecognized DTD in " ++ path ++ ": " ++ dtd ++ "." return $ ImportUnsupported infomsg + where + errmsg = "Could not unpickle " ++ dtd ++ "." + -- | Entry point of the program. It twiddles some knobs for -- configuration options and then calls 'import_file' on each XML diff --git a/src/TSN/XML/AutoRacingSchedule.hs b/src/TSN/XML/AutoRacingSchedule.hs index 27b73ef..ab1c29e 100644 --- a/src/TSN/XML/AutoRacingSchedule.hs +++ b/src/TSN/XML/AutoRacingSchedule.hs @@ -13,6 +13,7 @@ -- containing \s. -- module TSN.XML.AutoRacingSchedule ( + dtd, pickle_message, -- * Tests auto_racing_schedule_tests, @@ -67,6 +68,11 @@ import Xml ( unsafe_unpickle ) +-- | The DTD to which this module corresponds. Used to invoke dbimport. +-- +dtd :: String +dtd = "Auto_Racing_Schedule_XML.dtd" + -- -- DB/XML data types -- diff --git a/src/TSN/XML/Heartbeat.hs b/src/TSN/XML/Heartbeat.hs index b01e6fb..89b91ad 100644 --- a/src/TSN/XML/Heartbeat.hs +++ b/src/TSN/XML/Heartbeat.hs @@ -3,6 +3,7 @@ -- | Handle documents defined by Heartbeat.dtd. -- module TSN.XML.Heartbeat ( + dtd, verify, -- * Tests heartbeat_tests ) @@ -27,6 +28,11 @@ import TSN.DbImport ( ImportResult(..) ) import Xml ( pickle_unpickle, unpickleable ) +-- | The DTD to which this module corresponds. +-- +dtd :: String +dtd = "Heartbeat.dtd" + -- | The data structure that holds the XML representation of a -- Heartbeat message. -- diff --git a/src/TSN/XML/Injuries.hs b/src/TSN/XML/Injuries.hs index 81243e4..af1bc37 100644 --- a/src/TSN/XML/Injuries.hs +++ b/src/TSN/XML/Injuries.hs @@ -17,6 +17,7 @@ -- time_stamp. -- module TSN.XML.Injuries ( + dtd, pickle_message, -- * Tests injuries_tests, @@ -72,6 +73,12 @@ import Xml ( unsafe_unpickle ) + +-- | The DTD to which this module corresponds. Used to invoke dbimport. +-- +dtd :: String +dtd = "injuriesxml.dtd" + -- -- DB/XML Data types -- diff --git a/src/TSN/XML/InjuriesDetail.hs b/src/TSN/XML/InjuriesDetail.hs index e5d572e..4356eb6 100644 --- a/src/TSN/XML/InjuriesDetail.hs +++ b/src/TSN/XML/InjuriesDetail.hs @@ -13,6 +13,7 @@ -- real meat. -- module TSN.XML.InjuriesDetail ( + dtd, pickle_message, -- * Tests injuries_detail_tests, @@ -67,6 +68,13 @@ import Xml ( unsafe_unpickle ) + +-- | The DTD to which this module corresponds. Used to invoke dbimport. +-- +dtd :: String +dtd = "Injuries_Detail_XML.dtd" + + -- -- Data types -- diff --git a/src/TSN/XML/News.hs b/src/TSN/XML/News.hs index 86eed4a..49be37e 100644 --- a/src/TSN/XML/News.hs +++ b/src/TSN/XML/News.hs @@ -11,6 +11,7 @@ -- a root element \ that contains an entire news item. -- module TSN.XML.News ( + dtd, pickle_message, -- * Tests news_tests, @@ -73,6 +74,12 @@ import Xml ( unsafe_unpickle ) +-- | The DTD to which this module corresponds. Used to invoke dbimport. +-- +dtd :: String +dtd = "newsxml.dtd" + + -- -- DB/XML Data types -- diff --git a/src/TSN/XML/Odds.hs b/src/TSN/XML/Odds.hs index 5d95ca4..52b7b9f 100644 --- a/src/TSN/XML/Odds.hs +++ b/src/TSN/XML/Odds.hs @@ -12,6 +12,7 @@ -- other... disorganized... information. -- module TSN.XML.Odds ( + dtd, pickle_message, -- * Tests odds_tests, @@ -77,6 +78,12 @@ import Xml ( unsafe_unpickle ) +-- | The DTD to which this module corresponds. Used to invoke dbimport. +-- +dtd :: String +dtd = "Odds_XML.dtd" + + -- -- DB/XML data types -- diff --git a/src/TSN/XML/Weather.hs b/src/TSN/XML/Weather.hs index 2561377..03bb83d 100644 --- a/src/TSN/XML/Weather.hs +++ b/src/TSN/XML/Weather.hs @@ -10,6 +10,7 @@ -- that league contains a bunch of listings. -- module TSN.XML.Weather ( + dtd, pickle_message, -- * Tests weather_tests, @@ -64,6 +65,13 @@ import Xml ( unsafe_unpickle ) + +-- | The DTD to which this module corresponds. Used to invoke dbimport. +-- +dtd :: String +dtd = "weatherxml.dtd" + + -- -- DB/XML Data types --