4 import Control.Monad ( liftM, when )
5 import Data.Monoid ( (<>) )
6 import Text.Parsec ( ParseError, parse )
7 import System.Console.CmdArgs ( def )
8 import System.Exit ( exitWith, ExitCode (ExitFailure) )
9 import System.IO ( hPutStrLn, stderr )
11 import CommandLine ( get_args )
12 import Configuration ( Configuration(..), merge_optional )
16 exit_unparseable_host,
17 exit_unparseable_list )
18 import Hosts ( Hosts(..) )
19 import Lists ( Lists(..) )
20 import qualified OptionalConfiguration as OC ( from_rc )
21 import Network.DNS.RBL (
30 -- | The 'concatMapM' function generalizes 'concatMap' to arbitrary monads.
31 -- See e.g. <https://ghc.haskell.org/trac/ghc/ticket/2042>
32 concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
33 concatMapM f xs = liftM concat (mapM f xs)
35 -- | Parse a list of RBL sites from the user's input. If he was nice,
36 -- he would have given us a list of individual RBLs. But we also
37 -- handle the case where a big comma-separated string is given to
40 parse_lists :: Lists -> Either ParseError [Site]
41 parse_lists (Lists ls) = concatMapM (parse sites "") ls
43 -- | Parse a list of hosts from the user's input. Each one should be
44 -- parseable as a 'Host'.
46 parse_hosts :: Hosts -> Either ParseError [Host]
47 parse_hosts (Hosts hs) = mapM (parse host "") hs
55 -- Merge the config file options with the command-line ones,
56 -- prefering the command-line ones.
57 let opt_config = rc_cfg <> cmd_cfg
59 -- Update a default config with any options that have been set in
60 -- either the config file or on the command-line. We initialize
61 -- logging before the missing parameter checks below so that we can
63 let cfg = (def :: Configuration) `merge_optional` opt_config
65 when (null $ get_hosts $ hosts cfg) $
66 exitWith (ExitFailure exit_no_hosts)
68 when (null $ get_lists $ lists cfg) $
69 exitWith (ExitFailure exit_no_lists)
71 case (parse_lists $ lists cfg) of
73 hPutStrLn stderr (show e)
74 exitWith (ExitFailure exit_unparseable_list)
76 case (parse_hosts $ hosts cfg) of
78 hPutStrLn stderr (show e)
79 exitWith (ExitFailure exit_unparseable_host)
81 listings <- concatMapM (lookup_rbl ls) hs
82 mapM_ (putStrLn . listing_message) listings