X-Git-Url: https://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FOptionalConfiguration.hs;h=d133432bb3c23280b00690df4c2e774edf9f19ff;hb=52e788e676ea2a67ad20b23d2e5c5b351f27b834;hp=de2e97d892c31af6ab4e630118df94af7f1f099c;hpb=49c23c133221c9686dde0d52d06904db8d048724;p=dead%2Fhtsn.git diff --git a/src/OptionalConfiguration.hs b/src/OptionalConfiguration.hs index de2e97d..d133432 100644 --- a/src/OptionalConfiguration.hs +++ b/src/OptionalConfiguration.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StandaloneDeriving #-} -- | An OptionalConfiguration is just like a 'Configuration', except -- all of its fields are optional. The user can set options in two @@ -18,17 +19,27 @@ import qualified Data.Configurator as DC ( Worth(Optional), load, lookup ) -import Data.Data (Data) -import Data.Maybe (fromMaybe) -import Data.Monoid (Monoid(..)) -import Data.Typeable (Typeable) -import System.Directory (getHomeDirectory) +import qualified Data.Configurator.Types as DCT ( + Configured, + Value( String ), + convert ) +import Data.Data ( Data ) +import Data.Maybe ( fromMaybe ) +import Data.Monoid ( Monoid(..) ) +import Data.Typeable ( Typeable ) +import System.Directory ( getHomeDirectory ) import System.FilePath ( () ) -import System.IO.Error (catchIOError) +import System.IO.Error ( catchIOError ) +import System.Log ( Priority(..) ) +import Logging ( log_error ) +import TSN.FeedHosts ( FeedHosts(..) ) -import Logging (log_error) -import TSN.FeedHosts (FeedHosts(..)) +-- Derive standalone instances of Data and Typeable for Priority. This +-- is necessary for OptionalConfiguration (which contains a Maybe +-- Priority) to derive Data and Typeable. +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 @@ -37,10 +48,13 @@ import TSN.FeedHosts (FeedHosts(..)) -- data OptionalConfiguration = OptionalConfiguration { - feed_hosts :: FeedHosts, - password :: Maybe String, + feed_hosts :: FeedHosts, + log_file :: Maybe FilePath, + log_level :: Maybe Priority, + password :: Maybe String, output_directory :: Maybe FilePath, - username :: Maybe String } + syslog :: Maybe Bool, + username :: Maybe String } deriving (Show, Data, Typeable) @@ -62,14 +76,20 @@ instance Monoid OptionalConfiguration where Nothing Nothing Nothing + Nothing + Nothing + Nothing -- | Combine @cfg1@ and @cfg2@, giving precedence to @cfg2@. cfg1 `mappend` cfg2 = OptionalConfiguration all_feed_hosts + (merge (log_file cfg1) (log_file cfg2)) + (merge (log_level cfg1) (log_level cfg2)) (merge (password cfg1) (password cfg2)) (merge (output_directory cfg1) (output_directory cfg2)) + (merge (syslog cfg1) (syslog cfg2)) (merge (username cfg1) (username cfg2)) where merge :: (Maybe a) -> (Maybe a) -> (Maybe a) @@ -85,6 +105,17 @@ instance Monoid OptionalConfiguration where else cfg2 +instance DCT.Configured Priority where + -- | This allows us to read a Priority level out of a Configurator + -- config file. By default Configurator wouldn't know what to do, + -- so we have to tell it that we expect one of the valid Priority + -- constructors. + convert (DCT.String "INFO") = Just INFO + convert (DCT.String "WARNING") = Just WARNING + convert (DCT.String "ERROR") = Just ERROR + convert _ = Nothing + + -- | Obtain an OptionalConfiguration from the file ".htsnrc" in the -- user's home directory. -- @@ -105,14 +136,20 @@ from_rc = do return "$(HOME)") let user_config_path = home ".htsnrc" cfg <- DC.load [ DC.Optional user_config_path ] + cfg_log_file <- DC.lookup cfg "log_file" + cfg_log_level <- DC.lookup cfg "log_level" cfg_password <- DC.lookup cfg "password" cfg_output_directory <- DC.lookup cfg "output_directory" + cfg_syslog <- DC.lookup cfg "syslog" cfg_username <- DC.lookup cfg "username" cfg_feed_hosts <- DC.lookup cfg "feed_hosts" return $ OptionalConfiguration (fromMaybe (FeedHosts []) cfg_feed_hosts) + cfg_log_file + cfg_log_level cfg_password cfg_output_directory + cfg_syslog cfg_username