X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FOptionalConfiguration.hs;fp=src%2FOptionalConfiguration.hs;h=ce99f5f9517beeb2e4907da77e7a32ea00cdd378;hb=9d278c8b8eeff1a1317f2c3b0f7fdf5fb759ffb3;hp=f44f77a43396e80fc313cb66fb765ff1fd00c731;hpb=5726138127d880a12421a78b37a178e061c46efe;p=dead%2Fhtsn-import.git diff --git a/src/OptionalConfiguration.hs b/src/OptionalConfiguration.hs index f44f77a..ce99f5f 100644 --- a/src/OptionalConfiguration.hs +++ b/src/OptionalConfiguration.hs @@ -31,9 +31,10 @@ 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. +import Backend ( Backend(..) ) +import Network.Services.TSN.Report ( report_error ) -- Derive standalone instances of Data and Typeable for Priority. This @@ -49,10 +50,12 @@ deriving instance Typeable Priority -- data OptionalConfiguration = OptionalConfiguration { + backend :: Maybe Backend, connection_string :: Maybe String, log_file :: Maybe FilePath, log_level :: Maybe Priority, - syslog :: Maybe Bool } + syslog :: Maybe Bool, + xml_files :: [FilePath] } deriving (Show, Data, Typeable) @@ -76,17 +79,20 @@ 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 [] -- | 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 (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 +117,27 @@ 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_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_syslog + cfg_xml_files