htsn-import-0.0.1: src/Configuration.hs

-- | 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

-- System imports.
import System.Console.CmdArgs.Default ( Default(..) )
import System.Log ( Priority( INFO ) )

-- Local imports.
import Backend ( Backend(..) )
import ConnectionString ( ConnectionString )
import qualified OptionalConfiguration as OC (
  OptionalConfiguration(..),
  merge_maybes )


-- | The main configuration data type. It contains all options that
--   can be set in a config file or on the command line.
--
data Configuration =
  Configuration {
    backend           :: Backend,
    connection_string :: ConnectionString,
    log_file          :: Maybe FilePath,
    log_level         :: Priority,
    remove            :: Bool,
    syslog            :: Bool }
    deriving (Show)

-- | A Configuration with all of its fields set to their default
--   values.
instance Default Configuration where
  def = Configuration {
          backend           = def,
          connection_string = def,
          log_file          = def,
          log_level         = INFO,
          remove            = def,
          syslog            = def }


-- | 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 (backend cfg) (OC.backend opt_cfg))
    (merge (connection_string cfg) (OC.connection_string opt_cfg))
    (OC.merge_maybes (log_file cfg) (OC.log_file opt_cfg))
    (merge (log_level cfg) (OC.log_level opt_cfg))
    (merge (remove cfg) (OC.remove opt_cfg))
    (merge (syslog cfg) (OC.syslog 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