X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=blobdiff_plain;f=src%2FOptionalConfiguration.hs;h=8fd9f6c68319d204a94efc4e3a9d17f052124758;hp=600647f7fa37fafff795d9dfee1721cb0ca43d9c;hb=1b72ed45ef890ed1329a32457b4d7f3a7fb37788;hpb=62b4e5715d31747ffd526c54f6697736dcbf163e diff --git a/src/OptionalConfiguration.hs b/src/OptionalConfiguration.hs index 600647f..8fd9f6c 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 @@ -39,7 +49,7 @@ data OptionalCfg = from_address :: Maybe String, to_address :: Maybe String, verbose :: Maybe Bool, - usernames :: [String] } + usernames :: Usernames } deriving (Show, Data, Typeable) instance Monoid OptionalCfg where @@ -55,7 +65,7 @@ instance Monoid OptionalCfg where Nothing Nothing Nothing - [] + (Usernames []) cfg1 `mappend` cfg2 = OptionalCfg @@ -80,22 +90,33 @@ instance Monoid OptionalCfg where -- Use only the latter usernames if there are any. all_usernames = - usernames $ if (null (usernames cfg2)) + usernames $ if (null (get_usernames (usernames cfg2))) then cfg1 else cfg2 -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 (show e) + return "/etc") + home <- catchIOError getHomeDirectory (\e -> do + hPutStrLn stderr (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_consumer_key <- DC.lookup cfg "consumer-key" cfg_consumer_secret <- DC.lookup cfg "consumer-secret" cfg_access_token <- DC.lookup cfg "access-token" @@ -121,4 +142,4 @@ from_rc = do cfg_from_address cfg_to_address cfg_verbose - (fromMaybe [] cfg_usernames) + (fromMaybe (Usernames []) cfg_usernames)