X-Git-Url: http://gitweb.michael.orlitzky.com/?p=haeredes.git;a=blobdiff_plain;f=src%2FCommandLine.hs;h=85381de8703e85868f2308b7bf0644b2159a1008;hp=acd097a7d3094b3a7fe757ae2b23495d81f92af9;hb=c66c2d4fdf14e5b0fa54f39e6061eb4774c7b98a;hpb=70dffd6160208adf2c1c5746924c100cb0ffcb2e

diff --git a/src/CommandLine.hs b/src/CommandLine.hs
index acd097a..85381de 100644
--- a/src/CommandLine.hs
+++ b/src/CommandLine.hs
@@ -2,81 +2,165 @@
 
 module CommandLine (
   Args(..),
-  get_args
-  )
+  get_args )
 where
 
-import System.Console.CmdArgs
+import System.Console.CmdArgs (
+  Ann,
+  Annotate( (:=) ),
+  Data,
+  Typeable,
+  (+=),
+  args,
+  auto,
+  cmdArgs_,
+  def,
+  details,
+  explicit,
+  groupname,
+  help,
+  helpArg,
+  modes_,
+  name,
+  program,
+  record,
+  summary,
+  typ,
+  versionArg )
 
 -- Get the version from Cabal.
-import Paths_haeres (version)
+import Paths_haeredes (version)
 import Data.Version (showVersion)
 
+import Timeout (Timeout(..))
+
+
+-- | Description of the 'NS' mode.
+--
 ns_description :: String
 ns_description =
   "Confirm delegation of NS records. " ++
   "This is the default mode."
 
+
+-- | Description of the 'MX' mode.
+--
 mx_description :: String
 mx_description = "Confirm delegation of MX records."
 
+
+-- | The name of the program, appears in the \"help\" output.
+--
 program_name :: String
-program_name = "haeres"
+program_name = "haeredes"
 
+
+-- | A short summary (program name and version) that are output
+--   as part of the help.
+--
 my_summary :: String
 my_summary = program_name ++ "-" ++ (showVersion version)
 
+
+-- | Description of the --no-append-root flag.
+--
+no_append_root_help :: String
+no_append_root_help =
+  "Don't append a trailing dot to DNS names"
+
+
+-- | Description of the --server flag.
+--
 server_help :: String
 server_help =
-  "IP address of server to query " ++
+  "IP address or hostname of server to query " ++
   "(will use resolv.conf if not specified)"
 
+
+-- | Description of the --timeout flag.
+--
+timeout_help :: String
+timeout_help =
+  "Query timeout, in seconds (default: " ++ defstr ++ ")"
+  where
+    defstr = show $ seconds (def :: Timeout)
+
+
+-- | The 'Args' type represents the possible command-line options. The
+--   duplication here seems necessary; CmdArgs's magic requires us to
+--   define some things explicitly.
+--
 data Args =
-  NS { server :: Maybe String, delegates :: [String] } |
-  MX { server :: Maybe String, delegates :: [String] }
+  NS { no_append_root :: Bool,
+       server :: Maybe String,
+       timeout :: Timeout,
+       delegates :: [String] } |
+  MX { no_append_root :: Bool,
+       server :: Maybe String,
+       timeout :: Timeout,
+       delegates :: [String] }
   deriving (Data, Show, Typeable)
 
-arg_spec :: Args
+
+
+-- | The big argument specification. We use explicit annotation here
+--   because otherwise there's come CmdArgs magic going on that
+--   requires us to specify /all/ of the arguments for /each/ mode;
+--   i.e. we have to duplicate all of them for both 'NS' and 'MX.
+--
+--   This is slightly arcane but at least it doesn't repeat yoself.
+--
+arg_spec :: Annotate Ann
 arg_spec =
-  modes [ns &= auto, mx]
-    &= program program_name
-    &= summary my_summary
-    &= helpArg [explicit,
+  modes_ [ns += auto, mx]
+    += program program_name
+    += summary my_summary
+    += helpArg [explicit,
                 name "help",
                 name "h",
                 groupname "Common flags"]
-    &= versionArg [explicit,
+    += versionArg [explicit,
                    name "version",
                    name "v",
                    groupname "Common flags"]
   where
-    -- The repetition here is necessary, some Template Haskell magic
-    -- going on.
-    ns :: Args
-    ns = NS {
-           server = def
-                  &= groupname "Common flags"
-                  &= typ "IP"
-                  &= help server_help,
-
-           delegates = def
-                     &= args
-                     &= typ "DELEGATES" }
-
-            &= details [ns_description]
-
-    mx :: Args
-    mx = MX {
-           server = def
-                 &= groupname "Common flags"
-                 &= typ "IP"
-                 &= help server_help,
-
-           delegates = def
-                    &= args
-                    &= typ "DELEGATES" }
-
-            &= details [mx_description]
-
+    -- | Create a mode, adding all of the common flags to it
+    --   automatically. The big ugly type of the first argument is
+    --   simply the type of our NS/MX constructors.
+    --
+    make_mode :: (Bool -> Maybe String -> Timeout -> [String] -> Args)
+              -> String
+              -> (Annotate Ann)
+    make_mode ctor desc =
+      record (ctor def def def def) [
+        no_append_root := def
+                       += groupname "Common flags"
+                       += help no_append_root_help,
+
+        server := def
+               += groupname "Common flags"
+               += typ "IP"
+               += help server_help,
+
+        timeout := def
+                += groupname "Common flags"
+                += typ "SECONDS"
+                += help timeout_help,
+
+        delegates := def
+                  += args
+                  += typ "DELEGATES" ]
+        += details ["  " ++ desc]
+
+
+    -- Here we just create the NS/MX modes using our make_mode from above.
+    ns = make_mode NS ns_description
+    mx = make_mode MX mx_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
+get_args = cmdArgs_ arg_spec