X-Git-Url: http://gitweb.michael.orlitzky.com/?p=hath.git;a=blobdiff_plain;f=src%2FCommandLine.hs;h=8e6b49cfdef35fd22ce6dcd9badfcec9fc4fffba;hp=7fc614a4205bb614ef0285496c3c121271b0a3ed;hb=2404313e648301064041c12fdab8d2f976c26a64;hpb=e9ec7542beb8d34bc8215d2dfb53b2f5e5cd96a2 diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 7fc614a..8e6b49c 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -1,144 +1,144 @@ --- The CommandLine module handles parsing of the command-line options. --- It should more or less be a black box, providing Main with only the --- information it requires. +{-# LANGUAGE DeriveDataTypeable #-} -module CommandLine -( help_set, - help_text, - input_function, - Mode(..), - parse_errors, - parse_mode -) where - -import Data.Char(toLower) -import System.Console.GetOpt -import System.Environment (getArgs) - - --- Dark magic. -lowercase :: String -> String -lowercase = map toLower - - --- The application currently has four modes. The default, Regex, will --- compute a regular expression matching the input CIDRs. Reduce, on --- the other hand, will combine any redundant/adjacent CIDR blocks --- into one. Dupe will show you what would be removed by Reduce, and --- Diff will show both additions and deletions in a diff-like format. -data Mode = Regex | Reduce | Dupe | Diff - - --- A record containing values for all available options. -data Options = Options { opt_help :: Bool, - opt_input :: IO String } - - --- This constructs an instance of Options, with each of its members --- set to default values. -default_options :: Options -default_options = Options { opt_help = False, - opt_input = getContents } - - --- The options list that we construct associates a function with each --- option. This function is responsible for updating an Options record --- with the appropriate value. +-- | The CommandLine module handles parsing of the command-line +-- options. It should more or less be a black box, providing Main +-- with only the information it requires. +-- +-- Which is why we're allowed all of this unsafe voodoo. +-- +module CommandLine ( + Args(..), + get_args +) +where + +import System.Console.CmdArgs ( + Ann, + Annotate( (:=) ), + Data, + (+=), + auto, + cmdArgs_, + def, + details, + explicit, + groupname, + help, + helpArg, + modes_, + name, + program, + record, + summary, + versionArg ) + +-- Get the version from Cabal. +import Paths_hath (version) +import Data.Version (showVersion) + +-- | The name of our program. +program_name :: String +program_name = "hath" + +-- | A brief summary; displays the program name and version. +my_summary :: String +my_summary = program_name ++ "-" ++ (showVersion version) + +barriers_help :: String +barriers_help = + "(regexed mode) place barriers in front/back of the regex " ++ + "to prevent e.g. '127.0.0.1' from matching '127.0.0.100'" + +normalize_help :: String +normalize_help = + "(reduced mode) normalize the output CIDRs, replacing any " ++ + "masked bits by zeros; e.g. '127.0.0.1/8' -> '127.0.0.0/8'" + + +sort_help :: String +sort_help = + "(reduced mode) sort the output CIDRs by their octets" + + +-- | The Args type represents the possible command-line options. The +-- duplication here seems necessary; CmdArgs' magic requires us to +-- define some things explicitly. -- --- For more information and an example of this idiom, see, +-- The application currently has five modes (if this number is wrong, +-- it means I forgot to update the comment!), all of which take the +-- same options and arguments. -- --- http://www.haskell.org/haskellwiki/High-level_option_handling_with_GetOpt +data Args = + Regexed { barriers :: Bool, normalize :: Bool, sort :: Bool } | + Reduced { barriers :: Bool, normalize :: Bool, sort :: Bool } | + Duped { barriers :: Bool, normalize :: Bool, sort :: Bool } | + Diffed { barriers :: Bool, normalize :: Bool, sort :: Bool } | + Listed { barriers :: Bool, normalize :: Bool, sort :: Bool } + deriving (Data, Show) + +-- | Description of the 'Regexed' mode. +regexed_description :: String +regexed_description = + "Compute a regular expression matching the input CIDRs." + +-- | Description of the 'Reduced' mode. +reduced_description :: String +reduced_description = + "Combine any redundant/adjacent CIDR blocks into one." + +-- | Description of the 'Duped' mode. +duped_description :: String +duped_description = "Display what would be removed by 'reduced'." + +-- | Description of the 'Diffed' mode. +diffed_description :: String +diffed_description = + "Display both additions and deletions in a diff-like format." + +-- | Description of the 'Listed' mode. +listed_description :: String +listed_description = + "Enumerate the IP addresses contained within the input CIDRs." + +-- | We use explicit annotation here because if we use the magic +-- annotation, we have to duplicate the same argument definitions six +-- times. -- -options :: [OptDescr (Options -> IO Options)] -options = - [ Option ['h'][] (NoArg set_help) "Prints this help message.", - Option ['i'][] (ReqArg set_input "FILE") "Read FILE instead of stdin." ] - --- Takes an Options as an argument, and sets its opt_help member to --- True. -set_help :: Options -> IO Options -set_help opts = do - return opts { opt_help = True } - - --- If the input file option is set, this function will update the --- passed Options record with a new function for opt_input. The --- default opt_input is to read from stdin, but if this option is set, --- we replace that with readFile. -set_input :: String -> Options -> IO Options -set_input arg opts = do - return opts { opt_input = readFile arg } - - --- The usage header -usage :: String -usage = "Usage: hath [regexed|reduced|duplicated|diffed] [-h] [-i FILE]" - - --- The usage header, and all available flags (as generated by GetOpt) -help_text :: String -help_text = usageInfo usage options - - --- Return a list of options. -parse_options :: IO Options -parse_options = do - argv <- getArgs - let (actions, _, _) = getOpt Permute options argv - - -- This will execute each of the functions contained in our options - -- list, one after another, on a default_options record. The end - -- result should be an Options instance with all of its members set - -- correctly. - opts <- foldl (>>=) (return default_options) actions - - return opts - - --- Return the mode if one was given. -parse_mode :: IO Mode -parse_mode = do - argv <- getArgs - let (_, non_options, _) = getOpt Permute options argv - if (null non_options) - then do - -- Default - return Regex - else do - -- Some non-option was given, but were any of them modes? - case (lowercase (non_options !! 0)) of - "regex" -> return Regex - "regexed" -> return Regex - "reduce" -> return Reduce - "reduced" -> return Reduce - "dupe" -> return Dupe - "duplicated" -> return Dupe - "diff" -> return Diff - "diffed" -> return Diff - _ -> return Regex - - - - --- Return a list of errors. -parse_errors :: IO [String] -parse_errors = do - argv <- getArgs - let (_, _, errors) = getOpt Permute options argv - return errors - - - --- Is the help option set? -help_set :: IO Bool -help_set = do - opts <- parse_options - return (opt_help opts) - - --- Return our input function, getContents by default, or readFile if --- the input file option was set. -input_function :: IO (IO String) -input_function = do - opts <- parse_options - return (opt_input opts) +arg_spec :: Annotate Ann +arg_spec = + modes_ [regexed += auto, reduced, duped, diffed, listed] + += program program_name + += summary my_summary + += helpArg [explicit, + name "help", + name "h", + groupname "Common flags"] + += versionArg [explicit, + name "version", + name "v", + groupname "Common flags"] + where + make_mode :: (Bool -> Bool -> Bool -> Args) -> String -> (Annotate Ann) + make_mode ctor desc = + record (ctor def def def) + [ barriers := def + += groupname "Common flags" + += help barriers_help, + normalize := def + += groupname "Common flags" + += help normalize_help, + sort := def + += groupname "Common flags" + += help sort_help ] + += details [" " ++ desc] + + regexed = make_mode Regexed regexed_description + reduced = make_mode Reduced reduced_description + duped = make_mode Duped duped_description + diffed = make_mode Diffed diffed_description + listed = make_mode Listed listed_description + +-- | This is the public interface; i.e. what main() should use to get +-- the command-line arguments. +get_args :: IO Args +get_args = cmdArgs_ arg_spec