{-# LANGUAGE DeriveDataTypeable #-} module CommandLine ( Args(..), get_args ) where 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_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 = "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 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 { 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, name "help", name "h", groupname "Common flags"] += versionArg [explicit, name "version", name "v", groupname "Common flags"] where -- | 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