harbl-cli/src/OptionalConfiguration.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE StandaloneDeriving #-}
   5
   6 -- | An OptionalConfiguration is just like a 'Configuration', except
   7 --   all of its fields are optional. The user can set options in two
   8 --   places: the command-line, and a configuration file. Obviously if
   9 --   a parameter is set in one place, it doesn't need to be set in the
  10 --   other. Thus, the latter needs to be optional.
  11 --
  12 module OptionalConfiguration (
  13   OptionalConfiguration(..),
  14   from_rc )
  15 where
  16
  17 -- System imports.
  18 import qualified Data.Configurator as DC (
  19   Worth(Optional),
  20   load,
  21   lookup )
  22 import Data.Data ( Data )
  23 import Data.Maybe ( fromMaybe )
  24 import Data.Monoid ( Monoid(..) )
  25 import Data.Typeable ( Typeable )
  26 import Paths_harbl ( getSysconfDir )
  27 import System.Console.CmdArgs.Default ( Default(..) )
  28 import System.Directory ( getHomeDirectory )
  29 import System.FilePath ( (</>) )
  30 import System.IO.Error ( catchIOError )
  31 import System.IO ( hPutStrLn, stderr )
  32
  33 -- Local imports.
  34 import Hosts ( Hosts(..) )
  35 import Lists ( Lists(..) )
  36
  37
  38 -- | The same as 'Configuration', except everything is optional. It's
  39 --   easy to merge two of these by simply dropping the 'Nothing's in
  40 --   favor of the 'Just's. The 'xml_files' are left un-maybed so that
  41 --   cmdargs can parse more than one of them.
  42 --
  43 data OptionalConfiguration =
  44   OptionalConfiguration {
  45     hosts :: Hosts,
  46     lists :: Lists }
  47     deriving (Show, Data, Typeable)
  48
  49
  50 -- | The Monoid instance for these lets us \"combine\" two
  51 --   OptionalConfigurations. The \"combine\" operation that we'd like to
  52 --   perform is, essentially, to mash them together. So if we have two
  53 --   OptionalConfigurations, each half full, we could combine them
  54 --   into one big one.
  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 (Hosts []) (Lists [])
  61
  62
  63   -- | Combine @cfg1@ and @cfg2@, giving precedence to @cfg2@.
  64   --   XML files can only be specified on the command-line, so we
  65   --   just join them together here.
  66   cfg1 `mappend` cfg2 =
  67     OptionalConfiguration all_hosts all_lists
  68     where
  69       all_hosts = Hosts $ (get_hosts $ hosts cfg1) ++ (get_hosts $ hosts cfg2)
  70       all_lists = Lists $ (get_lists $ lists cfg1) ++ (get_lists $ lists cfg2)
  71
  72
  73
  74 -- | Obtain an OptionalConfiguration from harblrc in either the global
  75 --   configuration directory or the user's home directory. The one in
  76 --   $HOME is prefixed by a dot so that it is hidden.
  77 --
  78 --   We make an attempt at cross-platform compatibility; we will try
  79 --   to find the correct directory even on Windows. But if the calls
  80 --   to getHomeDirectory/getSysconfDir fail for whatever reason, we
  81 --   fall back to using the Unix-specific /etc and $HOME.
  82 --
  83 from_rc :: IO OptionalConfiguration
  84 from_rc = do
  85   etc  <- catchIOError getSysconfDir (\e -> do
  86                                         hPutStrLn stderr (show e)
  87                                         return "/etc")
  88   home <- catchIOError getHomeDirectory (\e -> do
  89                                            hPutStrLn stderr (show e)
  90                                            return "$(HOME)")
  91   let global_config_path = etc </> "harblrc"
  92   let user_config_path = home </> ".harblrc"
  93   cfg <- DC.load [ DC.Optional global_config_path,
  94                    DC.Optional user_config_path ]
  95   cfg_lists <- DC.lookup cfg "lists"
  96   let cfg_hosts = Hosts [] -- This won't be in the config file.
  97   return $ OptionalConfiguration cfg_hosts (fromMaybe def cfg_lists)