Begin throwing real code together.

[mailbox-count.git] / src / Configuration.hs

diff --git a/src/Configuration.hs b/src/Configuration.hs
new file mode 100644 (file)
index 0000000..2fbc397
--- /dev/null
+++ b/src/Configuration.hs
@@ -0,0 +1,59 @@
+-- | This module defines the 'Configuration' type, which is just a
+--   wrapper around all of the configuration options we accept on the
+--   command line.
+--
+module Configuration (
+  Configuration(..),
+  merge_optional )
+where
+
+import System.Console.CmdArgs.Default ( Default(..) )
+
+import qualified OptionalConfiguration as OC ( OptionalConfiguration(..) )
+
+-- | The main configuration data type. This will be passed to most of
+--   the important functions once it has been created.
+data Configuration =
+  Configuration {
+    both   :: Bool,
+    database :: String,
+    detail  :: Bool,
+    host :: String,
+    password :: String,
+    port :: Int,
+    username :: String }
+  deriving (Show)
+
+-- | A Configuration with all of its fields set to their default
+--   values.
+instance Default Configuration where
+  def = Configuration {
+          both   = def,
+          database = "postfixadmin",
+          detail = def,
+          host = "localhost",
+          password = def,
+          port = 5432,
+          username = "postgres" }
+
+-- | Merge a 'Configuration' with an 'OptionalConfiguration'. This is
+--   more or less the Monoid instance for 'OptionalConfiguration', but
+--   since the two types are different, we have to repeat ourselves.
+merge_optional :: Configuration
+               -> OC.OptionalConfiguration
+               -> Configuration
+merge_optional cfg opt_cfg =
+  Configuration
+    (merge (both cfg) (OC.both opt_cfg))
+    (merge (database cfg) (OC.database opt_cfg))
+    (merge (detail cfg) (OC.detail opt_cfg))
+    (merge (host cfg) (OC.host opt_cfg))
+    (merge (password cfg) (OC.password opt_cfg))
+    (merge (port cfg) (OC.port opt_cfg))
+    (merge (username cfg) (OC.username opt_cfg))
+  where
+    -- | If the thing on the right is Just something, return that
+    --   something, otherwise return the thing on the left.
+    merge :: a -> Maybe a -> a
+    merge x Nothing  = x
+    merge _ (Just y) = y