src/CommandLine.hs

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