module CommandLine (
Args(..),
- Delegates(..),
- get_args
- )
+ get_args )
where
-import System.Console.CmdArgs
+import System.Console.CmdArgs (
+ Ann,
+ Annotate( (:=) ),
+ Data,
+ (+=),
+ 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)"
-newtype Delegates =
- Delegates { get_delegates :: [String] }
- deriving (Data, Show, Typeable)
-instance Default Delegates where
- def = Delegates []
+-- | 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 :: Delegates } |
- MX { server :: Maybe String, delegates :: Delegates }
- deriving (Data, Show, Typeable)
-
-arg_spec :: Args
+ 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)
+
+
+
+-- | 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