]> gitweb.michael.orlitzky.com - dead/htsn-import.git/commitdiff
Don't remove imported files by default.
authorMichael Orlitzky <michael@orlitzky.com>
Sun, 12 Jan 2014 05:01:35 +0000 (00:01 -0500)
committerMichael Orlitzky <michael@orlitzky.com>
Sun, 12 Jan 2014 05:01:35 +0000 (00:01 -0500)
src/CommandLine.hs
src/Configuration.hs
src/Main.hs
src/OptionalConfiguration.hs

index 28768f98c3995e2d1f36a54856b4210cf17f0351..cfb43b387b7d30a21ca105ca71a0daa22e1bba8a 100644 (file)
@@ -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
index 168136a58ad6adb25bc72df12404d98e52acc7fc..4d76c739d25be973c33f49feab618284fa05f949 100644 (file)
@@ -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
index 27ddb66f84b2933b5600bd7fa5b58e2dcbf09429..a5e05ebef6722602259c051f57d8b5054c6edbfa 100644 (file)
@@ -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
index 9013112f997ebcc5f389d1099c75edea1f67aa5c..213f20363ae6fe822fa097f0ca3103f94cb72266 100644 (file)
@@ -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