From: Michael Orlitzky <michael@orlitzky.com>
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 \<RaceResultsListing\>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 \<message\> 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
 --