src/Configuration.hs

   1 -- | This module defines the 'Configuration' type, which is just a
   2 --   wrapper around all of the configuration options we accept on the
   3 --   command line.
   4 --
   5 module Configuration (
   6   Configuration(..),
   7   merge_optional )
   8 where
   9
  10 import System.Console.CmdArgs.Default ( Default(..) )
  11
  12 import qualified OptionalConfiguration as OC ( OptionalConfiguration(..) )
  13
  14 -- | The main configuration data type. This will be passed to most of
  15 --   the important functions once it has been created.
  16 data Configuration =
  17   Configuration {
  18     both   :: Bool,
  19     database :: String,
  20     detail  :: Bool,
  21     host :: String,
  22     password :: String,
  23     port :: Int,
  24     username :: String }
  25   deriving (Show)
  26
  27 -- | A Configuration with all of its fields set to their default
  28 --   values.
  29 instance Default Configuration where
  30   def = Configuration {
  31           both   = def,
  32           database = "postfixadmin",
  33           detail = def,
  34           host = "localhost",
  35           password = def,
  36           port = 5432,
  37           username = "postgres" }
  38
  39 -- | Merge a 'Configuration' with an 'OptionalConfiguration'. This is
  40 --   more or less the Monoid instance for 'OptionalConfiguration', but
  41 --   since the two types are different, we have to repeat ourselves.
  42 merge_optional :: Configuration
  43                -> OC.OptionalConfiguration
  44                -> Configuration
  45 merge_optional cfg opt_cfg =
  46   Configuration
  47     (merge (both cfg) (OC.both opt_cfg))
  48     (merge (database cfg) (OC.database opt_cfg))
  49     (merge (detail cfg) (OC.detail opt_cfg))
  50     (merge (host cfg) (OC.host opt_cfg))
  51     (merge (password cfg) (OC.password opt_cfg))
  52     (merge (port cfg) (OC.port opt_cfg))
  53     (merge (username cfg) (OC.username opt_cfg))
  54   where
  55     -- | If the thing on the right is Just something, return that
  56     --   something, otherwise return the thing on the left.
  57     merge :: a -> Maybe a -> a
  58     merge x Nothing  = x
  59     merge _ (Just y) = y