X-Git-Url: http://gitweb.michael.orlitzky.com/?p=haeredes.git;a=blobdiff_plain;f=src%2FCommandLine.hs;h=b94e378e516517e5c9d116fae5fe6979876b509e;hp=39470b23106af79e3b0c69070679971c4ef2cabc;hb=f9610a6d357f2ed79f2f18baa477244970f8b40f;hpb=228abb512bcd019b98d2b3fd7b7283f5ef14d1bc diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 39470b2..b94e378 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -6,17 +6,39 @@ module CommandLine ( ) where -import System.Console.CmdArgs +import System.Console.CmdArgs ( + Data, + Typeable, + (&=), + args, + auto, + cmdArgs, + def, + details, + explicit, + groupname, + help, + helpArg, + modes, + name, + program, + summary, + typ, + versionArg ) -- Get the version from Cabal. 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." @@ -26,14 +48,35 @@ program_name = "haeredes" my_summary :: String my_summary = program_name ++ "-" ++ (showVersion version) +no_append_root_help :: String +no_append_root_help = + "Don't append a trailing dot to DNS names" + +-- | Help string for 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)" +-- | Help string for 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' 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 @@ -50,28 +93,45 @@ arg_spec = name "v", groupname "Common flags"] where - -- The repetition here is necessary, some Template Haskell magic - -- going on. + -- The repetition here is necessary, some CmdArgs magic going on. ns :: Args ns = NS { + no_append_root = def + &= groupname "Common flags" + &= help no_append_root_help, + server = def - &= groupname "Common flags" - &= typ "IP" - &= help server_help, + &= groupname "Common flags" + &= typ "HOST" + &= help server_help, + + timeout = def + &= groupname "Common flags" + &= typ "SECONDS" + &= help timeout_help, delegates = def - &= args - &= typ "DELEGATES" } + &= args + &= typ "DELEGATES" } &= details [ns_description] mx :: Args mx = MX { + 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" }