X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=blobdiff_plain;f=src%2FOptionalConfiguration.hs;h=17c7191dead04be9265ec82e91604a730034ebb0;hp=11add85de7ae6081755d1821cf750a0c845b4af4;hb=c9a905e0ab69317448f261377ab9031fb83443b4;hpb=7bb00e04c15781d889f950d00babf3f183047bff diff --git a/src/OptionalConfiguration.hs b/src/OptionalConfiguration.hs index 11add85..17c7191 100644 --- a/src/OptionalConfiguration.hs +++ b/src/OptionalConfiguration.hs @@ -2,7 +2,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} --- | The program will parse ~/.twatrc for any available configuration +-- | The program will parse ~/.halcyonrc 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 @@ -11,16 +11,26 @@ module OptionalConfiguration ( OptionalCfg(..), - from_rc - ) + from_rc ) where -import qualified Data.Configurator as DC -import qualified Data.Configurator.Types as DCT -import Data.Data (Data) -import Data.Maybe (fromMaybe) -import Data.Monoid (Monoid(..)) -import Data.Typeable (Typeable) +import qualified Data.Configurator as DC ( + Worth (Optional), + load, + lookup ) + +import Data.Data ( Data ) +import Data.Maybe ( fromMaybe ) +import Data.Monoid ( Monoid(..) ) +import Data.Typeable ( Typeable ) +import Paths_halcyon ( getSysconfDir ) +import System.Directory ( getHomeDirectory ) +import System.FilePath ( () ) +import System.IO ( hPutStrLn, stderr ) +import System.IO.Error ( catchIOError ) + +import Usernames ( Usernames(..) ) + -- | The same as Cfg, except everything is optional. It's easy to -- merge two of these by simply dropping the Nothings in favor of @@ -28,18 +38,22 @@ import Data.Typeable (Typeable) -- 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 :: [String] } + usernames :: Usernames, + verbose :: Maybe Bool } deriving (Show, Data, Typeable) instance Monoid OptionalCfg where @@ -55,22 +69,30 @@ instance Monoid OptionalCfg where Nothing Nothing Nothing - [] + 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)) - (usernames cfg2) -- Use only the usernames from cfg2 where merge :: (Maybe a) -> (Maybe a) -> (Maybe a) merge Nothing Nothing = Nothing @@ -79,41 +101,61 @@ instance Monoid OptionalCfg where merge (Just _) (Just y) = Just y -instance DCT.Configured [String] where - convert (DCT.List xs) = - mapM convert_string xs - where - convert_string :: DCT.Value -> Maybe String - convert_string = DCT.convert - - convert _ = Nothing +-- | Obtain an 'OptionalCfg' from halcyonrc in either the global +-- configuration directory or the user's home directory. The one in +-- $HOME is prefixed by a dot so that it is hidden. +-- +-- We make an attempt at cross-platform compatibility; we will try +-- to find the correct directory even on Windows. But if the calls +-- to getHomeDirectory/getSysconfDir fail for whatever reason, we +-- fall back to using the Unix-specific /etc and $HOME. +-- from_rc :: IO OptionalCfg from_rc = do - cfg <- DC.load [ DC.Optional "$(HOME)/.twatrc" ] + etc <- catchIOError + getSysconfDir (\e -> do hPutStrLn stderr ("ERROR: " ++ (show e)) + return "/etc") + home <- catchIOError + getHomeDirectory (\e -> do hPutStrLn stderr ("ERROR: " ++ (show e)) + return "$(HOME)") + + let global_config_path = etc "halcyonrc" + let user_config_path = home ".halcyonrc" + 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 [] cfg_usernames)