mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-19 18:29:36 +03:00
0734da2bbe
Mixed positive and negative balances were confusing things. Now, the chart will omit any balances which do not match the sign of the first balance. Various other size/font/colour tweaks. Charts are now red for positive balances (like expense accounts) and green for negative balances (like income accounts). This is fun, but falls down for eg assets and liabilities.. better ideas welcome.
271 lines
11 KiB
Haskell
271 lines
11 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
{-|
|
|
Command-line options for the application.
|
|
-}
|
|
|
|
module Options
|
|
where
|
|
import System.Console.GetOpt
|
|
import System.Environment
|
|
import Ledger.IO (myLedgerPath,myTimelogPath)
|
|
import Ledger.Utils
|
|
import Ledger.Types
|
|
import Ledger.Dates
|
|
import Codec.Binary.UTF8.String (decodeString)
|
|
import Control.Monad (liftM)
|
|
|
|
progname = "hledger"
|
|
timeprogname = "hours"
|
|
#ifdef CHART
|
|
chartoutput = "hledger.png"
|
|
chartitems = 10
|
|
chartsize = "600x400"
|
|
#endif
|
|
|
|
usagehdr =
|
|
"Usage: hledger [OPTIONS] [COMMAND [PATTERNS]]\n" ++
|
|
" hours [OPTIONS] [COMMAND [PATTERNS]]\n" ++
|
|
" hledger convert CSVFILE\n" ++
|
|
"\n" ++
|
|
"hledger uses your ~/.ledger or $LEDGER file (or another specified with -f),\n" ++
|
|
"while hours uses your ~/.timelog or $TIMELOG file.\n" ++
|
|
"\n" ++
|
|
"COMMAND is one of (may be abbreviated):\n" ++
|
|
" add - prompt for new transactions and add them to the ledger\n" ++
|
|
" balance - show accounts, with balances\n" ++
|
|
" convert - read CSV bank data and display in ledger format\n" ++
|
|
" histogram - show a barchart of transactions per day or other interval\n" ++
|
|
" print - show transactions in ledger format\n" ++
|
|
" register - show transactions as a register with running balance\n" ++
|
|
" stats - show various statistics for a ledger\n" ++
|
|
#ifdef VTY
|
|
" ui - run a simple text-based UI\n" ++
|
|
#endif
|
|
#ifdef WEB
|
|
" web - run a simple web-based UI\n" ++
|
|
#endif
|
|
#ifdef CHART
|
|
" chart - generate balances pie chart\n" ++
|
|
#endif
|
|
" test - run self-tests\n" ++
|
|
"\n" ++
|
|
"PATTERNS are regular expressions which filter by account name.\n" ++
|
|
"Prefix with desc: to filter by transaction description instead.\n" ++
|
|
"Prefix with not: to negate a pattern. When using both, not: comes last.\n" ++
|
|
"\n" ++
|
|
"DATES can be y/m/d or ledger-style smart dates like \"last month\".\n" ++
|
|
"\n" ++
|
|
"Options:"
|
|
|
|
usageftr = ""
|
|
usage = usageInfo usagehdr options ++ usageftr
|
|
|
|
-- | Command-line options we accept.
|
|
options :: [OptDescr Opt]
|
|
options = [
|
|
Option "f" ["file"] (ReqArg File "FILE") "use a different ledger/timelog file; - means stdin"
|
|
,Option "b" ["begin"] (ReqArg Begin "DATE") "report on transactions on or after this date"
|
|
,Option "e" ["end"] (ReqArg End "DATE") "report on transactions before this date"
|
|
,Option "p" ["period"] (ReqArg Period "EXPR") ("report on transactions during the specified period\n" ++
|
|
"and/or with the specified reporting interval\n")
|
|
,Option "C" ["cleared"] (NoArg Cleared) "report only on cleared transactions"
|
|
,Option "U" ["uncleared"] (NoArg UnCleared) "report only on uncleared transactions"
|
|
,Option "B" ["cost","basis"] (NoArg CostBasis) "report cost of commodities"
|
|
,Option "" ["depth"] (ReqArg Depth "N") "hide accounts/transactions deeper than this"
|
|
,Option "d" ["display"] (ReqArg Display "EXPR") ("show only transactions matching EXPR (where\n" ++
|
|
"EXPR is 'dOP[DATE]' and OP is <, <=, =, >=, >)")
|
|
,Option "" ["effective"] (NoArg Effective) "use transactions' effective dates, if any"
|
|
,Option "E" ["empty"] (NoArg Empty) "show empty/zero things which are normally elided"
|
|
,Option "R" ["real"] (NoArg Real) "report only on real (non-virtual) transactions"
|
|
,Option "" ["no-total"] (NoArg NoTotal) "balance report: hide the final total"
|
|
-- ,Option "s" ["subtotal"] (NoArg SubTotal) "balance report: show subaccounts"
|
|
,Option "W" ["weekly"] (NoArg WeeklyOpt) "register report: show weekly summary"
|
|
,Option "M" ["monthly"] (NoArg MonthlyOpt) "register report: show monthly summary"
|
|
,Option "Q" ["quarterly"] (NoArg QuarterlyOpt) "register report: show quarterly summary"
|
|
,Option "Y" ["yearly"] (NoArg YearlyOpt) "register report: show yearly summary"
|
|
,Option "h" ["help"] (NoArg Help) "show this help"
|
|
,Option "V" ["version"] (NoArg Version) "show version information"
|
|
,Option "v" ["verbose"] (NoArg Verbose) "show verbose test output"
|
|
,Option "" ["binary-filename"] (NoArg BinaryFilename) "show the download filename for this hledger build"
|
|
,Option "" ["debug"] (NoArg Debug) "show extra debug output; implies verbose"
|
|
,Option "" ["debug-no-ui"] (NoArg DebugNoUI) "run ui commands with no output"
|
|
#ifdef CHART
|
|
,Option "o" ["output"] (ReqArg ChartOutput "FILE") ("chart: output filename (default: "++chartoutput++")")
|
|
,Option "" ["items"] (ReqArg ChartItems "N") ("chart: number of accounts to show (default: "++show chartitems++")")
|
|
,Option "" ["size"] (ReqArg ChartSize "WIDTHxHEIGHT") ("chart: image size (default: "++chartsize++")")
|
|
#endif
|
|
]
|
|
|
|
-- | An option value from a command-line flag.
|
|
data Opt =
|
|
File {value::String} |
|
|
Begin {value::String} |
|
|
End {value::String} |
|
|
Period {value::String} |
|
|
Cleared |
|
|
UnCleared |
|
|
CostBasis |
|
|
Depth {value::String} |
|
|
Display {value::String} |
|
|
Effective |
|
|
Empty |
|
|
Real |
|
|
NoTotal |
|
|
SubTotal |
|
|
WeeklyOpt |
|
|
MonthlyOpt |
|
|
QuarterlyOpt |
|
|
YearlyOpt |
|
|
Help |
|
|
Verbose |
|
|
Version
|
|
| BinaryFilename
|
|
| Debug
|
|
| DebugNoUI
|
|
#ifdef CHART
|
|
| ChartOutput {value::String}
|
|
| ChartItems {value::String}
|
|
| ChartSize {value::String}
|
|
#endif
|
|
deriving (Show,Eq)
|
|
|
|
-- these make me nervous
|
|
optsWithConstructor f opts = concatMap get opts
|
|
where get o = [o | f v == o] where v = value o
|
|
|
|
optsWithConstructors fs opts = concatMap get opts
|
|
where get o = [o | any (== o) fs]
|
|
|
|
optValuesForConstructor f opts = concatMap get opts
|
|
where get o = [v | f v == o] where v = value o
|
|
|
|
optValuesForConstructors fs opts = concatMap get opts
|
|
where get o = [v | any (\f -> f v == o) fs] where v = value o
|
|
|
|
-- | Parse the command-line arguments into options, command name, and
|
|
-- command arguments. Any dates in the options are converted to explicit
|
|
-- YYYY/MM/DD format based on the current time.
|
|
parseArguments :: IO ([Opt], String, [String])
|
|
parseArguments = do
|
|
args <- liftM (map decodeString) getArgs
|
|
let (os,as,es) = getOpt Permute options args
|
|
-- istimequery <- usingTimeProgramName
|
|
-- let os' = if istimequery then (Period "today"):os else os
|
|
os' <- fixOptDates os
|
|
let os'' = if Debug `elem` os' then Verbose:os' else os'
|
|
case (as,es) of
|
|
(cmd:args,[]) -> return (os'',cmd,args)
|
|
([],[]) -> return (os'',"",[])
|
|
(_,errs) -> ioError (userError (concat errs ++ usage))
|
|
|
|
-- | Convert any fuzzy dates within these option values to explicit ones,
|
|
-- based on today's date.
|
|
fixOptDates :: [Opt] -> IO [Opt]
|
|
fixOptDates opts = do
|
|
d <- getCurrentDay
|
|
return $ map (fixopt d) opts
|
|
where
|
|
fixopt d (Begin s) = Begin $ fixSmartDateStr d s
|
|
fixopt d (End s) = End $ fixSmartDateStr d s
|
|
fixopt d (Display s) = -- hacky
|
|
Display $ gsubRegexPRBy "\\[.+?\\]" fixbracketeddatestr s
|
|
where fixbracketeddatestr s = "[" ++ fixSmartDateStr d (init $ tail s) ++ "]"
|
|
fixopt _ o = o
|
|
|
|
-- | Figure out the overall date span we should report on, based on any
|
|
-- begin/end/period options provided. If there is a period option, the
|
|
-- others are ignored.
|
|
dateSpanFromOpts :: Day -> [Opt] -> DateSpan
|
|
dateSpanFromOpts refdate opts
|
|
| not $ null popts = snd $ parsePeriodExpr refdate $ last popts
|
|
| otherwise = DateSpan lastb laste
|
|
where
|
|
popts = optValuesForConstructor Period opts
|
|
bopts = optValuesForConstructor Begin opts
|
|
eopts = optValuesForConstructor End opts
|
|
lastb = listtomaybeday bopts
|
|
laste = listtomaybeday eopts
|
|
listtomaybeday vs = if null vs then Nothing else Just $ parse $ last vs
|
|
where parse = parsedate . fixSmartDateStr refdate
|
|
|
|
-- | Figure out the reporting interval, if any, specified by the options.
|
|
-- If there is a period option, the others are ignored.
|
|
intervalFromOpts :: [Opt] -> Interval
|
|
intervalFromOpts opts =
|
|
case (periodopts, intervalopts) of
|
|
((p:_), _) -> fst $ parsePeriodExpr d p where d = parsedate "0001/01/01" -- unused
|
|
(_, (WeeklyOpt:_)) -> Weekly
|
|
(_, (MonthlyOpt:_)) -> Monthly
|
|
(_, (QuarterlyOpt:_)) -> Quarterly
|
|
(_, (YearlyOpt:_)) -> Yearly
|
|
(_, _) -> NoInterval
|
|
where
|
|
periodopts = reverse $ optValuesForConstructor Period opts
|
|
intervalopts = reverse $ filter (`elem` [WeeklyOpt,MonthlyOpt,QuarterlyOpt,YearlyOpt]) opts
|
|
|
|
-- | Get the value of the (last) depth option, if any, otherwise a large number.
|
|
depthFromOpts :: [Opt] -> Maybe Int
|
|
depthFromOpts opts = listtomaybeint $ optValuesForConstructor Depth opts
|
|
where
|
|
listtomaybeint [] = Nothing
|
|
listtomaybeint vs = Just $ read $ last vs
|
|
|
|
-- | Get the value of the (last) display option, if any.
|
|
displayExprFromOpts :: [Opt] -> Maybe String
|
|
displayExprFromOpts opts = listtomaybe $ optValuesForConstructor Display opts
|
|
where
|
|
listtomaybe [] = Nothing
|
|
listtomaybe vs = Just $ last vs
|
|
|
|
-- | Get a maybe boolean representing the last cleared/uncleared option if any.
|
|
clearedValueFromOpts opts | null os = Nothing
|
|
| last os == Cleared = Just True
|
|
| otherwise = Just False
|
|
where os = optsWithConstructors [Cleared,UnCleared] opts
|
|
|
|
-- | Was the program invoked via the \"hours\" alias ?
|
|
usingTimeProgramName :: IO Bool
|
|
usingTimeProgramName = do
|
|
progname <- getProgName
|
|
return $ map toLower progname == timeprogname
|
|
|
|
-- | Get the ledger file path from options, an environment variable, or a default
|
|
ledgerFilePathFromOpts :: [Opt] -> IO String
|
|
ledgerFilePathFromOpts opts = do
|
|
istimequery <- usingTimeProgramName
|
|
f <- if istimequery then myTimelogPath else myLedgerPath
|
|
return $ last $ f : optValuesForConstructor File opts
|
|
|
|
-- | Gather filter pattern arguments into a list of account patterns and a
|
|
-- list of description patterns. We interpret pattern arguments as
|
|
-- follows: those prefixed with "desc:" are description patterns, all
|
|
-- others are account patterns; also patterns prefixed with "not:" are
|
|
-- negated. not: should come after desc: if both are used.
|
|
parsePatternArgs :: [String] -> ([String],[String])
|
|
parsePatternArgs args = (as, ds')
|
|
where
|
|
descprefix = "desc:"
|
|
(ds, as) = partition (descprefix `isPrefixOf`) args
|
|
ds' = map (drop (length descprefix)) ds
|
|
|
|
-- | Convert application options to the library's generic filter specification.
|
|
optsToFilterSpec :: [Opt] -> [String] -> LocalTime -> FilterSpec
|
|
optsToFilterSpec opts args t = FilterSpec {
|
|
datespan=dateSpanFromOpts (localDay t) opts
|
|
,cleared=clearedValueFromOpts opts
|
|
,real=Real `elem` opts
|
|
,empty=Empty `elem` opts
|
|
,costbasis=CostBasis `elem` opts
|
|
,acctpats=apats
|
|
,descpats=dpats
|
|
,whichdate = if Effective `elem` opts then EffectiveDate else ActualDate
|
|
,depth = depthFromOpts opts
|
|
}
|
|
where (apats,dpats) = parsePatternArgs args
|
|
|
|
-- currentLocalTimeFromOpts opts = listtomaybe $ optValuesForConstructor CurrentLocalTime opts
|
|
-- where
|
|
-- listtomaybe [] = Nothing
|
|
-- listtomaybe vs = Just $ last vs
|
|
|