From 95e23e65db31cf51c9f207a6b447da19920ee1a1 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Thu, 19 Dec 2013 22:19:54 -0500 Subject: [PATCH] Move FeedHosts under the TSN namespace. Undo the global config file check. Use a cross-platform method of getting the user's home directory. Clarify some old comments, and add new ones. --- src/Configuration.hs | 2 +- src/Main.hs | 8 ++---- src/OptionalConfiguration.hs | 52 +++++++++++++++++++++++++++++------- src/{ => TSN}/FeedHosts.hs | 15 ++++++++--- src/Terminal.hs | 10 ++++--- 5 files changed, 64 insertions(+), 23 deletions(-) rename src/{ => TSN}/FeedHosts.hs (61%) diff --git a/src/Configuration.hs b/src/Configuration.hs index a382a9d..71dbbc9 100644 --- a/src/Configuration.hs +++ b/src/Configuration.hs @@ -9,8 +9,8 @@ where import System.Console.CmdArgs.Default (Default(..)) -import FeedHosts (FeedHosts(..)) import qualified OptionalConfiguration as OC (OptionalConfiguration(..)) +import TSN.FeedHosts (FeedHosts(..)) data Configuration = Configuration { diff --git a/src/Main.hs b/src/Main.hs index e1cb91a..3749812 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -36,18 +36,14 @@ import ExitCodes ( exit_no_feed_hosts, exit_no_password, exit_no_username ) -import FeedHosts (FeedHosts(..)) import qualified OptionalConfiguration as OC ( OptionalConfiguration(..), from_rc ) -import Terminal (hPutRedLn, putGreenLn) +import Terminal (putGreenLn, report_error) +import TSN.FeedHosts (FeedHosts(..)) import TSN.Xml (parse_xmlfid, xml_prologue) -report_error :: String -> IO () -report_error = hPutRedLn stderr - - recv_line :: Handle -> IO String recv_line h = do line <- hGetLine h 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" diff --git a/src/FeedHosts.hs b/src/TSN/FeedHosts.hs similarity index 61% rename from src/FeedHosts.hs rename to src/TSN/FeedHosts.hs index 43bab17..0b2056e 100644 --- a/src/FeedHosts.hs +++ b/src/TSN/FeedHosts.hs @@ -1,10 +1,14 @@ {-# LANGUAGE DeriveDataTypeable #-} -- | A newtype around a list of Strings which represent the feed --- hosts. This is all to avoid an orphan instance of Configured for --- [String] if we had defined one in e.g. OptionalConfiguration. +-- hosts. This is all to avoid an orphan instance of Configured for +-- [String] if we had defined one in e.g. OptionalConfiguration. -- -module FeedHosts +-- This was placed under the "TSN" namespace because its Default +-- instance is specific to TSN, even though otherwise it's just a +-- list of strings. +-- +module TSN.FeedHosts where -- DC is needed only for the DCT.Configured instance of String. @@ -19,8 +23,11 @@ newtype FeedHosts = FeedHosts { get_feed_hosts :: [String] } deriving (Data, Show, Typeable) - instance Default FeedHosts where + -- | The default list of feed hosts. These were found by checking + -- PTR records in the neighborhood of the IP address in use. There + -- is a feed4.sportsnetwork.com, but it was not operational when + -- this was written. def = FeedHosts ["feed1.sportsnetwork.com", "feed2.sportsnetwork.com", "feed3.sportsnetwork.com"] diff --git a/src/Terminal.hs b/src/Terminal.hs index e9b59dc..cd35bf0 100644 --- a/src/Terminal.hs +++ b/src/Terminal.hs @@ -1,6 +1,6 @@ module Terminal ( - hPutRedLn, - putGreenLn) + putGreenLn, + report_error) where import Control.Monad.IO.Class (MonadIO(..)) @@ -10,7 +10,7 @@ import System.Console.ANSI ( ColorIntensity( Vivid ), ConsoleLayer( Foreground ), setSGR ) -import System.IO ( Handle, hPutStrLn ) +import System.IO ( Handle, hPutStrLn, stderr ) -- | Perform a computation (anything in MonadIO) with the given -- graphics mode(s) enabled. Revert to the previous graphics mode @@ -39,3 +39,7 @@ hPutRedLn h = with_color Red . hPutStrLn h -- consistency with e.g. putStrLn. putGreenLn :: String -> IO () putGreenLn = with_color Green . putStrLn + +-- | Report an error (to stderr). +report_error :: String -> IO () +report_error = hPutRedLn stderr -- 2.43.2