Add dummy TSN.XML.{Game,Sport}Info modules that only list DTDs for now.

[dead/htsn-import.git] / src / Main.hs

diff --git a/src/Main.hs b/src/Main.hs
index 8d4999ae7b22237db3c15e8cb16d453d4c6576b2..4669b748a610db8ecba3e77abb04ccc99ec7d00e 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -3,6 +3,7 @@
 module Main
 where
 
+-- System imports.
 import Control.Arrow ( (&&&), (>>^), arr, returnA )
 import Control.Concurrent ( threadDelay )
 import Control.Exception ( SomeException, catch )
@@ -29,9 +30,9 @@ import Text.XML.HXT.Core (
   hasName,
   readDocument,
   runX,
-  unpickleDoc,
-  xpickle)
+  unpickleDoc )
 
+-- Local imports.
 import Backend ( Backend(..) )
 import CommandLine ( get_args )
 import Configuration ( Configuration(..), merge_optional )
@@ -44,11 +45,20 @@ import Network.Services.TSN.Report (
   report_info,
   report_error )
 import TSN.DbImport ( DbImport(..), ImportResult(..) )
-import qualified TSN.XML.Heartbeat as Heartbeat ( verify )
-import qualified TSN.XML.Injuries as Injuries ( Message )
-import qualified TSN.XML.InjuriesDetail as InjuriesDetail ( Message )
-import qualified TSN.XML.News as News ( Message )
-import qualified TSN.XML.Odds as Odds ( Message )
+import qualified TSN.XML.AutoRacingSchedule as AutoRacingSchedule (
+  dtd,
+  pickle_message )
+import qualified TSN.XML.GameInfo as GameInfo ( dtds )
+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.SportInfo as SportInfo ( dtds )
+import qualified TSN.XML.Weather as Weather ( dtd, pickle_message )
 import Xml ( DtdName(..), parse_opts )
 
 
@@ -134,7 +144,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
@@ -142,39 +152,56 @@ 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 == "injuriesxml.dtd" = do
-               let m = unpickleDoc xpickle xml :: Maybe Injuries.Message
-               let errmsg = "Could not unpickle injuriesxml."
+            | dtd == AutoRacingSchedule.dtd = do
+               let m = unpickleDoc AutoRacingSchedule.pickle_message xml
                maybe (return $ ImportFailed errmsg) migrate_and_import m
 
-            | dtd == "Injuries_Detail_XML.dtd" = do
-                let m = unpickleDoc xpickle xml :: Maybe InjuriesDetail.Message
-                let errmsg = "Could not unpickle Injuries_Detail_XML."
+            | dtd == Injuries.dtd = do
+               let m = unpickleDoc Injuries.pickle_message xml
+               maybe (return $ ImportFailed errmsg) migrate_and_import m
+
+            | dtd == InjuriesDetail.dtd = do
+                let m = unpickleDoc InjuriesDetail.pickle_message xml
                 maybe (return $ ImportFailed errmsg) migrate_and_import m
 
 
-            | dtd == "newsxml.dtd" = do
-                let m = unpickleDoc xpickle xml :: Maybe News.Message
-                let errmsg = "Could not unpickle newsxml."
+            | dtd == News.dtd = do
+                let m = unpickleDoc News.pickle_message xml
                 maybe (return $ ImportFailed errmsg) migrate_and_import m
 
-            | dtd == "Odds_XML.dtd" = do
-                let m = unpickleDoc xpickle xml :: Maybe Odds.Message
-                let errmsg = "Could not unpickle Odds_XML."
+            | dtd == Odds.dtd = do
+                let m = unpickleDoc Odds.pickle_message xml
                 maybe (return $ ImportFailed errmsg) migrate_and_import m
 
+            | 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
+                maybe (return $ ImportFailed errmsg) migrate_and_import m
+
+            | dtd `elem` GameInfo.dtds = undefined
+
+            | dtd `elem` SportInfo.dtds = undefined
+
             | otherwise = do
               let infomsg =
                     "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
@@ -212,8 +239,8 @@ main = do
   -- deleted.
   let result_pairs = zip (OC.xml_files opt_config) results
   let victims = [ p | (p, True) <- result_pairs ]
-  let imported_count = length victims
-  report_info $ "Imported " ++ (show imported_count) ++ " document(s) total."
+  let processed_count = length victims
+  report_info $ "Processed " ++ (show processed_count) ++ " document(s) total."
   when (remove cfg) $ mapM_ (kill True) victims
 
   where