{-# LANGUAGE DeriveDataTypeable #-}

module CommandLine (
  Args(..),
  get_args )
where

import System.Console.CmdArgs (
  Ann,
  Annotate( (:=) ),
  Data,
  (+=),
  args,
  auto,
  cmdArgs_,
  def,
  details,
  explicit,
  groupname,
  help,
  helpArg,
  modes_,
  name,
  program,
  record,
  summary,
  typ,
  versionArg )

-- Get the version from Cabal.
import Paths_haeredes (version)
import Data.Version (showVersion)

import Timeout (Timeout(seconds))


-- | Description of the 'NS' mode.
--
ns_description :: String
ns_description =
  "Confirm delegation of NS records. " ++
  "This is the default mode."


-- | Description of the 'MX' mode.
--
mx_description :: String
mx_description = "Confirm delegation of MX records."


-- | The name of the program, appears in the \"help\" output.
--
program_name :: String
program_name = "haeredes"


-- | A short summary (program name and version) that are output
--   as part of the help.
--
my_summary :: String
my_summary = program_name ++ "-" ++ (showVersion version)


-- | Description of the --no-append-root flag.
--
no_append_root_help :: String
no_append_root_help =
  "Don't append a trailing dot to DNS names"


-- | Description of the --server flag.
--
server_help :: String
server_help =
  "IP address or hostname of server to query " ++
  "(will use resolv.conf if not specified)"


-- | Description of the --timeout flag.
--
timeout_help :: String
timeout_help =
  "Query timeout, in seconds (default: " ++ defstr ++ ")"
  where
    defstr = show $ seconds (def :: Timeout)


-- | The 'Args' type represents the possible command-line options. The
--   duplication here seems necessary; CmdArgs's magic requires us to
--   define some things explicitly.
--
data Args =
  NS { no_append_root :: Bool,
       server :: Maybe String,
       timeout :: Timeout,
       delegates :: [String] } |
  MX { no_append_root :: Bool,
       server :: Maybe String,
       timeout :: Timeout,
       delegates :: [String] }
  deriving (Data, Show)



-- | The big argument specification. We use explicit annotation here
--   because otherwise there's come CmdArgs magic going on that
--   requires us to specify /all/ of the arguments for /each/ mode;
--   i.e. we have to duplicate all of them for both 'NS' and 'MX.
--
--   This is slightly arcane but at least it doesn't repeat yoself.
--
arg_spec :: Annotate Ann
arg_spec =
  modes_ [ns += auto, mx]
    += program program_name
    += summary my_summary
    += helpArg [explicit,
                name "help",
                name "h",
                groupname "Common flags"]
    += versionArg [explicit,
                   name "version",
                   name "v",
                   groupname "Common flags"]
  where
    -- | Create a mode, adding all of the common flags to it
    --   automatically. The big ugly type of the first argument is
    --   simply the type of our NS/MX constructors.
    --
    make_mode :: (Bool -> Maybe String -> Timeout -> [String] -> Args)
              -> String
              -> (Annotate Ann)
    make_mode ctor desc =
      record (ctor def def def def) [
        no_append_root := def
                       += groupname "Common flags"
                       += help no_append_root_help,

        server := def
               += groupname "Common flags"
               += typ "IP"
               += help server_help,

        timeout := def
                += groupname "Common flags"
                += typ "SECONDS"
                += help timeout_help,

        delegates := def
                  += args
                  += typ "DELEGATES" ]
        += details ["  " ++ desc]


    -- Here we just create the NS/MX modes using our make_mode from above.
    ns = make_mode NS ns_description
    mx = make_mode MX mx_description



-- | This is the public interface; i.e. what 'main' should use to get
--   the command-line arguments.
--
get_args :: IO Args
get_args = cmdArgs_ arg_spec
