Create a Usernames newtype to fix an orphan instance.

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

diff --git a/src/Configuration.hs b/src/Configuration.hs
index 5e84368b6853a4d85c1a293f0fd44b484ff4f4a3..095f5395f6bf7b6d0e4994ece60f453df1e5b614 100644 (file)
--- a/src/Configuration.hs
+++ b/src/Configuration.hs
@@ -1,19 +1,77 @@
 -- | 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(..),
+  default_config,
+  merge_optional
 )
 where
 
-data Cfg = Cfg { consumer_key :: String,
-                 consumer_secret :: String,
-                 access_token :: String,
-                 access_secret :: String,
-                 heartbeat :: Int,
-                 ignore_replies :: Bool,
-                 ignore_retweets :: Bool,
-                 sendmail_path :: String,
-                 from_address :: Maybe String,
-                 to_address :: Maybe String,
-                 verbose :: Bool }
+import qualified OptionalConfiguration as OC
+import Usernames
+
+data Cfg =
+  Cfg { consumer_key :: String,
+        consumer_secret :: String,
+        access_token :: String,
+        access_secret :: String,
+        heartbeat :: Int,
+        ignore_replies :: Bool,
+        ignore_retweets :: Bool,
+        sendmail_path :: String,
+        from_address :: Maybe String,
+        to_address :: Maybe String,
+        verbose :: Bool,
+        usernames :: Usernames }
+    deriving (Show)
+
+
+default_config :: Cfg
+default_config =
+  Cfg { consumer_key = "",
+        consumer_secret = "",
+        access_token = "",
+        access_secret = "",
+        heartbeat = 600,
+        ignore_replies = False,
+        ignore_retweets = False,
+        sendmail_path = "/usr/sbin/sendmail",
+        from_address = Nothing,
+        to_address = Nothing,
+        verbose = False,
+        usernames = Usernames [] }
+
+merge_optional :: Cfg -> OC.OptionalCfg -> Cfg
+merge_optional cfg opt_cfg =
+  Cfg
+    (merge (consumer_key cfg) (OC.consumer_key opt_cfg))
+    (merge (consumer_secret cfg) (OC.consumer_secret opt_cfg))
+    (merge (access_token cfg) (OC.access_token opt_cfg))
+    (merge (access_secret cfg) (OC.access_secret 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 (sendmail_path cfg) (OC.sendmail_path opt_cfg))
+    (merge' (from_address cfg) (OC.from_address opt_cfg))
+    (merge' (to_address cfg) (OC.to_address opt_cfg))
+    (merge (verbose cfg) (OC.verbose opt_cfg))
+    all_usernames
+  where
+    merge :: a -> Maybe a -> a
+    merge x Nothing  = x
+    merge _ (Just y) = y
+
+    -- Used for the to/from address
+    merge' :: Maybe a -> Maybe a -> Maybe a
+    merge' Nothing Nothing = Nothing
+    merge' (Just x) Nothing  = Just x
+    merge' Nothing (Just x)  = Just x
+    merge' (Just _) (Just y) = Just y
+
+    -- If there are any optional usernames, use only those.
+    all_usernames = if (null (get_usernames (OC.usernames opt_cfg)))
+                    then (usernames cfg)
+                    else (OC.usernames opt_cfg)