From: Michael Orlitzky Date: Sun, 14 Jul 2013 17:35:53 +0000 (-0400) Subject: Add an OptionalConfiguration type and parse one from ~/.twatrc. X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=commitdiff_plain;h=26718edaad5cd7921d957a1f0972fd9f5cd5b645 Add an OptionalConfiguration type and parse one from ~/.twatrc. --- diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 0b081bc..878cd68 100644 --- 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 5e84368..b4b29f3 100644 --- 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 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 12c978e..c2890fe 100644 --- 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.*,