X-Git-Url: http://gitweb.michael.orlitzky.com/?p=haeredes.git;a=blobdiff_plain;f=src%2FCommandLine.hs;h=b94e378e516517e5c9d116fae5fe6979876b509e;hp=699ea97aceea436ce6abecbace894d43542984eb;hb=d5141b436433e6f48cf37fb831026c8ecc4ef3ee;hpb=825753e2731b8491d93d9f2d66b457fe31b1c763 diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 699ea97..b94e378 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -2,46 +2,81 @@ module CommandLine ( Args(..), - Delegates(..), get_args ) 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_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." program_name :: String -program_name = "haeres" +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)" -newtype Delegates = - Delegates { get_delegates :: [String] } - deriving (Data, Show, Typeable) - -instance Default Delegates where - def = Delegates [] +-- | 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 :: Delegates } | - MX { server :: Maybe String, delegates :: Delegates } + 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 @@ -58,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" }