X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=blobdiff_plain;f=src%2FOptionalConfiguration.hs;fp=src%2FOptionalConfiguration.hs;h=53635439ac354c76bc1f9d96d074fac6ee89254c;hp=0000000000000000000000000000000000000000;hb=26718edaad5cd7921d957a1f0972fd9f5cd5b645;hpb=d721869c5e7395c021cc79f40720bdb275d613d2

diff --git a/src/OptionalConfiguration.hs b/src/OptionalConfiguration.hs
new file mode 100644
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
+