X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FOptionalConfiguration.hs;h=49355f2de743dfcdbc887606df408488ba73e60a;hb=93cab4df902fe7399637bdac4201d713bccad583;hp=f44f77a43396e80fc313cb66fb765ff1fd00c731;hpb=08fce472b305acb2cfbffbe877798378c4079cc4;p=dead%2Fhtsn-import.git diff --git a/src/OptionalConfiguration.hs b/src/OptionalConfiguration.hs index f44f77a..49355f2 100644 --- a/src/OptionalConfiguration.hs +++ b/src/OptionalConfiguration.hs @@ -15,6 +15,7 @@ module OptionalConfiguration ( merge_maybes ) where +-- System imports. import qualified Data.Configurator as DC ( Worth(Optional), load, @@ -31,9 +32,12 @@ import System.Directory ( getHomeDirectory ) import System.FilePath ( () ) import System.IO.Error ( catchIOError ) import System.Log ( Priority(..) ) +import Text.Read ( readMaybe ) -import Logging ( log_error ) -- Can't import report_error from Main -import Terminal ( display_error ) -- 'cause of circular imports. +-- Local imports. +import Backend ( Backend(..) ) +import ConnectionString ( ConnectionString ) +import Network.Services.TSN.Report ( report_error ) -- Derive standalone instances of Data and Typeable for Priority. This @@ -42,17 +46,20 @@ import Terminal ( display_error ) -- 'cause of circular imports. deriving instance Data Priority deriving instance Typeable Priority --- | The same as Configuration, except everything is optional. It's easy to --- merge two of these by simply dropping the Nothings in favor of --- the Justs. The 'feed_hosts' are left un-maybed so that cmdargs --- can parse more than one of them. +-- | The same as 'Configuration', except everything is optional. It's +-- easy to merge two of these by simply dropping the 'Nothing's in +-- favor of the 'Just's. The 'xml_files' are left un-maybed so that +-- cmdargs can parse more than one of them. -- data OptionalConfiguration = OptionalConfiguration { - connection_string :: Maybe String, + backend :: Maybe Backend, + connection_string :: Maybe ConnectionString, log_file :: Maybe FilePath, log_level :: Maybe Priority, - syslog :: Maybe Bool } + remove :: Maybe Bool, + syslog :: Maybe Bool, + xml_files :: [FilePath] } deriving (Show, Data, Typeable) @@ -66,8 +73,8 @@ merge_maybes Nothing (Just x) = Just x merge_maybes (Just _) (Just y) = Just y --- | The Monoid instance for these lets us "combine" two --- OptionalConfigurations. The "combine" operation that we'd like to +-- | The Monoid instance for these lets us \"combine\" two +-- OptionalConfigurations. The \"combine\" operation that we'd like to -- perform is, essentially, to mash them together. So if we have two -- OptionalConfigurations, each half full, we could combine them -- into one big one. @@ -76,17 +83,28 @@ merge_maybes (Just _) (Just y) = Just y -- instance Monoid OptionalConfiguration where -- | An empty OptionalConfiguration. - mempty = OptionalConfiguration Nothing Nothing Nothing Nothing + mempty = OptionalConfiguration + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + [] -- | Combine @cfg1@ and @cfg2@, giving precedence to @cfg2@. + -- XML files can only be specified on the command-line, so we + -- just join them together here. cfg1 `mappend` cfg2 = OptionalConfiguration + (merge_maybes (backend cfg1) (backend cfg2)) (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)) instance DCT.Configured Priority where -- | This allows us to read a Priority level out of a Configurator @@ -111,24 +129,29 @@ instance DCT.Configured Priority where from_rc :: IO OptionalConfiguration from_rc = do etc <- catchIOError getSysconfDir (\e -> do - display_error (show e) - log_error (show e) + report_error (show e) return "/etc") home <- catchIOError getHomeDirectory (\e -> do - display_error (show e) - log_error (show e) + report_error (show e) return "$(HOME)") let global_config_path = etc "htsn-importrc" let user_config_path = home ".htsn-importrc" cfg <- DC.load [ DC.Optional global_config_path, DC.Optional user_config_path ] + cfg_backend <- DC.lookup cfg "backend" 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 + (case cfg_backend of -- Try to convert a String to a Backend. + Nothing -> Nothing + Just s -> readMaybe s) cfg_connection_string cfg_log_file cfg_log_level + cfg_remove cfg_syslog + cfg_xml_files