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

diff --git a/harbl-cli/src/OptionalConfiguration.hs b/harbl-cli/src/OptionalConfiguration.hs
index 35ca7d4..66e4785 100644
--- a/harbl-cli/src/OptionalConfiguration.hs
+++ b/harbl-cli/src/OptionalConfiguration.hs
@@ -1,7 +1,5 @@
 {-# 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
@@ -11,6 +9,8 @@
 --
 module OptionalConfiguration (
   OptionalConfiguration(..),
+  merge_maybe,
+  merge_monoid,
   from_rc )
 where
 
@@ -22,13 +22,17 @@ import qualified Data.Configurator as DC (
 import Data.Data ( Data )
 import Data.Maybe ( fromMaybe )
 import Data.Monoid ( Monoid(..) )
+import Data.Text ( pack )
 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 )
+import System.IO ( hPrint, stderr )
+
+-- Harbl library imports.
+import Network.DNS.RBL.Weight ( Weight )
 
 -- Local imports.
 import Hosts ( Hosts(..) )
@@ -43,10 +47,88 @@ import Lists ( Lists(..) )
 data OptionalConfiguration =
   OptionalConfiguration {
     hosts :: Hosts,
-    lists :: Lists }
+    lists :: Lists,
+    threshold :: Maybe Weight }
     deriving (Show, Data, Typeable)
 
 
+-- | Choose a nonempty monoid from our two arguments, preferring the
+--   second. So if the second monoid is non-'mempty', we'll return
+--   that. Otherwise the first.
+--
+--   ==== _Examples_
+--
+--   The second list is preferred if both are nonempty:
+--
+--   >>> merge_monoid [1,2] [3,4]
+--   [3,4]
+--
+--   However, if the second list is empty, the first is returned:
+--
+--   >>> merge_monoid [1,2] []
+--   [1,2]
+--
+--   And if both are empty, we return the first (i.e. empty) list:
+--
+--   >>> merge_monoid [] []
+--   []
+--
+merge_monoid :: (Eq a, Monoid a) => a -> a -> a
+merge_monoid l1 l2 = if l2 == mempty then l1 else l2
+
+
+-- | Like 'merge_monoid', except for optional things. We take two
+--   (potentially 'Nothing') values, and then try to choose a
+--   non-'Nothing' one, preferring the second argument.
+--
+--   ==== _Examples_
+--
+--   The second is preferred if it is non-'Nothing':
+--
+--   >>> merge_maybes (Just 3) (Just 4)
+--   Just 4
+--
+--   >>> merge_maybes Nothing (Just 4)
+--   Just 4
+--
+--   However, if the second argument is 'Nothing', the first is
+--   returned:
+--
+--   >>> merge_maybes (Just 1) Nothing
+--   Just 1
+--
+--   If both are 'Nothing', we return 'Nothing':
+--
+--   >>> merge_maybes Nothing Nothing
+--   Nothing
+--
+merge_maybes :: (Maybe a) -> (Maybe a) -> (Maybe a)
+merge_maybes _ y@(Just _) = y
+merge_maybes x@(Just _) Nothing = x
+merge_maybes Nothing Nothing = Nothing
+
+
+-- | Return the (thing contained in the) second argument if it is
+--   non-'Nothing'. Otherwise return the first argument.
+--
+--   ==== _Examples_
+--
+--   The second is preferred if it is non-'Nothing':
+--
+--   >>> merge_maybe 3 (Just 4)
+--   4
+--
+--   However, if the second argument is 'Nothing', the first is
+--   returned:
+--
+--   >>> merge_maybe 1 Nothing
+--   1
+--
+merge_maybe :: a -> Maybe a -> a
+merge_maybe x Nothing = x
+merge_maybe _ (Just y) = y
+
+
 -- | 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
@@ -57,18 +139,14 @@ data OptionalConfiguration =
 --
 instance Monoid OptionalConfiguration where
   -- | An empty OptionalConfiguration.
-  mempty = OptionalConfiguration (Hosts []) (Lists [])
-
+  mempty = OptionalConfiguration mempty mempty Nothing
 
   -- | 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
+  cfg1 `mappend` cfg2 = OptionalConfiguration hs ls t
     where
-      all_hosts = Hosts $ (get_hosts $ hosts cfg1) ++ (get_hosts $ hosts cfg2)
-      all_lists = Lists $ (get_lists $ lists cfg1) ++ (get_lists $ lists cfg2)
-
+      hs = merge_monoid (hosts cfg1) (hosts cfg2)
+      ls = merge_monoid (lists cfg1) (lists cfg2)
+      t  = merge_maybes (threshold cfg1) (threshold cfg2)
 
 
 -- | Obtain an OptionalConfiguration from harblrc in either the global
@@ -83,15 +161,19 @@ instance Monoid OptionalConfiguration where
 from_rc :: IO OptionalConfiguration
 from_rc = do
   etc  <- catchIOError getSysconfDir (\e -> do
-                                        hPutStrLn stderr (show e)
+                                        hPrint stderr e
                                         return "/etc")
   home <- catchIOError getHomeDirectory (\e -> do
-                                           hPutStrLn stderr (show e)
+                                           hPrint stderr 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)
+  cfg_lists <- DC.lookup cfg (pack "lists")
+  cfg_hosts <- DC.lookup cfg (pack "hosts")
+  cfg_threshold <- DC.lookup cfg (pack "threshold")
+  return $ OptionalConfiguration
+             (fromMaybe def cfg_hosts)
+             (fromMaybe def cfg_lists)
+             cfg_threshold