Add a new module, TSN.XML.AutoRacingSchedule, and its tests.

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

diff --git a/src/Main.hs b/src/Main.hs
index a5e05ebef6722602259c051f57d8b5054c6edbfa..84593976ec9e3eb05300e89bc4fe42e54b7cf663 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,26 +45,29 @@ import Network.Services.TSN.Report (
   report_info,
   report_error )
 import TSN.DbImport ( DbImport(..), ImportResult(..) )
+import qualified TSN.XML.AutoRacingSchedule as AutoRacingSchedule (
+  pickle_message )
 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.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.Weather as Weather ( pickle_message )
 import Xml ( DtdName(..), parse_opts )
 
 
 -- | This is where most of the work happens. This function is called
 --   on every file that we would like to import. It determines which
---   importer to use based on the DTD, processes the file, and then
---   returns whether or not any records were imported. If the file was
---   processed, the number of records imported is returned (wrapped in
---   a Just). Otherwise, if the file was not processed, 'Nothing' is
+--   importer to use based on the DTD, attempts to process the file,
+--   and then returns whether or not it was successful. If the file
+--   was processed, 'True' is returned. Otherwise, 'False' is
 --   returned.
 --
---   Since we are already in arrow world with HXT, the
---   'import_with_dtd' function is lifted to an 'Arrow' as well with
---   'arr'. This prevents us from having to do a bunch of unwrapping
---   and rewrapping with the associated error checking.
+--   The implementation is straightforward with one exception: since
+--   we are already in arrow world with HXT, the @import_with_dtd@
+--   function is lifted to an 'Arrow' as well with 'arr'. This
+--   prevents us from having to do a bunch of unwrapping and
+--   rewrapping with the associated error checking.
 --
 import_file :: Configuration -- ^ A configuration object needed for the
                              --   'backend' and 'connection_string'.
@@ -149,27 +153,37 @@ import_file cfg path = do
           migrate_and_import m = dbmigrate m >> dbimport m
 
           importer
+            | dtd == "Auto_Racing_Schedule_XML.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
-               let m = unpickleDoc xpickle xml :: Maybe Injuries.Message
+               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
-                let m = unpickleDoc xpickle xml :: Maybe InjuriesDetail.Message
+                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
-                let m = unpickleDoc xpickle xml :: Maybe News.Message
+                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
-                let m = unpickleDoc xpickle xml :: Maybe Odds.Message
+                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
+                let m = unpickleDoc Weather.pickle_message xml
+                let errmsg = "Could not unpickle weatherxml."
+                maybe (return $ ImportFailed errmsg) migrate_and_import m
+
             | otherwise = do
               let infomsg =
                     "Unrecognized DTD in " ++ path ++ ": " ++ dtd ++ "."
@@ -177,10 +191,11 @@ import_file cfg path = do
 
 
 -- | Entry point of the program. It twiddles some knobs for
---   configuration options and then calls 'import_file' on each XML file
---   given on the command-line.
+--   configuration options and then calls 'import_file' on each XML
+--   file given on the command-line.
 --
---   Any file successfully processed is then removed, and we're done.
+--   Any file successfully processed is then optionally removed, and
+--   we're done.
 --
 main :: IO ()
 main = do
@@ -211,8 +226,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