program,
summary,
typ,
+ typFile,
versionArg )
import System.Environment ( withArgs )
my_summary = program_name ++ "-" ++ (showVersion version)
--- | Help string for the \"consumer_key\" option.
---
-consumer_key_help :: String
-consumer_key_help = "Your Twitter API consumer key"
-
-
--- | Help string for the \"consumer_secret\" option.
+-- | Help string for the \"access_secret\" option.
--
-consumer_secret_help :: String
-consumer_secret_help = "Your Twitter API consumer secret"
+access_secret_help :: String
+access_secret_help = "Your Twitter API access secret"
-- | Help string for the \"access_token\" option
access_token_help = "Your Twitter API access token"
--- | Help string for the \"access_secret\" option.
+-- | Help string for the \"consumer_key\" option.
--
-access_secret_help :: String
-access_secret_help = "Your Twitter API access secret"
+consumer_key_help :: String
+consumer_key_help = "Your Twitter API consumer key"
--- | Help string for the \"heartbeat\" option.
+-- | Help string for the \"consumer_secret\" option.
--
-heartbeat_help :: String
-heartbeat_help = "How many seconds to wait between polling"
+consumer_secret_help :: String
+consumer_secret_help = "Your Twitter API consumer secret"
--- | Help string for the \"to_address\" option.
+-- | A description of the \"daemonize\" option.
--
-to_address_help :: String
-to_address_help = "Send tweets to ADDRESS"
+daemonize_help :: String
+daemonize_help = "Run as a daemon, in the background."
-- | Help string for the \"from_address\" option.
from_address_help = "Send tweets from ADDRESS"
--- | Help string for the \"sendmail_path\" option.
+-- | Help string for the \"heartbeat\" option.
--
-sendmail_path_help :: String
-sendmail_path_help = "Use PATH to send mail"
+heartbeat_help :: String
+heartbeat_help = "How many seconds to wait between polling"
-- | Help string for the \"ignore_replies\" option.
ignore_retweets_help = "Ignore retweets from other users"
+-- | A description of the "pidfile" option.
+pidfile_help :: String
+pidfile_help =
+ "Location to create PID file (daemon only)."
+
+
+-- | A description of the "run_as_group" option.
+run_as_group_help :: String
+run_as_group_help =
+ "System group to run as (daemon only)."
+
+
+-- | A description of the "run_as_user" option.
+run_as_user_help :: String
+run_as_user_help =
+ "System user to run under (daemon only)."
+
+
+-- | Help string for the \"to_address\" option.
+--
+to_address_help :: String
+to_address_help = "Send tweets to ADDRESS"
+
+
+
+-- | Help string for the \"sendmail_path\" option.
+--
+sendmail_path_help :: String
+sendmail_path_help = "Use PATH to send mail"
+
+
-- | Help string for the \"verbose\" option.
--
verbose_help :: String
arg_spec :: OptionalCfg
arg_spec =
OptionalCfg {
- consumer_key =
- def &= typ "KEY"
- &= groupname "Twitter API"
- &= help consumer_key_help,
- consumer_secret =
+ access_secret =
def &= typ "SECRET"
&= groupname "Twitter API"
- &= help consumer_secret_help,
+ &= help access_secret_help,
access_token =
def &= typ "TOKEN"
&= groupname "Twitter API"
&= help access_token_help,
- access_secret =
+ consumer_key =
+ def &= typ "KEY"
+ &= groupname "Twitter API"
+ &= help consumer_key_help,
+
+ consumer_secret =
def &= typ "SECRET"
&= groupname "Twitter API"
- &= help access_secret_help,
+ &= help consumer_secret_help,
+
+
+ daemonize =
+ def &= groupname "Miscellaneous"
+ &= help daemonize_help,
+
+ from_address =
+ def &= typ "ADDRESS"
+ &= groupname "Mail Options"
+ &= help from_address_help,
heartbeat =
def &= groupname "Miscellaneous"
def &= groupname "Miscellaneous"
&= help ignore_retweets_help,
- verbose =
- def &= groupname "Miscellaneous"
- &= help verbose_help,
+ pidfile =
+ def &= typFile
+ &= help pidfile_help,
+
+ run_as_group =
+ def &= typ "GROUP"
+ &= help run_as_group_help,
+
+ run_as_user =
+ def &= typ "USER"
+ &= help run_as_user_help,
sendmail_path =
def &= typ "PATH"
&= groupname "Mail Options"
&= help sendmail_path_help,
- from_address =
- def &= typ "ADDRESS"
- &= groupname "Mail Options"
- &= help from_address_help,
-
to_address =
def &= typ "ADDRESS"
&= groupname "Mail Options"
usernames =
def &= args
- &= typ "USERNAMES" }
+ &= typ "USERNAMES",
+
+ verbose =
+ def &= groupname "Miscellaneous"
+ &= help verbose_help }
&= program program_name
&= summary my_summary
&= helpArg [groupname "Common flags"]
&= versionArg [groupname "Common flags"]
+
show_help :: IO OptionalCfg
show_help = withArgs ["--help"] get_args
merge_optional )
where
+import Data.Monoid ( Monoid(..) )
import System.Console.CmdArgs.Default ( Default(..) )
import qualified OptionalConfiguration as OC ( OptionalCfg(..) )
-- can be set in a config file or on the command line.
--
data Cfg =
- Cfg { consumer_key :: String,
- consumer_secret :: String,
+ Cfg { access_secret :: String,
access_token :: String,
- access_secret :: 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,
- from_address :: Maybe String,
to_address :: Maybe String,
- verbose :: Bool,
- usernames :: Usernames }
+ usernames :: Usernames,
+ verbose :: Bool }
deriving (Show)
instance Default Cfg where
-- | A 'Cfg' with all of its fields set to their default values.
--
- def = Cfg { consumer_key = def,
- consumer_secret = def,
+ def = Cfg { access_secret = def,
access_token = def,
- access_secret = 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",
- from_address = def,
to_address = def,
- verbose = def,
- usernames = def }
+ usernames = def,
+ verbose = def }
-- | Merge a 'Cfg' with an 'OptionalCfg'. This is more or less the
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 (access_token cfg) (OC.access_token opt_cfg))
- (merge (access_secret cfg) (OC.access_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' (from_address cfg) (OC.from_address opt_cfg))
- (merge' (to_address cfg) (OC.to_address 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))
- 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)
+ -- 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
-- can parse more than one of them.
--
data OptionalCfg =
- OptionalCfg { consumer_key :: Maybe String,
- consumer_secret :: Maybe String,
+ OptionalCfg { access_secret :: Maybe String,
access_token :: Maybe String,
- access_secret :: Maybe String,
+ consumer_key :: Maybe String,
+ consumer_secret :: Maybe String,
+ daemonize :: Maybe Bool,
+ from_address :: Maybe String,
heartbeat :: Maybe Int,
ignore_replies :: Maybe Bool,
ignore_retweets :: Maybe Bool,
+ pidfile :: Maybe FilePath,
+ run_as_group :: Maybe String,
+ run_as_user :: Maybe String,
sendmail_path :: Maybe String,
- from_address :: Maybe String,
to_address :: Maybe String,
- verbose :: Maybe Bool,
- usernames :: Usernames }
+ usernames :: Usernames,
+ verbose :: Maybe Bool }
deriving (Show, Data, Typeable)
instance Monoid OptionalCfg where
Nothing
Nothing
Nothing
- (Usernames [])
+ Nothing
+ Nothing
+ Nothing
+ mempty
+ Nothing
cfg1 `mappend` cfg2 =
OptionalCfg
+ (merge (access_secret cfg1) (access_secret cfg2))
+ (merge (access_token cfg1) (access_token cfg2))
(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 (daemonize cfg1) (daemonize cfg2))
+ (merge (from_address cfg1) (from_address cfg2))
(merge (heartbeat cfg1) (heartbeat cfg2))
(merge (ignore_replies cfg1) (ignore_replies cfg2))
(merge (ignore_retweets cfg1) (ignore_retweets cfg2))
+ (merge (pidfile cfg1) (pidfile cfg2))
+ (merge (run_as_group cfg1) (run_as_group cfg2))
+ (merge (run_as_user cfg1) (run_as_user cfg2))
(merge (sendmail_path cfg1) (sendmail_path cfg2))
- (merge (from_address cfg1) (from_address cfg2))
(merge (to_address cfg1) (to_address cfg2))
+ ((usernames cfg1) `mappend` (usernames cfg2))
(merge (verbose cfg1) (verbose cfg2))
- all_usernames
where
merge :: (Maybe a) -> (Maybe a) -> (Maybe a)
merge Nothing Nothing = Nothing
merge Nothing (Just x) = Just x
merge (Just _) (Just y) = Just y
- -- Use only the latter usernames if there are any.
- all_usernames =
- usernames $ if (null (get_usernames (usernames cfg2)))
- then cfg1
- else cfg2
-- | Obtain an 'OptionalCfg' from halcyonrc in either the global
cfg <- DC.load [ DC.Optional global_config_path,
DC.Optional user_config_path ]
+ cfg_access_secret <- DC.lookup cfg "access-secret"
+ cfg_access_token <- DC.lookup cfg "access-token"
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_daemonize <- DC.lookup cfg "daemonize"
+ cfg_from_address <- DC.lookup cfg "from"
cfg_heartbeat <- DC.lookup cfg "heartbeat"
cfg_ignore_replies <- DC.lookup cfg "ignore-replies"
cfg_ignore_retweets <- DC.lookup cfg "ignore-retweets"
+ cfg_pidfile <- DC.lookup cfg "pidfile"
+ cfg_run_as_group <- DC.lookup cfg "run_as_group"
+ cfg_run_as_user <- DC.lookup cfg "run_as_user"
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"
cfg_usernames <- DC.lookup cfg "usernames"
+ cfg_verbose <- DC.lookup cfg "verbose"
return $ OptionalCfg
+ cfg_access_secret
+ cfg_access_token
cfg_consumer_key
cfg_consumer_secret
- cfg_access_token
- cfg_access_secret
+ cfg_daemonize
+ cfg_from_address
cfg_heartbeat
cfg_ignore_replies
cfg_ignore_retweets
+ cfg_pidfile
+ cfg_run_as_group
+ cfg_run_as_user
cfg_sendmail_path
- cfg_from_address
cfg_to_address
+ (fromMaybe mempty cfg_usernames)
cfg_verbose
- (fromMaybe (Usernames []) cfg_usernames)
import qualified Data.Configurator as DC()
import qualified Data.Configurator.Types as DCT
import Data.Data ( Data )
-import System.Console.CmdArgs.Default ( Default(..) )
+import Data.Monoid ( Monoid(..) )
import Data.Typeable ( Typeable )
+import System.Console.CmdArgs.Default ( Default(..) )
-- | Wrapper around a list of strings (usernames).
def = Usernames []
+-- | The 'Monoid' instance for 'Usernames' uses an
+-- 'Monoid' instance for lists.
+--
+instance Monoid Usernames where
+ -- | The \"empty\" 'Usernames' simply wraps an empty list.
+ mempty = Usernames []
+
+ -- | This mappend is a little funny; it always chooses the second
+ -- list if that list is nonempty. Otherwise, it chooses the
+ -- first. This is actually associative!
+ u1 `mappend` u2
+ | null (get_usernames u2) = u1
+ | otherwise = u2
+
instance DCT.Configured Usernames where
-- | This allows us to read a 'Usernames' object out of a
projects / dead / halcyon.git / commitdiff