+{-# LANGUAGE DeriveDataTypeable #-}
+
-- | 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.
-module CommandLine
-( help_set,
- help_text,
- input_function,
- Mode(..),
- parse_errors,
- parse_mode)
-where
-
-import Data.Char (toLower)
-import System.Console.GetOpt (
- ArgDescr(NoArg, ReqArg),
- ArgOrder(Permute),
- OptDescr(..),
- getOpt,
- usageInfo )
-import System.Environment (getArgs)
-
-
--- | Lowercase an entire string.
-lowercase :: String -> String
-lowercase = map toLower
-
-
--- | The application currently has six 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.
--
--- Diff will show both additions and deletions in a diff-like
--- format.
+-- Which is why we're allowed all of this unsafe voodoo.
--
--- List will enumerate the IP addresses contained within the input
--- CIDRs.
---
--- Reverse will perform a reverse DNS (PTR) lookup on each IP
--- address contained within the input CIDRs.
---
-data Mode = Regex | Reduce | Dupe | Diff | List | Reverse
-
-
--- | 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 }
-
+module CommandLine (
+ Args(..),
+ get_args
+)
+where
--- | 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.
+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" ["help"] (NoArg set_help) "Prints this help message.",
- Option "i" ["input"] (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 =
- 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 =
- return opts { opt_input = readFile arg }
-
-
--- | The usage header.
-usage :: String
-usage =
- "Usage: hath " ++
- "[regexed|reduced|duped|diffed|listed|reversed] " ++
- "[-h] " ++
- "[-i FILE] " ++
- "<input>"
-
-
--- | 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.
- foldl (>>=) (return default_options) actions
-
-
-
--- | Return the mode if one was given.
-parse_mode :: IO Mode
-parse_mode = do
- argv <- getArgs
- let (_, non_options, _) = getOpt Permute options argv
- return $ case non_options of
- -- Default
- [] -> Regex
- -- Some non-option was given, but were any of them modes?
- (x:_) ->
- case (lowercase x) of
- "regex" -> Regex
- "regexed" -> Regex
- "reduce" -> Reduce
- "reduced" -> Reduce
- "dupe" -> Dupe
- "duped" -> Dupe
- "diff" -> Diff
- "diffed" -> Diff
- "list" -> List
- "listed" -> List
- "reverse" -> Reverse
- "reversed" -> Reverse
- _ -> 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