Add an OptionalConfiguration type and parse one from ~/.twatrc.

diff --git a/src/CommandLine.hs b/src/CommandLine.hs
index 0b081bc5a7d752fefe85652d0c1f6e92bd124466..878cd686ca12f1a4bdc7b2e676edd07199699bbb 100644 (file)
--- a/src/CommandLine.hs
+++ b/src/CommandLine.hs
@@ -99,8 +99,8 @@ options =
       "Send tweets FROM email_address.",
 
     Option
-      "s" ["sendmail_path"]
-      (ReqArg set_sendmail_path "sendmail_path")
+      "s" ["sendmail-path"]
+      (ReqArg set_sendmail_path "sendmail-path")
       "Use sendmail_path to send mail",
 
     Option

diff --git a/src/Configuration.hs b/src/Configuration.hs
index 5e84368b6853a4d85c1a293f0fd44b484ff4f4a3..b4b29f3687bb7e9429ab0959368841e208fc9ea1 100644 (file)
--- a/src/Configuration.hs
+++ b/src/Configuration.hs
@@ -1,19 +1,66 @@
 -- | 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(..)
 )
 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
+
+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 }
+
+
+
+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 }
+
+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))
+  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

diff --git a/src/OptionalConfiguration.hs b/src/OptionalConfiguration.hs
new file mode 100644 (file)
index 0000000..5363543
--- /dev/null
+++ b/src/OptionalConfiguration.hs
@@ -0,0 +1,91 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | The program will parse ~/.twatrc for any available configuration
+--   directives, resulting in an OptionalCfg. The command-line
+--   arguments will be used to create another OptionalCfg, and the two
+--   will be merged. Finally, a default_config will be updated from
+--   the merged OptionalCfgs.
+--
+
+module OptionalConfiguration
+where
+
+import Data.Monoid (Monoid(..))
+import qualified Data.Configurator as DC
+
+-- The same as Cfg, except everything is optional. It's easy to merge
+-- two of these by simply dropping the Nothings in favor of the Justs.
+data OptionalCfg =
+  OptionalCfg { consumer_key :: Maybe String,
+                consumer_secret :: Maybe String,
+                access_token :: Maybe String,
+                access_secret :: Maybe String,
+                heartbeat :: Maybe Int,
+                ignore_replies :: Maybe Bool,
+                ignore_retweets :: Maybe Bool,
+                sendmail_path :: Maybe String,
+                from_address :: Maybe String,
+                to_address :: Maybe String,
+                verbose :: Maybe Bool }
+
+instance Monoid OptionalCfg where
+  mempty = OptionalCfg
+             Nothing
+             Nothing
+             Nothing
+             Nothing
+             Nothing
+             Nothing
+             Nothing
+             Nothing
+             Nothing
+             Nothing
+             Nothing
+
+  cfg1 `mappend` cfg2 =
+    OptionalCfg
+      (merge (consumer_key cfg1) (consumer_key cfg2))
+      (merge (consumer_secret cfg1) (consumer_secret cfg2))
+      (merge (access_token cfg1) (access_token cfg2))
+      (merge (access_secret cfg1) (access_secret cfg2))
+      (merge (heartbeat cfg1) (heartbeat cfg2))
+      (merge (ignore_replies cfg1) (ignore_replies cfg2))
+      (merge (ignore_retweets cfg1) (ignore_retweets cfg2))
+      (merge (sendmail_path cfg1) (sendmail_path cfg2))
+      (merge (from_address cfg1) (from_address cfg2))
+      (merge (to_address cfg1) (to_address cfg2))
+      (merge (verbose cfg1) (verbose cfg2))
+    where
+      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
+
+from_rc :: IO OptionalCfg
+from_rc = do
+  cfg <- DC.load [ DC.Optional "$(HOME)/.twatrc" ]
+  cfg_consumer_key <- DC.lookup cfg "consumer-key"
+  cfg_consumer_secret <- DC.lookup cfg "consumer-secret"
+  cfg_access_token <- DC.lookup cfg "access-token"
+  cfg_access_secret <- DC.lookup cfg "access-secret"
+  cfg_heartbeat <- DC.lookup cfg "heartbeat"
+  cfg_ignore_replies <- DC.lookup cfg "ignore-replies"
+  cfg_ignore_retweets <- DC.lookup cfg "ignore-retweets"
+  cfg_sendmail_path <- DC.lookup cfg "sendmail-path"
+  cfg_from_address <- DC.lookup cfg "from"
+  cfg_to_address <- DC.lookup cfg "to"
+  cfg_verbose <- DC.lookup cfg "verbose"
+  return $ OptionalCfg
+             cfg_consumer_key
+             cfg_consumer_secret
+             cfg_access_token
+             cfg_access_secret
+             cfg_heartbeat
+             cfg_ignore_replies
+             cfg_ignore_retweets
+             cfg_sendmail_path
+             cfg_from_address
+             cfg_to_address
+             cfg_verbose
+

diff --git a/twat.cabal b/twat.cabal
index 12c978ede25872d620e2baa1db72a6681b77ecdb..c2890fe6e29ea6e0151e97273837b5a13c0ac05b 100644 (file)
--- a/twat.cabal
+++ b/twat.cabal
@@ -19,6 +19,7 @@ executable twat
     base                        == 4.*,
     bytestring                  == 0.10.*,
     conduit                     == 1.*,
+    configurator                == 0.2.*,
     directory                   == 1.2.*,
     HaXml                       == 1.24.*,
     http-conduit                == 1.9.*,
@@ -46,6 +47,7 @@ executable twat
     ExitCodes
     Html
     Mail
+    OptionalConfiguration
     StringUtils
     Twitter.Http
     Twitter.Status
@@ -75,6 +77,7 @@ test-suite testsuite
     base                        == 4.*,
     bytestring                  == 0.10.*,
     conduit                     == 1.*,
+    configurator                == 0.2.*,
     directory                   == 1.2.*,
     HaXml                       == 1.24.*,
     http-conduit                == 1.9.*,