X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=blobdiff_plain;f=src%2FConfiguration.hs;h=4a38d0664cd4d8c4c22fd2b853cb3d1d38ed821b;hp=f73bc615a7d81adbd8c2c2eca0aea3afc92ab5f9;hb=15fd6f764f88f79424d7caaba564e57df564b532;hpb=90c763c607d9eceb718b2229bb420134c9931544 diff --git a/src/Configuration.hs b/src/Configuration.hs index f73bc61..4a38d06 100644 --- a/src/Configuration.hs +++ b/src/Configuration.hs @@ -5,72 +5,91 @@ module Configuration ( Cfg(..), - default_config, - merge_optional -) + merge_optional ) where -import qualified OptionalConfiguration as OC +import Data.Monoid ( Monoid(..) ) +import System.Console.CmdArgs.Default ( Default(..) ) +import qualified OptionalConfiguration as OC ( OptionalCfg(..) ) +import Usernames ( Usernames(..) ) + + +-- | The main configuration data type. It contains all options that +-- 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, - sendmail_path :: String, - from_address :: Maybe String, + pidfile :: FilePath, + run_as_group :: Maybe String, + run_as_user :: Maybe String, + sendmail_path :: FilePath, to_address :: Maybe String, - verbose :: Bool, - usernames :: [String] } + usernames :: Usernames, + verbose :: Bool } 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 = [] } +instance Default Cfg where + -- | A 'Cfg' with all of its fields set to their default values. + -- + def = Cfg { access_secret = def, + access_token = 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", + to_address = def, + usernames = def, + verbose = def } + +-- | Merge a 'Cfg' with an 'OptionalCfg'. This is more or less the +-- Monoid instance for 'OptionalCfg', but since the two types are +-- different, we have to repeat ourselves. +-- 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 (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