X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhtsn.git;a=blobdiff_plain;f=src%2FOptionalConfiguration.hs;h=0913864e0bb064cfd61884e25940a1e326eda771;hp=d133432bb3c23280b00690df4c2e774edf9f19ff;hb=160caf38b6e936b6541b31b3c9bbe952ba0a4b15;hpb=bf31955186e4e3dd4e4f57cbf915fd9fc3d6b793 diff --git a/src/OptionalConfiguration.hs b/src/OptionalConfiguration.hs index d133432..0913864 100644 --- a/src/OptionalConfiguration.hs +++ b/src/OptionalConfiguration.hs @@ -12,7 +12,8 @@ module OptionalConfiguration ( OptionalConfiguration(..), - from_rc ) + from_rc, + merge_maybes ) where import qualified Data.Configurator as DC ( @@ -31,6 +32,7 @@ import System.Directory ( getHomeDirectory ) import System.FilePath ( () ) import System.IO.Error ( catchIOError ) import System.Log ( Priority(..) ) + import Logging ( log_error ) import TSN.FeedHosts ( FeedHosts(..) ) @@ -58,15 +60,22 @@ data OptionalConfiguration = deriving (Show, Data, Typeable) +-- | Combine two Maybes into one, essentially mashing them +-- together. We give precedence to the second argument when both are +-- Justs. +merge_maybes :: (Maybe a) -> (Maybe a) -> (Maybe a) +merge_maybes Nothing Nothing = Nothing +merge_maybes (Just x) Nothing = Just x +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 -- perform is, essentially, to mash them together. So if we have two -- OptionalConfigurations, each half full, we could combine them -- into one big one. -- --- One of the two must take precedence during this mashing, and we --- choose the second one for no reason. --- -- This is used to merge command-line and config-file settings. -- instance Monoid OptionalConfiguration where @@ -85,19 +94,13 @@ instance Monoid OptionalConfiguration where 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)) + (merge_maybes (log_file cfg1) (log_file cfg2)) + (merge_maybes (log_level cfg1) (log_level cfg2)) + (merge_maybes (password cfg1) (password cfg2)) + (merge_maybes (output_directory cfg1) (output_directory cfg2)) + (merge_maybes (syslog cfg1) (syslog cfg2)) + (merge_maybes (username cfg1) (username cfg2)) where - merge :: (Maybe a) -> (Maybe a) -> (Maybe a) - merge Nothing Nothing = Nothing - merge (Just x) Nothing = Just x - merge Nothing (Just x) = Just x - merge (Just _) (Just y) = Just y - -- Use only the latter feed_hosts if there are any. all_feed_hosts = feed_hosts $ if (null (get_feed_hosts (feed_hosts cfg2)))