X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FMain.hs;h=da27b12e9a59ebf8a1e27a4c5fd4a13cf42f85cc;hb=1f1b0076266ccb665b7d9470f4ed5f2edbc680a4;hp=8d4999ae7b22237db3c15e8cb16d453d4c6576b2;hpb=88b80555c3df3649799c8caa4de8d9c87c50be45;p=dead%2Fhtsn-import.git diff --git a/src/Main.hs b/src/Main.hs index 8d4999a..da27b12 100644 --- 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 ) @@ -45,10 +46,11 @@ import Network.Services.TSN.Report ( 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.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 ) @@ -150,26 +152,31 @@ import_file cfg path = do importer | 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 ++ "." @@ -212,8 +219,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