src/CommandLine.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2
   3 module CommandLine (
   4   Args(..),
   5   Delegates(..),
   6   get_args
   7   )
   8 where
   9
  10 import System.Console.CmdArgs
  11
  12 -- Get the version from Cabal.
  13 import Paths_haeres (version)
  14 import Data.Version (showVersion)
  15
  16 ns_description :: String
  17 ns_description =
  18   "Confirm delegation of NS records. " ++
  19   "This is the default mode."
  20
  21 mx_description :: String
  22 mx_description = "Confirm delegation of MX records."
  23
  24 program_name :: String
  25 program_name = "haeres"
  26
  27 my_summary :: String
  28 my_summary = program_name ++ "-" ++ (showVersion version)
  29
  30 server_help :: String
  31 server_help =
  32   "IP address of server to query " ++
  33   "(will use resolv.conf if not specified)"
  34
  35 newtype Delegates =
  36   Delegates { get_delegates :: [String] }
  37   deriving (Data, Show, Typeable)
  38
  39 instance Default Delegates where
  40   def = Delegates []
  41
  42 data Args =
  43   NS { server :: Maybe String, delegates :: Delegates } |
  44   MX { server :: Maybe String, delegates :: Delegates }
  45   deriving (Data, Show, Typeable)
  46
  47 arg_spec :: Args
  48 arg_spec =
  49   modes [ns &= auto, mx]
  50     &= program program_name
  51     &= summary my_summary
  52     &= helpArg [explicit,
  53                 name "help",
  54                 name "h",
  55                 groupname "Common flags"]
  56     &= versionArg [explicit,
  57                    name "version",
  58                    name "v",
  59                    groupname "Common flags"]
  60   where
  61     -- The repetition here is necessary, some Template Haskell magic
  62     -- going on.
  63     ns :: Args
  64     ns = NS {
  65            server = def
  66                   &= groupname "Common flags"
  67                   &= typ "IP"
  68                   &= help server_help,
  69
  70            delegates = def
  71                      &= args
  72                      &= typ "DELEGATES" }
  73
  74             &= details [ns_description]
  75
  76     mx :: Args
  77     mx = MX {
  78            server = def
  79                  &= groupname "Common flags"
  80                  &= typ "IP"
  81                  &= help server_help,
  82
  83            delegates = def
  84                     &= args
  85                     &= typ "DELEGATES" }
  86
  87             &= details [mx_description]
  88
  89 get_args :: IO Args
  90 get_args = cmdArgs arg_spec