Add configuration options for daemonize, pidfile, run_as_group and run_as_user.

[dead/halcyon.git] / src / Configuration.hs

diff --git a/src/Configuration.hs b/src/Configuration.hs
index e83dc29c8616e755048cb4c39d0461da750c1766..4a38d0664cd4d8c4c22fd2b853cb3d1d38ed821b 100644 (file)
--- a/src/Configuration.hs
+++ b/src/Configuration.hs
@@ -1,15 +1,95 @@
 -- | This module defines the 'Cfg' type, which is just a wrapper
 --   around all of the configuration options we accept on the command
 --   line. We thread this throughout the rest of the program.
+--
+
 module Configuration (
-  Cfg(..)
-)
+  Cfg(..),
+  merge_optional )
 where
 
-data Cfg = Cfg { heartbeat :: Int,
-                 ignore_replies :: Bool,
-                 ignore_retweets :: Bool,
-                 sendmail_path :: String,
-                 from_address :: Maybe String,
-                 to_address :: Maybe String,
-                 verbose :: Bool }
+import Data.Monoid ( Monoid(..) )
+import System.Console.CmdArgs.Default ( Default(..) )
+
+import qualified OptionalConfiguration as OC ( OptionalCfg(..) )
+import Usernames ( Usernames(..) )
+
+
+-- | The main configuration data type. It contains all options that
+--   can be set in a config file or on the command line.
+--
+data Cfg =
+  Cfg { access_secret :: String,
+        access_token :: String,
+        consumer_key :: String,
+        consumer_secret :: String,
+        daemonize :: Bool,
+        from_address :: Maybe String,
+        heartbeat :: Int,
+        ignore_replies :: Bool,
+        ignore_retweets :: Bool,
+        pidfile :: FilePath,
+        run_as_group     :: Maybe String,
+        run_as_user      :: Maybe String,
+        sendmail_path :: FilePath,
+        to_address :: Maybe String,
+        usernames :: Usernames,
+        verbose :: Bool }
+    deriving (Show)
+
+
+instance Default Cfg where
+  -- | A 'Cfg' with all of its fields set to their default values.
+  --
+  def = Cfg { access_secret = def,
+              access_token = def,
+              consumer_key = def,
+              consumer_secret = def,
+              daemonize = def,
+              from_address = def,
+              heartbeat = 600,
+              ignore_replies = def,
+              ignore_retweets = def,
+              pidfile = "/run/halcyon/halcyon.pid",
+              run_as_group = def,
+              run_as_user = def,
+              sendmail_path = "/usr/sbin/sendmail",
+              to_address = def,
+              usernames = def,
+              verbose = def }
+
+
+-- | Merge a 'Cfg' with an 'OptionalCfg'. This is more or less the
+--   Monoid instance for 'OptionalCfg', but since the two types are
+--   different, we have to repeat ourselves.
+--
+merge_optional :: Cfg -> OC.OptionalCfg -> Cfg
+merge_optional cfg opt_cfg =
+  Cfg
+    (merge (access_secret cfg) (OC.access_secret opt_cfg))
+    (merge (access_token cfg) (OC.access_token opt_cfg))
+    (merge (consumer_key cfg) (OC.consumer_key opt_cfg))
+    (merge (consumer_secret cfg) (OC.consumer_secret opt_cfg))
+    (merge (daemonize cfg) (OC.daemonize opt_cfg))
+    (merge_maybes (from_address cfg) (OC.from_address opt_cfg))
+    (merge (heartbeat cfg) (OC.heartbeat opt_cfg))
+    (merge (ignore_replies cfg) (OC.ignore_replies opt_cfg))
+    (merge (ignore_retweets cfg) (OC.ignore_retweets opt_cfg))
+    (merge (pidfile cfg) (OC.pidfile opt_cfg))
+    (merge_maybes (run_as_group cfg) (OC.run_as_group opt_cfg))
+    (merge_maybes (run_as_user cfg) (OC.run_as_user opt_cfg))
+    (merge (sendmail_path cfg) (OC.sendmail_path opt_cfg))
+    (merge_maybes (to_address cfg) (OC.to_address opt_cfg))
+    ((usernames cfg) `mappend` (OC.usernames opt_cfg))
+    (merge (verbose cfg) (OC.verbose opt_cfg))
+  where
+    merge :: a -> Maybe a -> a
+    merge x Nothing  = x
+    merge _ (Just y) = y
+
+    -- Used for the truly optional fields
+    merge_maybes :: Maybe a -> Maybe a -> Maybe a
+    merge_maybes Nothing Nothing = Nothing
+    merge_maybes (Just x) Nothing  = Just x
+    merge_maybes Nothing (Just x)  = Just x
+    merge_maybes (Just _) (Just y) = Just y