From: Michael Orlitzky Date: Wed, 29 May 2013 19:21:30 +0000 (-0400) Subject: Add command-line processing. X-Git-Tag: 0.0.2~12 X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=a6d2e7470f17b44c0e8fe31c1268488a6788631f;p=email-validator.git Add command-line processing. --- diff --git a/src/CommandLine.hs b/src/CommandLine.hs new file mode 100644 index 0000000..1088f2a --- /dev/null +++ b/src/CommandLine.hs @@ -0,0 +1,72 @@ +{-# 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 { input_file :: Maybe FilePath, + output_file :: Maybe FilePath } + 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) + +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)" + +arg_spec :: Mode (CmdArgs Args) +arg_spec = + cmdArgsMode $ + Args { input_file = def &= typFile &= help input_file_help, + output_file = def &= typFile &= help output_file_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 diff --git a/src/ExitCodes.hs b/src/ExitCodes.hs new file mode 100644 index 0000000..a48980f --- /dev/null +++ b/src/ExitCodes.hs @@ -0,0 +1,12 @@ +-- | All exit codes that the program can return (excepting +-- ExitSuccess). There's only one, since the program will try and +-- fail forever upon errors. +module ExitCodes +where + +-- |Indicates that the command-line arguments could not be parsed. +exit_args_parse_failed :: Int +exit_args_parse_failed = 1 + +exit_input_file_doesnt_exist :: Int +exit_input_file_doesnt_exist = 2 diff --git a/src/Main.hs b/src/Main.hs index bd3cc45..f38a7db 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,9 +1,11 @@ {-# LANGUAGE DoAndIfThenElse #-} +{-# LANGUAGE RecordWildCards #-} module Main where import Control.Concurrent.ParallelIO.Global (parallel, stopGlobalPool) +import Control.Monad (when) import qualified Data.ByteString as BS import qualified Data.ByteString.UTF8 as BSU import Network.DNS ( @@ -14,9 +16,21 @@ import Network.DNS ( makeResolvSeed, withResolver) import Network.DNS.Lookup (lookupMX) -import System.IO (hGetContents, hFlush, hPutStrLn, stdin, stdout) +import System.Directory (doesFileExist) +import System.Exit (exitWith, ExitCode(..)) +import System.IO ( + Handle, + IOMode( WriteMode ), + hClose, + hFlush, + openFile, + stdin, + stdout) import Text.Regex.PCRE.Light (compile, match, utf8) +import CommandLine (Args(..), apply_args) +import ExitCodes (exit_input_file_doesnt_exist) + type Address = BSU.ByteString -- | Resolver parameters. We increase the default timeout from 3 to 5 @@ -96,19 +110,40 @@ validate resolver address = do else do return (address, False) + +append_handle_with_newline :: Handle -> BS.ByteString -> IO () +append_handle_with_newline h bs = do + BS.hPutStr h bs + BS.hPutStr h newline + where + newline = BSU.fromString "\n" + + main :: IO () main = do - input <- hGetContents stdin + Args{..} <- apply_args + + input <- case input_file of + Nothing -> BS.hGetContents stdin + Just path -> do + is_file <- doesFileExist path + when (not is_file) $ do + exitWith (ExitFailure exit_input_file_doesnt_exist) + BS.readFile path - let addresses = BSU.lines $ BSU.fromString input + output_handle <- case output_file of + Nothing -> return stdout + Just path -> openFile path WriteMode + + let addresses = BSU.lines input let nonempty_addresses = filter (not . BS.null) addresses rs <- makeResolvSeed resolv_conf withResolver rs $ \resolver -> do let actions = map (validate resolver) nonempty_addresses results <- parallel actions + stopGlobalPool let good_pairs = filter snd results - mapM_ ((hPutStrLn stdout) . BSU.toString . fst) good_pairs - - stopGlobalPool - hFlush stdout + mapM_ ((append_handle_with_newline output_handle) . fst) good_pairs + hFlush output_handle + hClose output_handle