X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FOptionalConfiguration.hs;h=d9627928c82b4b856e2ad0feedf66b991db22f16;hb=2924d6a843aa0d4a0d9612a5d2e1e1203931302e;hp=0bd093b457acc174d4ed5637824c51a3eb17026d;hpb=bc4c3efd191f3cc5b7b9f046775bff706c491a7d;p=mailbox-count.git diff --git a/src/OptionalConfiguration.hs b/src/OptionalConfiguration.hs index 0bd093b..d962792 100644 --- a/src/OptionalConfiguration.hs +++ b/src/OptionalConfiguration.hs @@ -19,8 +19,8 @@ import qualified Data.Configurator as DC ( load, lookup ) import Data.Data ( Data ) -import Data.Typeable ( Typeable ) -import Data.Monoid ( Monoid(..) ) +import Data.Monoid ( Monoid() ) +import Data.Semigroup ( Semigroup( (<>) ) ) import Paths_mailbox_count ( getSysconfDir ) import System.Directory ( getHomeDirectory ) import System.FilePath ( () ) @@ -36,11 +36,13 @@ data OptionalConfiguration = OptionalConfiguration { 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 @@ -53,14 +55,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 @@ -70,16 +88,9 @@ instance Monoid OptionalConfiguration where Nothing Nothing Nothing - - -- | Combine @cfg1@ and @cfg2@, giving precedence to @cfg2@. - cfg1 `mappend` cfg2 = - OptionalConfiguration - (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 + Nothing + mappend = (<>) -- | Obtain an OptionalConfiguration from mailbox-countrc in either @@ -106,15 +117,19 @@ from_rc = do DC.Optional user_config_path ] 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_database cfg_detail + cfg_detail_query cfg_host cfg_password cfg_port + cfg_summary_query cfg_username