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