From: Michael Orlitzky <michael@orlitzky.com>
Date: Sat, 7 Mar 2015 04:10:22 +0000 (-0500)
Subject: Fix deletion of unsupported document types.
X-Git-Tag: 0.2.3^0
X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=93cab4df902fe7399637bdac4201d713bccad583;p=dead%2Fhtsn-import.git

Fix deletion of unsupported document types.
---

diff --git a/htsn-import.cabal b/htsn-import.cabal
index 30378fe..445d95c 100644
--- a/htsn-import.cabal
+++ b/htsn-import.cabal
@@ -1,5 +1,5 @@
 name:           htsn-import
-version:        0.2.2
+version:        0.2.3
 cabal-version:  >= 1.8
 author:         Michael Orlitzky
 maintainer:	Michael Orlitzky <michael@orlitzky.com>
diff --git a/src/Main.hs b/src/Main.hs
index e36cc78..907c351 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -110,9 +110,13 @@ import_file cfg path = do
   results <- parse_and_import `catch` exception_handler
   case results of
     []    -> do
-      -- One of the arrows returned "nothing."
-      report_error $ "Unable to determine DTD for file " ++ path ++ "."
-      return False
+      -- One of the arrows returned "nothing."  Now that we're
+      -- validating against the DTDs, this will almost always be
+      -- caused by a document whose DTD is not present (i.e. is
+      -- unsupported). So we return "success" to allow the XML file to
+      -- be deleted.
+      report_error $ "No DTD for file " ++ path ++ "."
+      return True
     (ImportFailed errmsg:_) -> do
       report_error $ errmsg ++ " (" ++ path ++ ")"
       return False
@@ -289,6 +293,10 @@ import_file cfg path = do
             | otherwise = do
               let infomsg =
                     "Unrecognized DTD in " ++ path ++ ": " ++ dtd ++ "."
+              -- This should be an impossible case while DTD
+              -- validation is enabled. If we can parse the file at
+              -- all, then we have a DTD for it sitting around. And we
+              -- only have DTDs for supported types.
               return $ ImportUnsupported infomsg