Options cleanups

This commit is contained in:
Simon Michael 2009-01-25 08:09:26 +00:00
parent aed74a9ef9
commit f807c0f095

View File

@ -12,7 +12,6 @@ import Ledger.Utils
import Ledger.Types import Ledger.Types
import Ledger.Dates import Ledger.Dates
configflags = [ configflags = [
#ifdef VTY #ifdef VTY
"vty" "vty"
@ -24,18 +23,22 @@ configflags = [
,"happs" ,"happs"
#endif #endif
] ]
versionmsg = "hledger " ++ version ++ configmsg ++ "\n"
version = "0.3.x"
configmsg = if null configflags configmsg = if null configflags
then "" then ""
else " with " ++ intercalate ", " configflags else " with " ++ intercalate ", " configflags
ledgerdefault = "~/.ledger"
version = "0.3.x"
progname = "hledger"
versionmsg = progname ++ " " ++ version ++ configmsg ++ "\n"
ledgerpath = "~/.ledger"
ledgerenvvar = "LEDGER" ledgerenvvar = "LEDGER"
timelogdefault = "~/.timelog"
timelogenvvar = "TIMELOG"
timeprogname = "hours" timeprogname = "hours"
usagehdr = "Usage: hledger [OPTION] COMMAND [ACCTPATTERNS] [-- DESCPATTERNS]\n" ++ timelogpath = "~/.timelog"
"or: hours [OPTIONS] [PERIOD [COMMAND [PATTERNS]]]\n" ++ timelogenvvar = "TIMELOG"
usagehdr =
"Usage: "++progname++" [OPTION] COMMAND [ACCTPATTERNS] [-- DESCPATTERNS]\n" ++
"or: "++timeprogname++" [OPTIONS] [PERIOD [COMMAND [PATTERNS]]]\n" ++
"\n" ++ "\n" ++
"Commands (can be abbreviated):\n" ++ "Commands (can be abbreviated):\n" ++
" balance - show account balances\n" ++ " balance - show account balances\n" ++
@ -52,16 +55,20 @@ usagehdr = "Usage: hledger [OPTION] COMMAND [ACCTPATTERNS] [-- DESCPATTERNS]\
#endif #endif
"\n" ++ "\n" ++
"Options (before command, unless using --options-anywhere):" "Options (before command, unless using --options-anywhere):"
usageftr = "\n" ++
usageftr =
"\n" ++
"All dates can be y/m/d or ledger-style smart dates like \"last month\".\n" ++ "All dates can be y/m/d or ledger-style smart dates like \"last month\".\n" ++
"\n" ++ "\n" ++
"Account and description patterns are regular expressions which filter by\n" ++ "Account and description patterns are regular expressions which filter by\n" ++
"account name and entry description. Prefix a pattern with - to negate it,\n" ++ "account name and entry description. Prefix a pattern with - to negate it,\n" ++
"and separate account and description patterns with --.\n" ++ "and separate account and description patterns with --.\n" ++
"(With --options-anywhere, use ^ and ^^. \"hours\" implies --options-anywhere.)\n" ++ "(With --options-anywhere, use ^ and ^^. \""++timeprogname++"\" implies --options-anywhere.)\n" ++
"\n" ++ "\n" ++
"Also: hledger [-v] test [TESTPATTERNS] to run self-tests.\n" ++ "Also: "++progname++" [-v] test [TESTPATTERNS] to run self-tests.\n" ++
"\n" "\n"
usage = usageInfo usagehdr options ++ usageftr usage = usageInfo usagehdr options ++ usageftr
-- | Command-line options we accept. -- | Command-line options we accept.
@ -92,7 +99,7 @@ options = [
] ]
where where
filehelp = printf "ledger file; - means use standard input. Defaults\nto the %s environment variable or %s" filehelp = printf "ledger file; - means use standard input. Defaults\nto the %s environment variable or %s"
ledgerenvvar ledgerdefault ledgerenvvar ledgerpath
-- | An option value from a command-line flag. -- | An option value from a command-line flag.
data Opt = data Opt =
@ -132,7 +139,7 @@ optValuesForConstructors fs opts = concatMap get opts
-- command arguments. Any dates in the options are converted to full -- command arguments. Any dates in the options are converted to full
-- YYYY/MM/DD format, while we are in the IO monad and can get the current -- YYYY/MM/DD format, while we are in the IO monad and can get the current
-- time. Arguments are parsed differently if the program was invoked as -- time. Arguments are parsed differently if the program was invoked as
-- "hours". -- \"hours\".
parseArguments :: IO ([Opt], String, [String]) parseArguments :: IO ([Opt], String, [String])
parseArguments = do parseArguments = do
args <- getArgs args <- getArgs
@ -227,8 +234,8 @@ ledgerFilePathFromOpts :: [Opt] -> IO String
ledgerFilePathFromOpts opts = do ledgerFilePathFromOpts opts = do
istimequery <- usingTimeProgramName istimequery <- usingTimeProgramName
let (e,d) = if istimequery let (e,d) = if istimequery
then (timelogenvvar,timelogdefault) then (timelogenvvar,timelogpath)
else (ledgerenvvar,ledgerdefault) else (ledgerenvvar,ledgerpath)
envordefault <- getEnv e `catch` \_ -> return d envordefault <- getEnv e `catch` \_ -> return d
paths <- mapM tildeExpand $ [envordefault] ++ optValuesForConstructor File opts paths <- mapM tildeExpand $ [envordefault] ++ optValuesForConstructor File opts
return $ last paths return $ last paths