]> gitweb.michael.orlitzky.com - dead/htsn-import.git/blobdiff - src/Main.hs
Add and update documentation.
[dead/htsn-import.git] / src / Main.hs
index 6a0380091a65d60f342b86bdb65190e4d024bce5..8d4999ae7b22237db3c15e8cb16d453d4c6576b2 100644 (file)
@@ -48,22 +48,22 @@ 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 ( Odds )
+import qualified TSN.XML.Odds as Odds ( 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'.
@@ -135,11 +135,11 @@ import_file cfg path = do
         -- We special-case the heartbeat so it doesn't have to run in
         -- the database monad.
       | dtd == "Heartbeat.dtd" = Heartbeat.verify xml
-      | otherwise = do
+      | otherwise =
         -- We need NoMonomorphismRestriction here.
         if backend cfg == Postgres
-        then withPostgresqlConn cs $ runDbConn importer
-        else withSqliteConn cs $ runDbConn importer
+        then withPostgresqlConn cs $ runDbConn importer
+        else withSqliteConn cs $ runDbConn importer
         where
           -- | Pull the real connection String out  of the configuration.
           cs :: String
@@ -165,7 +165,10 @@ import_file cfg path = do
                 let errmsg = "Could not unpickle newsxml."
                 maybe (return $ ImportFailed errmsg) migrate_and_import m
 
-            -- | dtd == "Odds_XML.dtd" = undefined
+            | dtd == "Odds_XML.dtd" = do
+                let m = unpickleDoc xpickle xml :: Maybe Odds.Message
+                let errmsg = "Could not unpickle Odds_XML."
+                maybe (return $ ImportFailed errmsg) migrate_and_import m
 
             | otherwise = do
               let infomsg =
@@ -174,10 +177,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
@@ -210,7 +214,7 @@ main = do
   let victims = [ p | (p, True) <- result_pairs ]
   let imported_count = length victims
   report_info $ "Imported " ++ (show imported_count) ++ " document(s) total."
-  mapM_ (kill True) victims
+  when (remove cfg) $ mapM_ (kill True) victims
 
   where
     -- | Wrap these two actions into one function so that we don't