From: Michael Orlitzky <michael@orlitzky.com>
Date: Sun, 12 Jan 2014 05:01:35 +0000 (-0500)
Subject: Don't remove imported files by default.
X-Git-Tag: 0.0.1~92
X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=5124833f973f6c47a4eda3f4e343d3d8631897c6;p=dead%2Fhtsn-import.git

Don't remove imported files by default.
---

diff --git a/src/CommandLine.hs b/src/CommandLine.hs
index 28768f9..cfb43b3 100644
--- a/src/CommandLine.hs
+++ b/src/CommandLine.hs
@@ -54,6 +54,11 @@ log_level_help :: String
 log_level_help =
   "How verbose should the logs be? One of INFO, WARNING, ERROR."
 
+-- | A description of the "remove" option.
+remove_help :: String
+remove_help =
+  "Remove files that have been successfully imported."
+
 -- | A description of the "syslog" option.
 syslog_help :: String
 syslog_help =
@@ -70,6 +75,7 @@ arg_spec =
     connection_string = def &= typ "STRING"   &= help connection_string_help,
     log_file          = def &= typFile        &= help log_file_help,
     log_level         = def &= typ "LEVEL"    &= help log_level_help,
+    remove            = def &= typ "BOOL"     &= help remove_help,
     syslog            = def &= typ "BOOL"     &= help syslog_help,
     xml_files         = def &= typ "XMLFILES" &= args }
   &= program program_name
diff --git a/src/Configuration.hs b/src/Configuration.hs
index 168136a..4d76c73 100644
--- a/src/Configuration.hs
+++ b/src/Configuration.hs
@@ -24,6 +24,7 @@ data Configuration =
     connection_string :: ConnectionString,
     log_file          :: Maybe FilePath,
     log_level         :: Priority,
+    remove            :: Bool,
     syslog            :: Bool }
     deriving (Show)
 
@@ -35,6 +36,7 @@ instance Default Configuration where
           connection_string = def,
           log_file          = def,
           log_level         = INFO,
+          remove            = def,
           syslog            = def }
 
 
@@ -50,6 +52,7 @@ merge_optional cfg opt_cfg =
     (merge (connection_string cfg) (OC.connection_string opt_cfg))
     (OC.merge_maybes (log_file cfg) (OC.log_file opt_cfg))
     (merge (log_level cfg) (OC.log_level opt_cfg))
+    (merge (remove cfg) (OC.remove opt_cfg))
     (merge (syslog cfg) (OC.syslog opt_cfg))
   where
     -- | If the thing on the right is Just something, return that
diff --git a/src/Main.hs b/src/Main.hs
index 27ddb66..a5e05eb 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -213,7 +213,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
diff --git a/src/OptionalConfiguration.hs b/src/OptionalConfiguration.hs
index 9013112..213f203 100644
--- a/src/OptionalConfiguration.hs
+++ b/src/OptionalConfiguration.hs
@@ -55,6 +55,7 @@ data OptionalConfiguration =
     connection_string :: Maybe ConnectionString,
     log_file          :: Maybe FilePath,
     log_level         :: Maybe Priority,
+    remove            :: Maybe Bool,
     syslog            :: Maybe Bool,
     xml_files         :: [FilePath] }
     deriving (Show, Data, Typeable)
@@ -80,7 +81,14 @@ merge_maybes (Just _) (Just y) = Just y
 --
 instance Monoid OptionalConfiguration where
   -- | An empty OptionalConfiguration.
-  mempty = OptionalConfiguration Nothing Nothing Nothing Nothing Nothing []
+  mempty = OptionalConfiguration
+             Nothing
+             Nothing
+             Nothing
+             Nothing
+             Nothing
+             Nothing
+             []
 
 
   -- | Combine @cfg1@ and @cfg2@, giving precedence to @cfg2@.
@@ -92,6 +100,7 @@ instance Monoid OptionalConfiguration where
       (merge_maybes (connection_string cfg1) (connection_string cfg2))
       (merge_maybes (log_file cfg1) (log_file cfg2))
       (merge_maybes (log_level cfg1) (log_level cfg2))
+      (merge_maybes (remove cfg1) (remove cfg2))
       (merge_maybes (syslog cfg1) (syslog cfg2))
       ((xml_files cfg1) ++ (xml_files cfg2))
 
@@ -131,6 +140,7 @@ from_rc = do
   cfg_connection_string <- DC.lookup cfg "connection_string"
   cfg_log_file <- DC.lookup cfg "log_file"
   cfg_log_level <- DC.lookup cfg "log_level"
+  cfg_remove <- DC.lookup cfg "remove"
   cfg_syslog <- DC.lookup cfg "syslog"
   let cfg_xml_files = [] -- This won't be in the config file.
   return $ OptionalConfiguration
@@ -140,5 +150,6 @@ from_rc = do
              cfg_connection_string
              cfg_log_file
              cfg_log_level
+             cfg_remove
              cfg_syslog
              cfg_xml_files