src/CommandLine.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2
   3 module CommandLine
   4 where
   5
   6 import System.Console.CmdArgs
   7 import System.Console.CmdArgs.Explicit (process)
   8 import System.Environment (getArgs, withArgs)
   9 import System.Exit (ExitCode(..), exitWith)
  10 import System.IO (hPutStrLn, stderr)
  11
  12 -- Get the version from Cabal.
  13 import Paths_email_validator (version)
  14 import Data.Version (showVersion)
  15
  16 import ExitCodes
  17
  18 -- We optionally accept input/output files to use instead of
  19 -- stdin/stdout.
  20 data Args = Args { accept_a :: Bool,
  21                    input_file :: Maybe FilePath,
  22                    output_file :: Maybe FilePath }
  23   deriving   (Show, Data, Typeable)
  24
  25 description :: String
  26 description = "Perform naive validation of email addresses."
  27
  28 program_name :: String
  29 program_name = "email-validator"
  30
  31 my_summary :: String
  32 my_summary = program_name ++ "-" ++ (showVersion version)
  33
  34 accept_a_help :: String
  35 accept_a_help =
  36   "Accept an 'A' record for the domain instead of requiring an MX record."
  37
  38 input_file_help :: String
  39 input_file_help =
  40   "Path to the input file (default: stdin), one email address per line"
  41
  42 output_file_help :: String
  43 output_file_help =
  44   "Path to the output file (default: stdout)"
  45
  46 arg_spec :: Mode (CmdArgs Args)
  47 arg_spec =
  48   cmdArgsMode $
  49     Args { accept_a    = def &=            help accept_a_help,
  50            input_file  = def &= typFile &= help input_file_help,
  51            output_file = def &= typFile &= help output_file_help }
  52       &= program program_name
  53       &= summary my_summary
  54       &= details [description]
  55
  56 show_help :: IO (CmdArgs Args)
  57 show_help = withArgs ["--help"] parse_args
  58
  59
  60
  61 parse_args :: IO (CmdArgs Args)
  62 parse_args = do
  63   x <- getArgs
  64   let y = process arg_spec x
  65   case y of
  66     Right result -> return result
  67     Left err -> do
  68       hPutStrLn stderr err
  69       exitWith (ExitFailure exit_args_parse_failed)
  70
  71
  72 -- | Really get the command-line arguments. This calls 'parse_args'
  73 --   first to replace the default "wrong number of arguments" error,
  74 --   and then runs 'cmdArgsApply' on the result to do what the
  75 --   'cmdArgs' function usually does.
  76 apply_args :: IO Args
  77 apply_args =
  78   parse_args >>= cmdArgsApply