src/CommandLine.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2
   3 module CommandLine (
   4   Args(..),
   5   get_args )
   6 where
   7
   8 import System.Console.CmdArgs (
   9   Ann,
  10   Annotate( (:=) ),
  11   Data,
  12   Typeable,
  13   (+=),
  14   args,
  15   auto,
  16   cmdArgs_,
  17   def,
  18   details,
  19   explicit,
  20   groupname,
  21   help,
  22   helpArg,
  23   modes_,
  24   name,
  25   program,
  26   record,
  27   summary,
  28   typ,
  29   versionArg )
  30
  31 -- Get the version from Cabal.
  32 import Paths_haeredes (version)
  33 import Data.Version (showVersion)
  34
  35 import Timeout (Timeout(..))
  36
  37
  38 -- | Description of the 'NS' mode.
  39 --
  40 ns_description :: String
  41 ns_description =
  42   "Confirm delegation of NS records. " ++
  43   "This is the default mode."
  44
  45
  46 -- | Description of the 'MX' mode.
  47 --
  48 mx_description :: String
  49 mx_description = "Confirm delegation of MX records."
  50
  51
  52 -- | The name of the program, appears in the \"help\" output.
  53 --
  54 program_name :: String
  55 program_name = "haeredes"
  56
  57
  58 -- | A short summary (program name and version) that are output
  59 --   as part of the help.
  60 --
  61 my_summary :: String
  62 my_summary = program_name ++ "-" ++ (showVersion version)
  63
  64
  65 -- | Description of the --no-append-root flag.
  66 --
  67 no_append_root_help :: String
  68 no_append_root_help =
  69   "Don't append a trailing dot to DNS names"
  70
  71
  72 -- | Description of the --server flag.
  73 --
  74 server_help :: String
  75 server_help =
  76   "IP address or hostname of server to query " ++
  77   "(will use resolv.conf if not specified)"
  78
  79
  80 -- | Description of the --timeout flag.
  81 --
  82 timeout_help :: String
  83 timeout_help =
  84   "Query timeout, in seconds (default: " ++ defstr ++ ")"
  85   where
  86     defstr = show $ seconds (def :: Timeout)
  87
  88
  89 -- | The 'Args' type represents the possible command-line options. The
  90 --   duplication here seems necessary; CmdArgs's magic requires us to
  91 --   define some things explicitly.
  92 --
  93 data Args =
  94   NS { no_append_root :: Bool,
  95        server :: Maybe String,
  96        timeout :: Timeout,
  97        delegates :: [String] } |
  98   MX { no_append_root :: Bool,
  99        server :: Maybe String,
 100        timeout :: Timeout,
 101        delegates :: [String] }
 102   deriving (Data, Show, Typeable)
 103
 104
 105
 106 -- | The big argument specification. We use explicit annotation here
 107 --   because otherwise there's come CmdArgs magic going on that
 108 --   requires us to specify /all/ of the arguments for /each/ mode;
 109 --   i.e. we have to duplicate all of them for both 'NS' and 'MX.
 110 --
 111 --   This is slightly arcane but at least it doesn't repeat yoself.
 112 --
 113 arg_spec :: Annotate Ann
 114 arg_spec =
 115   modes_ [ns += auto, mx]
 116     += program program_name
 117     += summary my_summary
 118     += helpArg [explicit,
 119                 name "help",
 120                 name "h",
 121                 groupname "Common flags"]
 122     += versionArg [explicit,
 123                    name "version",
 124                    name "v",
 125                    groupname "Common flags"]
 126   where
 127     -- | Create a mode, adding all of the common flags to it
 128     --   automatically. The big ugly type of the first argument is
 129     --   simply the type of our NS/MX constructors.
 130     --
 131     make_mode :: (Bool -> Maybe String -> Timeout -> [String] -> Args)
 132               -> String
 133               -> (Annotate Ann)
 134     make_mode ctor desc =
 135       record (ctor def def def def) [
 136         no_append_root := def
 137                        += groupname "Common flags"
 138                        += help no_append_root_help,
 139
 140         server := def
 141                += groupname "Common flags"
 142                += typ "IP"
 143                += help server_help,
 144
 145         timeout := def
 146                 += groupname "Common flags"
 147                 += typ "SECONDS"
 148                 += help timeout_help,
 149
 150         delegates := def
 151                   += args
 152                   += typ "DELEGATES" ]
 153         += details ["  " ++ desc]
 154
 155
 156     -- Here we just create the NS/MX modes using our make_mode from above.
 157     ns = make_mode NS ns_description
 158     mx = make_mode MX mx_description
 159
 160
 161
 162 -- | This is the public interface; i.e. what 'main' should use to get
 163 --   the command-line arguments.
 164 --
 165 get_args :: IO Args
 166 get_args = cmdArgs_ arg_spec