{-# LANGUAGE DeriveDataTypeable #-}

module CommandLine
where

import System.Console.CmdArgs
import System.Console.CmdArgs.Explicit (process)
import System.Environment (getArgs, withArgs)
import System.Exit (ExitCode(..), exitWith)
import System.IO (hPutStrLn, stderr)

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

import ExitCodes

-- We optionally accept input/output files to use instead of
-- stdin/stdout.
data Args = Args { accept_a :: Bool,
                   input_file :: Maybe FilePath,
                   output_file :: Maybe FilePath,
                   rfc5322 :: Bool }
  deriving   (Show, Data, Typeable)

description :: String
description = "Perform naive validation of email addresses."

program_name :: String
program_name = "email-validator"

my_summary :: String
my_summary = program_name ++ "-" ++ (showVersion version)

accept_a_help :: String
accept_a_help =
  "Accept an 'A' record for the domain instead of requiring an MX record."

input_file_help :: String
input_file_help =
  "Path to the input file (default: stdin), one email address per line"

output_file_help :: String
output_file_help =
  "Path to the output file (default: stdout)"

rfc5322_help :: String
rfc5322_help =
  "Validate according to RFC 5322 (incredibly lenient)."

arg_spec :: Mode (CmdArgs Args)
arg_spec =
  cmdArgsMode $
    Args { accept_a    = def &=            help accept_a_help,
           input_file  = def &= typFile &= help input_file_help,
           output_file = def &= typFile &= help output_file_help,
           rfc5322     = def &=            help rfc5322_help }
      &= program program_name
      &= summary my_summary
      &= details [description]

show_help :: IO (CmdArgs Args)
show_help = withArgs ["--help"] parse_args



parse_args :: IO (CmdArgs Args)
parse_args = do
  x <- getArgs
  let y = process arg_spec x
  case y of
    Right result -> return result
    Left err -> do
      hPutStrLn stderr err
      exitWith (ExitFailure exit_args_parse_failed)


-- | Really get the command-line arguments. This calls 'parse_args'
--   first to replace the default "wrong number of arguments" error,
--   and then runs 'cmdArgsApply' on the result to do what the
--   'cmdArgs' function usually does.
apply_args :: IO Args
apply_args =
  parse_args >>= cmdArgsApply