src/OptionalConfiguration.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4
   5 -- | An OptionalConfiguration is just like a 'Configuration', except
   6 --   all of its fields are optional. The user can set options in two
   7 --   places: the command-line, and a configuration file. Obviously if
   8 --   a parameter is set in one place, it doesn't need to be set in the
   9 --   other. Thus, the latter needs to be optional.
  10 --
  11
  12 module OptionalConfiguration (
  13   OptionalConfiguration(..),
  14   from_rc )
  15 where
  16
  17 import qualified Data.Configurator as DC (
  18   Worth(Optional),
  19   load,
  20   lookup )
  21 import Data.Data (Data)
  22 import Data.Maybe (fromMaybe)
  23 import Data.Monoid (Monoid(..))
  24 import Data.Typeable (Typeable)
  25 import System.Directory (getHomeDirectory)
  26 import System.FilePath ( (</>) )
  27 import System.IO.Error (catchIOError)
  28
  29 import Terminal (report_error)
  30 import TSN.FeedHosts (FeedHosts(..))
  31
  32
  33 -- | The same as Configuration, except everything is optional. It's easy to
  34 --   merge two of these by simply dropping the Nothings in favor of
  35 --   the Justs. The 'feed_hosts' are left un-maybed so that cmdargs
  36 --   can parse more than one of them.
  37 --
  38 data OptionalConfiguration =
  39   OptionalConfiguration {
  40     feed_hosts :: FeedHosts,
  41     password  :: Maybe String,
  42     output_directory :: Maybe FilePath,
  43     username :: Maybe String }
  44     deriving (Show, Data, Typeable)
  45
  46
  47 -- | The Monoid instance for these lets us "combine" two
  48 --   OptionalConfigurations. The "combine" operation that we'd like to
  49 --   perform is, essentially, to mash them together. So if we have two
  50 --   OptionalConfigurations, each half full, we could combine them
  51 --   into one big one.
  52 --
  53 --   One of the two must take precedence during this mashing, and we
  54 --   choose the second one for no reason.
  55 --
  56 --   This is used to merge command-line and config-file settings.
  57 --
  58 instance Monoid OptionalConfiguration where
  59   -- | An empty OptionalConfiguration.
  60   mempty = OptionalConfiguration
  61              (FeedHosts [])
  62              Nothing
  63              Nothing
  64              Nothing
  65
  66
  67   -- | Combine @cfg1@ and @cfg2@, giving precedence to @cfg2@.
  68   cfg1 `mappend` cfg2 =
  69     OptionalConfiguration
  70       all_feed_hosts
  71       (merge (password cfg1) (password cfg2))
  72       (merge (output_directory cfg1) (output_directory cfg2))
  73       (merge (username cfg1) (username cfg2))
  74     where
  75       merge :: (Maybe a) -> (Maybe a) -> (Maybe a)
  76       merge Nothing Nothing   = Nothing
  77       merge (Just x) Nothing  = Just x
  78       merge Nothing (Just x)  = Just x
  79       merge (Just _) (Just y) = Just y
  80
  81       -- Use only the latter feed_hosts if there are any.
  82       all_feed_hosts =
  83         feed_hosts $ if (null (get_feed_hosts (feed_hosts cfg2)))
  84                     then cfg1
  85                     else cfg2
  86
  87
  88 -- | Obtain an OptionalConfiguration from the file ".htsnrc" in the
  89 --   user's home directory.
  90 --
  91 --   We make an attempt at cross-platform compatibility; we will try
  92 --   to find the correct directory even on Windows. But if the call
  93 --   to getHomeDirectory fails for whatever reason, we fall back to
  94 --   using the environment variable $HOME.
  95 --
  96 from_rc :: IO OptionalConfiguration
  97 from_rc = do
  98   -- After some thought, the "global" /etc/htsnrc configuration file
  99   -- was left out. Since each config file needs a password, and this
 100   -- should be run by a dedicated user anyway, the global file does
 101   -- not serve much purpose. It could also be a security risk (visible
 102   -- password) if the admin screws up.
 103   home <- catchIOError getHomeDirectory (\e -> do
 104                                            report_error (show e)
 105                                            return "$(HOME)")
 106   let user_config_path = home </> ".htsnrc"
 107   cfg <- DC.load [ DC.Optional user_config_path ]
 108   cfg_password <- DC.lookup cfg "password"
 109   cfg_output_directory <- DC.lookup cfg "output_directory"
 110   cfg_username <- DC.lookup cfg "username"
 111   cfg_feed_hosts <- DC.lookup cfg "feed_hosts"
 112
 113   return $ OptionalConfiguration
 114              (fromMaybe (FeedHosts []) cfg_feed_hosts)
 115              cfg_password
 116              cfg_output_directory
 117              cfg_username
 118