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   merge_maybe,
  15   merge_monoid,
  16   from_rc )
  17 where
  18
  19 -- System imports.
  20 import qualified Data.Configurator as DC (
  21   Worth(Optional),
  22   load,
  23   lookup )
  24 import Data.Data ( Data )
  25 import Data.Maybe ( fromMaybe )
  26 import Data.Monoid ( Monoid(..) )
  27 import Data.Typeable ( Typeable )
  28 import Paths_harbl ( getSysconfDir )
  29 import System.Console.CmdArgs.Default ( Default(..) )
  30 import System.Directory ( getHomeDirectory )
  31 import System.FilePath ( (</>) )
  32 import System.IO.Error ( catchIOError )
  33 import System.IO ( hPutStrLn, stderr )
  34
  35 -- Harbl library imports.
  36 import Network.DNS.RBL.Weight ( Weight )
  37
  38 -- Local imports.
  39 import Hosts ( Hosts(..) )
  40 import Lists ( Lists(..) )
  41
  42
  43 -- | The same as 'Configuration', except everything is optional. It's
  44 --   easy to merge two of these by simply dropping the 'Nothing's in
  45 --   favor of the 'Just's. The 'xml_files' are left un-maybed so that
  46 --   cmdargs can parse more than one of them.
  47 --
  48 data OptionalConfiguration =
  49   OptionalConfiguration {
  50     hosts :: Hosts,
  51     lists :: Lists,
  52     threshold :: Maybe Weight }
  53     deriving (Show, Data, Typeable)
  54
  55
  56 -- | Choose a nonempty monoid from our two arguments, preferring the
  57 --   second. So if the second monoid is non-'mempty', we'll return
  58 --   that. Otherwise the first.
  59 --
  60 --   ==== _Examples_
  61 --
  62 --   The second list is preferred if both are nonempty:
  63 --
  64 --   >>> merge_monoid [1,2] [3,4]
  65 --   [3,4]
  66 --
  67 --   However, if the second list is empty, the first is returned:
  68 --
  69 --   >>> merge_monoid [1,2] []
  70 --   [1,2]
  71 --
  72 --   And if both are empty, we return the first (i.e. empty) list:
  73 --
  74 --   >>> merge_monoid [] []
  75 --   []
  76 --
  77 merge_monoid :: (Eq a, Monoid a) => a -> a -> a
  78 merge_monoid l1 l2 = if l2 == mempty then l1 else l2
  79
  80
  81 -- | Like 'merge_monoid', except for optional things. We take two
  82 --   (potentially 'Nothing') values, and then try to choose a
  83 --   non-'Nothing' one, preferring the second argument.
  84 --
  85 --   ==== _Examples_
  86 --
  87 --   The second is preferred if it is non-'Nothing':
  88 --
  89 --   >>> merge_maybes (Just 3) (Just 4)
  90 --   Just 4
  91 --
  92 --   >>> merge_maybes Nothing (Just 4)
  93 --   Just 4
  94 --
  95 --   However, if the second argument is 'Nothing', the first is
  96 --   returned:
  97 --
  98 --   >>> merge_maybes (Just 1) Nothing
  99 --   Just 1
 100 --
 101 --   If both are 'Nothing', we return 'Nothing':
 102 --
 103 --   >>> merge_maybes Nothing Nothing
 104 --   Nothing
 105 --
 106 merge_maybes :: (Maybe a) -> (Maybe a) -> (Maybe a)
 107 merge_maybes _ y@(Just _) = y
 108 merge_maybes x@(Just _) Nothing = x
 109 merge_maybes Nothing Nothing = Nothing
 110
 111
 112 -- | Return the (thing contained in the) second argument if it is
 113 --   non-'Nothing'. Otherwise return the first argument.
 114 --
 115 --   ==== _Examples_
 116 --
 117 --   The second is preferred if it is non-'Nothing':
 118 --
 119 --   >>> merge_maybe 3 (Just 4)
 120 --   4
 121 --
 122 --   However, if the second argument is 'Nothing', the first is
 123 --   returned:
 124 --
 125 --   >>> merge_maybe 1 Nothing
 126 --   1
 127 --
 128 merge_maybe :: a -> Maybe a -> a
 129 merge_maybe x Nothing = x
 130 merge_maybe _ (Just y) = y
 131
 132
 133 -- | The Monoid instance for these lets us \"combine\" two
 134 --   OptionalConfigurations. The \"combine\" operation that we'd like to
 135 --   perform is, essentially, to mash them together. So if we have two
 136 --   OptionalConfigurations, each half full, we could combine them
 137 --   into one big one.
 138 --
 139 --   This is used to merge command-line and config-file settings.
 140 --
 141 instance Monoid OptionalConfiguration where
 142   -- | An empty OptionalConfiguration.
 143   mempty = OptionalConfiguration mempty mempty Nothing
 144
 145   -- | Combine @cfg1@ and @cfg2@, giving precedence to @cfg2@.
 146   cfg1 `mappend` cfg2 = OptionalConfiguration hs ls t
 147     where
 148       hs = merge_monoid (hosts cfg1) (hosts cfg2)
 149       ls = merge_monoid (lists cfg1) (lists cfg2)
 150       t  = merge_maybes (threshold cfg1) (threshold cfg2)
 151
 152
 153 -- | Obtain an OptionalConfiguration from harblrc in either the global
 154 --   configuration directory or the user's home directory. The one in
 155 --   $HOME is prefixed by a dot so that it is hidden.
 156 --
 157 --   We make an attempt at cross-platform compatibility; we will try
 158 --   to find the correct directory even on Windows. But if the calls
 159 --   to getHomeDirectory/getSysconfDir fail for whatever reason, we
 160 --   fall back to using the Unix-specific /etc and $HOME.
 161 --
 162 from_rc :: IO OptionalConfiguration
 163 from_rc = do
 164   etc  <- catchIOError getSysconfDir (\e -> do
 165                                         hPutStrLn stderr (show e)
 166                                         return "/etc")
 167   home <- catchIOError getHomeDirectory (\e -> do
 168                                            hPutStrLn stderr (show e)
 169                                            return "$(HOME)")
 170   let global_config_path = etc </> "harblrc"
 171   let user_config_path = home </> ".harblrc"
 172   cfg <- DC.load [ DC.Optional global_config_path,
 173                    DC.Optional user_config_path ]
 174   cfg_lists <- DC.lookup cfg "lists"
 175   cfg_hosts <- DC.lookup cfg "hosts"
 176   cfg_threshold <- DC.lookup cfg "threshold"
 177   return $ OptionalConfiguration
 178              (fromMaybe def cfg_hosts)
 179              (fromMaybe def cfg_lists)
 180              cfg_threshold