src/Configuration.hs

   1 -- | This module defines the 'Cfg' type, which is just a wrapper
   2 --   around all of the configuration options we accept on the command
   3 --   line. We thread this throughout the rest of the program.
   4 --
   5
   6 module Configuration (
   7   Cfg(..),
   8   merge_optional )
   9 where
  10
  11 import Data.Monoid ( Monoid(..) )
  12 import System.Console.CmdArgs.Default ( Default(..) )
  13
  14 import qualified OptionalConfiguration as OC ( OptionalCfg(..) )
  15 import Usernames ( Usernames(..) )
  16
  17
  18 -- | The main configuration data type. It contains all options that
  19 --   can be set in a config file or on the command line.
  20 --
  21 data Cfg =
  22   Cfg { access_secret :: String,
  23         access_token :: String,
  24         consumer_key :: String,
  25         consumer_secret :: String,
  26         daemonize :: Bool,
  27         from_address :: Maybe String,
  28         heartbeat :: Int,
  29         ignore_replies :: Bool,
  30         ignore_retweets :: Bool,
  31         pidfile :: FilePath,
  32         run_as_group     :: Maybe String,
  33         run_as_user      :: Maybe String,
  34         sendmail_path :: FilePath,
  35         to_address :: Maybe String,
  36         usernames :: Usernames,
  37         verbose :: Bool }
  38     deriving (Show)
  39
  40
  41 instance Default Cfg where
  42   -- | A 'Cfg' with all of its fields set to their default values.
  43   --
  44   def = Cfg { access_secret = def,
  45               access_token = def,
  46               consumer_key = def,
  47               consumer_secret = def,
  48               daemonize = def,
  49               from_address = def,
  50               heartbeat = 600,
  51               ignore_replies = def,
  52               ignore_retweets = def,
  53               pidfile = "/run/halcyon/halcyon.pid",
  54               run_as_group = def,
  55               run_as_user = def,
  56               sendmail_path = "/usr/sbin/sendmail",
  57               to_address = def,
  58               usernames = def,
  59               verbose = def }
  60
  61
  62 -- | Merge a 'Cfg' with an 'OptionalCfg'. This is more or less the
  63 --   Monoid instance for 'OptionalCfg', but since the two types are
  64 --   different, we have to repeat ourselves.
  65 --
  66 merge_optional :: Cfg -> OC.OptionalCfg -> Cfg
  67 merge_optional cfg opt_cfg =
  68   Cfg
  69     (merge (access_secret cfg) (OC.access_secret opt_cfg))
  70     (merge (access_token cfg) (OC.access_token opt_cfg))
  71     (merge (consumer_key cfg) (OC.consumer_key opt_cfg))
  72     (merge (consumer_secret cfg) (OC.consumer_secret opt_cfg))
  73     (merge (daemonize cfg) (OC.daemonize opt_cfg))
  74     (merge_maybes (from_address cfg) (OC.from_address opt_cfg))
  75     (merge (heartbeat cfg) (OC.heartbeat opt_cfg))
  76     (merge (ignore_replies cfg) (OC.ignore_replies opt_cfg))
  77     (merge (ignore_retweets cfg) (OC.ignore_retweets opt_cfg))
  78     (merge (pidfile cfg) (OC.pidfile opt_cfg))
  79     (merge_maybes (run_as_group cfg) (OC.run_as_group opt_cfg))
  80     (merge_maybes (run_as_user cfg) (OC.run_as_user opt_cfg))
  81     (merge (sendmail_path cfg) (OC.sendmail_path opt_cfg))
  82     (merge_maybes (to_address cfg) (OC.to_address opt_cfg))
  83     ((usernames cfg) `mappend` (OC.usernames opt_cfg))
  84     (merge (verbose cfg) (OC.verbose opt_cfg))
  85   where
  86     merge :: a -> Maybe a -> a
  87     merge x Nothing  = x
  88     merge _ (Just y) = y
  89
  90     -- Used for the truly optional fields
  91     merge_maybes :: Maybe a -> Maybe a -> Maybe a
  92     merge_maybes Nothing Nothing = Nothing
  93     merge_maybes (Just x) Nothing  = Just x
  94     merge_maybes Nothing (Just x)  = Just x
  95     merge_maybes (Just _) (Just y) = Just y