X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Flwn-epub.git;a=blobdiff_plain;f=src%2FCommandLine.hs;h=455f7fd7a9416f0e417829ae9f6cad1020670c41;hp=d9be034d5f5ec5734a753ede3d791458be0c28fd;hb=ebedcdb6b1b8925dcfb5700d076f25743fac8645;hpb=ed2ed8abd62ba3dec7f799253de1133732f8c153 diff --git a/src/CommandLine.hs b/src/CommandLine.hs index d9be034..455f7fd 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -1,6 +1,10 @@ {-# LANGUAGE DeriveDataTypeable #-} -module CommandLine (Args(..), apply_args) +module CommandLine ( + Args(..), + apply_args, + program_name, + show_help) where -- Get the version from Cabal. @@ -17,9 +21,12 @@ import System.Console.CmdArgs ( argPos, cmdArgsApply, cmdArgsMode, + def, details, + help, program, typ, + typFile, summary ) @@ -33,7 +40,8 @@ import ExitCodes data Args = - Args { article :: String } + Args { output :: FilePath, + article :: String } deriving (Show, Data, Typeable) @@ -47,9 +55,15 @@ lwn_epub_summary :: String lwn_epub_summary = program_name ++ "-" ++ (showVersion version) +output_help :: String +output_help = "Output file, defaults to stdout" + arg_spec :: Mode (CmdArgs Args) arg_spec = cmdArgsMode $ - Args { article = "" &= argPos 0 &= typ "ARTICLE" } + Args { + output = def &= typFile &= help output_help, + article = def &= argPos 0 &= typ "ARTICLE" + } &= program program_name &= summary lwn_epub_summary &= details [description] @@ -60,6 +74,10 @@ is_missing_arg_error :: String -> Bool is_missing_arg_error s = startswith "Requires at least" s + +show_help :: IO (CmdArgs Args) +show_help = withArgs ["--help"] parse_args + parse_args :: IO (CmdArgs Args) parse_args = do x <- getArgs @@ -68,14 +86,17 @@ parse_args = do Right result -> return result Left err -> if (is_missing_arg_error err) then - withArgs ["--help"] parse_args + -- Disregard the error message, show help instead. + show_help else do hPutStrLn stderr err exitWith (ExitFailure exit_args_parse_failed) - -- Disregard the error message, show help instead. +-- | 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 = do - x <- parse_args - cmdArgsApply x +apply_args = + parse_args >>= cmdArgsApply