X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhtsn.git;a=blobdiff_plain;f=src%2FOptionalConfiguration.hs;h=f636a17e2d623104dc2b06ea4983a9ff09c81d74;hp=ea7a67830dd280cf2dbe7380e74b824b16d24d4d;hb=95e23e65db31cf51c9f207a6b447da19920ee1a1;hpb=3fbc7d861d1f95513151010cd0f2d620befc2870 diff --git a/src/OptionalConfiguration.hs b/src/OptionalConfiguration.hs index ea7a678..f636a17 100644 --- a/src/OptionalConfiguration.hs +++ b/src/OptionalConfiguration.hs @@ -2,12 +2,11 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} --- | The program will parse ~/.htsnrc for any available configuration --- directives, resulting in an OptionalConfiguration. The --- command-line arguments will be used to create another --- OptionalConfiguration, and the two will be merged. Finally, a --- def :: Configuration will be updated from the merged --- OptionalConfigurations. +-- | An OptionalConfiguration is just like a 'Configuration', except +-- all of its fields are optional. The user can set options in two +-- places: the command-line, and a configuration file. Obviously if +-- a parameter is set in one place, it doesn't need to be set in the +-- other. Thus, the latter needs to be optional. -- module OptionalConfiguration ( @@ -23,8 +22,12 @@ import Data.Data (Data) import Data.Maybe (fromMaybe) import Data.Monoid (Monoid(..)) import Data.Typeable (Typeable) +import System.Directory (getHomeDirectory) +import System.FilePath ( () ) +import System.IO.Error (catchIOError) -import FeedHosts (FeedHosts(..)) +import Terminal (report_error) +import TSN.FeedHosts (FeedHosts(..)) -- | The same as Configuration, except everything is optional. It's easy to @@ -40,7 +43,20 @@ data OptionalConfiguration = username :: Maybe String } deriving (Show, Data, Typeable) + +-- | The Monoid instance for these lets us "combine" two +-- OptionalConfigurations. The "combine" operation that we'd like to +-- perform is, essentially, to mash them together. So if we have two +-- OptionalConfigurations, each half full, we could combine them +-- into one big one. +-- +-- One of the two must take precedence during this mashing, and we +-- choose the second one for no reason. +-- +-- This is used to merge command-line and config-file settings. +-- instance Monoid OptionalConfiguration where + -- | An empty OptionalConfiguration. mempty = OptionalConfiguration (FeedHosts []) Nothing @@ -48,6 +64,7 @@ instance Monoid OptionalConfiguration where Nothing + -- | Combine @cfg1@ and @cfg2@, giving precedence to @cfg2@. cfg1 `mappend` cfg2 = OptionalConfiguration all_feed_hosts @@ -67,10 +84,27 @@ instance Monoid OptionalConfiguration where then cfg1 else cfg2 + +-- | Obtain an OptionalConfiguration from the file ".htsnrc" in the +-- user's home directory. +-- +-- We make an attempt at cross-platform compatibility; we will try +-- to find the correct directory even on Windows. But if the call +-- to getHomeDirectory fails for whatever reason, we fall back to +-- using the environment variable $HOME. +-- from_rc :: IO OptionalConfiguration from_rc = do - cfg <- DC.load [ DC.Optional "/etc/htsnrc", - DC.Optional "$(HOME)/.htsnrc" ] + -- After some thought, the "global" /etc/htsnrc configuration file + -- was left out. Since each config file needs a password, and this + -- should be run by a dedicated user anyway, the global file does + -- not serve much purpose. It could also be a security risk (visible + -- password) if the admin screws up. + home <- catchIOError getHomeDirectory (\e -> do + report_error (show e) + return "$(HOME)") + let user_config_path = home ".htsnrc" + cfg <- DC.load [ DC.Optional user_config_path ] cfg_password <- DC.lookup cfg "password" cfg_output_directory <- DC.lookup cfg "output_directory" cfg_username <- DC.lookup cfg "username"