X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=harbl-cli%2Fsrc%2FOptionalConfiguration.hs;fp=harbl-cli%2Fsrc%2FOptionalConfiguration.hs;h=35ca7d4cb3a7876648f329dbee2e1ff69def59b9;hb=b55e5db2a68be5d69b970bbe4b5ad447881abd3d;hp=0000000000000000000000000000000000000000;hpb=c4d41b93ec02ff4dc762163441ebefb0324e6f07;p=dead%2Fharbl.git

diff --git a/harbl-cli/src/OptionalConfiguration.hs b/harbl-cli/src/OptionalConfiguration.hs
new file mode 100644
index 0000000..35ca7d4
--- /dev/null
+++ b/harbl-cli/src/OptionalConfiguration.hs
@@ -0,0 +1,97 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+-- | 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 (
+  OptionalConfiguration(..),
+  from_rc )
+where
+
+-- System imports.
+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_harbl ( getSysconfDir )
+import System.Console.CmdArgs.Default ( Default(..) )
+import System.Directory ( getHomeDirectory )
+import System.FilePath ( (</>) )
+import System.IO.Error ( catchIOError )
+import System.IO ( hPutStrLn, stderr )
+
+-- Local imports.
+import Hosts ( Hosts(..) )
+import Lists ( Lists(..) )
+
+
+-- | The same as 'Configuration', except everything is optional. It's
+--   easy to merge two of these by simply dropping the 'Nothing's in
+--   favor of the 'Just's. The 'xml_files' are left un-maybed so that
+--   cmdargs can parse more than one of them.
+--
+data OptionalConfiguration =
+  OptionalConfiguration {
+    hosts :: Hosts,
+    lists :: Lists }
+    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.
+--
+--   This is used to merge command-line and config-file settings.
+--
+instance Monoid OptionalConfiguration where
+  -- | An empty OptionalConfiguration.
+  mempty = OptionalConfiguration (Hosts []) (Lists [])
+
+
+  -- | Combine @cfg1@ and @cfg2@, giving precedence to @cfg2@.
+  --   XML files can only be specified on the command-line, so we
+  --   just join them together here.
+  cfg1 `mappend` cfg2 =
+    OptionalConfiguration all_hosts all_lists
+    where
+      all_hosts = Hosts $ (get_hosts $ hosts cfg1) ++ (get_hosts $ hosts cfg2)
+      all_lists = Lists $ (get_lists $ lists cfg1) ++ (get_lists $ lists cfg2)
+
+
+
+-- | Obtain an OptionalConfiguration from harblrc 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 OptionalConfiguration
+from_rc = do
+  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 </> "harblrc"
+  let user_config_path = home </> ".harblrc"
+  cfg <- DC.load [ DC.Optional global_config_path,
+                   DC.Optional user_config_path ]
+  cfg_lists <- DC.lookup cfg "lists"
+  let cfg_hosts = Hosts [] -- This won't be in the config file.
+  return $ OptionalConfiguration cfg_hosts (fromMaybe def cfg_lists)