src/CommandLine.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2
   3 module CommandLine (
   4   Args(..),
   5   get_args )
   6 where
   7
   8 import System.Console.CmdArgs (
   9   Data,
  10   Typeable,
  11   (&=),
  12   args,
  13   auto,
  14   cmdArgs,
  15   def,
  16   details,
  17   explicit,
  18   groupname,
  19   help,
  20   helpArg,
  21   modes,
  22   name,
  23   program,
  24   summary,
  25   typ,
  26   versionArg )
  27
  28 -- Get the version from Cabal.
  29 import Paths_haeredes (version)
  30 import Data.Version (showVersion)
  31
  32 import Timeout (Timeout(..))
  33
  34 -- | Description of the 'NS' mode.
  35 ns_description :: String
  36 ns_description =
  37   "Confirm delegation of NS records. " ++
  38   "This is the default mode."
  39
  40 -- | Description of the 'MX' mode.
  41 mx_description :: String
  42 mx_description = "Confirm delegation of MX records."
  43
  44 program_name :: String
  45 program_name = "haeredes"
  46
  47 my_summary :: String
  48 my_summary = program_name ++ "-" ++ (showVersion version)
  49
  50 no_append_root_help :: String
  51 no_append_root_help =
  52   "Don't append a trailing dot to DNS names"
  53
  54 -- | Help string for the --server flag.
  55 server_help :: String
  56 server_help =
  57   "IP address or hostname of server to query " ++
  58   "(will use resolv.conf if not specified)"
  59
  60 -- | Help string for the --timeout flag.
  61 timeout_help :: String
  62 timeout_help =
  63   "Query timeout, in seconds (default: " ++ defstr ++ ")"
  64   where
  65     defstr = show $ seconds (def :: Timeout)
  66
  67 -- | The Args type represents the possible command-line options. The
  68 --   duplication here seems necessary; CmdArgs' magic requires us to
  69 --   define some things explicitly.
  70 data Args =
  71   NS { no_append_root :: Bool,
  72        server :: Maybe String,
  73        timeout :: Timeout,
  74        delegates :: [String] } |
  75   MX { no_append_root :: Bool,
  76        server :: Maybe String,
  77        timeout :: Timeout,
  78        delegates :: [String] }
  79   deriving (Data, Show, Typeable)
  80
  81 arg_spec :: Args
  82 arg_spec =
  83   modes [ns &= auto, mx]
  84     &= program program_name
  85     &= summary my_summary
  86     &= helpArg [explicit,
  87                 name "help",
  88                 name "h",
  89                 groupname "Common flags"]
  90     &= versionArg [explicit,
  91                    name "version",
  92                    name "v",
  93                    groupname "Common flags"]
  94   where
  95     -- The repetition here is necessary, some CmdArgs magic going on.
  96     ns :: Args
  97     ns = NS {
  98            no_append_root = def
  99                          &= groupname "Common flags"
 100                          &= help no_append_root_help,
 101
 102            server = def
 103                  &= groupname "Common flags"
 104                  &= typ "HOST"
 105                  &= help server_help,
 106
 107            timeout = def
 108                    &= groupname "Common flags"
 109                    &= typ "SECONDS"
 110                    &= help timeout_help,
 111
 112            delegates = def
 113                     &= args
 114                     &= typ "DELEGATES" }
 115
 116             &= details [ns_description]
 117
 118     mx :: Args
 119     mx = MX {
 120            no_append_root = def
 121                          &= groupname "Common flags"
 122                          &= help no_append_root_help,
 123
 124            server = def
 125                  &= groupname "Common flags"
 126                  &= typ "IP"
 127                  &= help server_help,
 128
 129            timeout = def
 130                    &= groupname "Common flags"
 131                    &= typ "SECONDS"
 132                    &= help timeout_help,
 133
 134            delegates = def
 135                     &= args
 136                     &= typ "DELEGATES" }
 137
 138             &= details [mx_description]
 139
 140 get_args :: IO Args
 141 get_args = cmdArgs arg_spec