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                    rfc5322 :: Bool }
  24   deriving   (Show, Data, Typeable)
  25
  26 description :: String
  27 description = "Perform naive validation of email addresses."
  28
  29 program_name :: String
  30 program_name = "email-validator"
  31
  32 my_summary :: String
  33 my_summary = program_name ++ "-" ++ (showVersion version)
  34
  35 accept_a_help :: String
  36 accept_a_help =
  37   "Accept an 'A' record for the domain instead of requiring an MX record."
  38
  39 input_file_help :: String
  40 input_file_help =
  41   "Path to the input file (default: stdin), one email address per line"
  42
  43 output_file_help :: String
  44 output_file_help =
  45   "Path to the output file (default: stdout)"
  46
  47 rfc5322_help :: String
  48 rfc5322_help =
  49   "Validate according to RFC 5322 (incredibly lenient)."
  50
  51 arg_spec :: Mode (CmdArgs Args)
  52 arg_spec =
  53   cmdArgsMode $
  54     Args { accept_a    = def &=            help accept_a_help,
  55            input_file  = def &= typFile &= help input_file_help,
  56            output_file = def &= typFile &= help output_file_help,
  57            rfc5322     = def &=            help rfc5322_help }
  58       &= program program_name
  59       &= summary my_summary
  60       &= details [description]
  61
  62 show_help :: IO (CmdArgs Args)
  63 show_help = withArgs ["--help"] parse_args
  64
  65
  66
  67 parse_args :: IO (CmdArgs Args)
  68 parse_args = do
  69   x <- getArgs
  70   let y = process arg_spec x
  71   case y of
  72     Right result -> return result
  73     Left err -> do
  74       hPutStrLn stderr err
  75       exitWith (ExitFailure exit_args_parse_failed)
  76
  77
  78 -- | Really get the command-line arguments. This calls 'parse_args'
  79 --   first to replace the default "wrong number of arguments" error,
  80 --   and then runs 'cmdArgsApply' on the result to do what the
  81 --   'cmdArgs' function usually does.
  82 apply_args :: IO Args
  83 apply_args =
  84   parse_args >>= cmdArgsApply