]> gitweb.michael.orlitzky.com - hath.git/blobdiff - src/CommandLine.hs
Add a --sort flag to hath and document/test why it was needed after all.
[hath.git] / src / CommandLine.hs
index c2bbe0c45f15a6e023ab45597de7d8ad82561826..8e6b49cfdef35fd22ce6dcd9badfcec9fc4fffba 100644 (file)
--- 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)
-
-
--- | Lowercase an entire string.
-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']["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 = 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|duped|diffed] [-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.
-  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
-        "duped"   -> 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