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