X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FOptionalConfiguration.hs;h=d9627928c82b4b856e2ad0feedf66b991db22f16;hb=HEAD;hp=6bf4f9b35d7db66df049634a7348ecd27a4b60c1;hpb=7a6ba612bdec5ba940dc6f74143ca64a9163fff2;p=mailbox-count.git diff --git a/src/OptionalConfiguration.hs b/src/OptionalConfiguration.hs index 6bf4f9b..95a6fdb 100644 --- a/src/OptionalConfiguration.hs +++ b/src/OptionalConfiguration.hs @@ -19,8 +19,6 @@ import qualified Data.Configurator as DC ( load, lookup ) import Data.Data ( Data ) -import Data.Typeable ( Typeable ) -import Data.Monoid ( Monoid(..) ) import Paths_mailbox_count ( getSysconfDir ) import System.Directory ( getHomeDirectory ) import System.FilePath ( () ) @@ -34,14 +32,15 @@ import System.IO.Error ( catchIOError ) -- data OptionalConfiguration = OptionalConfiguration { - both :: Maybe Bool, database :: Maybe String, detail :: Maybe Bool, + detail_query :: Maybe String, host :: Maybe String, password :: Maybe String, port :: Maybe Int, + summary_query :: Maybe String, username :: Maybe String } - deriving (Show, Data, Typeable) + deriving (Show, Data) -- | Combine two Maybes into one, essentially mashing them @@ -54,14 +53,30 @@ 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 +-- | The Semigroup instance for these lets us "combine" two +-- configurations. 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. -- -- This is used to merge command-line and config-file settings. -- +instance Semigroup OptionalConfiguration where + -- | Combine @cfg1@ and @cfg2@, giving precedence to @cfg2@. + cfg1 <> cfg2 = + OptionalConfiguration + (merge_maybes (database cfg1) (database cfg2)) + (merge_maybes (detail cfg1) (detail cfg2)) + (merge_maybes (detail_query cfg1) (detail_query cfg2)) + (merge_maybes (host cfg1) (host cfg2)) + (merge_maybes (password cfg1) (password cfg2)) + (merge_maybes (port cfg1) (port cfg2)) + (merge_maybes (summary_query cfg1) (summary_query cfg2)) + (merge_maybes (username cfg1) (username cfg2)) + + +-- | The Monoid instance essentially only provides the "empty +-- configuration." instance Monoid OptionalConfiguration where -- | An empty OptionalConfiguration. mempty = OptionalConfiguration @@ -72,17 +87,8 @@ instance Monoid OptionalConfiguration where Nothing Nothing Nothing - - -- | Combine @cfg1@ and @cfg2@, giving precedence to @cfg2@. - cfg1 `mappend` cfg2 = - OptionalConfiguration - (merge_maybes (both cfg1) (both cfg2)) - (merge_maybes (database cfg1) (database cfg2)) - (merge_maybes (detail cfg1) (detail cfg2)) - (merge_maybes (host cfg1) (host cfg2)) - (merge_maybes (password cfg1) (password cfg2)) - (merge_maybes (port cfg1) (port cfg2)) - (merge_maybes (username cfg1) (username cfg2)) + Nothing + mappend = (<>) -- | Obtain an OptionalConfiguration from mailbox-countrc in either @@ -107,19 +113,21 @@ from_rc = do let user_config_path = home ".mailbox-countrc" cfg <- DC.load [ DC.Optional global_config_path, DC.Optional user_config_path ] - cfg_both <- DC.lookup cfg "both" cfg_database <- DC.lookup cfg "database" cfg_detail <- DC.lookup cfg "detail" + cfg_detail_query <- DC.lookup cfg "detail_query" cfg_host <- DC.lookup cfg "host" cfg_password <- DC.lookup cfg "password" cfg_port <- DC.lookup cfg "port" + cfg_summary_query <- DC.lookup cfg "summary_query" cfg_username <- DC.lookup cfg "username" return $ OptionalConfiguration - cfg_both cfg_database cfg_detail + cfg_detail_query cfg_host cfg_password cfg_port + cfg_summary_query cfg_username