{-# 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(..), merge_maybe, merge_monoid, 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 ) -- Harbl library imports. import Network.DNS.RBL.Weight ( Weight ) -- 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, 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 -- 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 mempty mempty Nothing -- | Combine @cfg1@ and @cfg2@, giving precedence to @cfg2@. cfg1 `mappend` cfg2 = OptionalConfiguration hs ls t where 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 -- 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" cfg_hosts <- DC.lookup cfg "hosts" cfg_threshold <- DC.lookup cfg "threshold" return $ OptionalConfiguration (fromMaybe def cfg_hosts) (fromMaybe def cfg_lists) cfg_threshold