2009-01-20 07:31:11 +03:00
|
|
|
{-# OPTIONS_GHC -cpp #-}
|
2008-10-10 05:53:39 +04:00
|
|
|
module Options
|
2007-02-10 20:36:50 +03:00
|
|
|
where
|
2008-10-08 21:00:22 +04:00
|
|
|
import System
|
2007-01-30 12:07:12 +03:00
|
|
|
import System.Console.GetOpt
|
2007-03-12 10:40:33 +03:00
|
|
|
import System.Directory
|
2009-01-23 05:04:31 +03:00
|
|
|
import System.Environment
|
2008-11-24 01:15:51 +03:00
|
|
|
import Text.Printf
|
2009-01-23 05:04:31 +03:00
|
|
|
import Data.Char (toLower)
|
2008-11-26 07:04:05 +03:00
|
|
|
import Ledger.Parse
|
2008-11-25 00:51:31 +03:00
|
|
|
import Ledger.Utils
|
2008-11-27 03:35:00 +03:00
|
|
|
import Ledger.Types
|
|
|
|
import Ledger.Dates
|
2008-11-25 00:51:31 +03:00
|
|
|
|
2009-01-25 11:09:26 +03:00
|
|
|
progname = "hledger"
|
|
|
|
ledgerpath = "~/.ledger"
|
|
|
|
ledgerenvvar = "LEDGER"
|
|
|
|
timeprogname = "hours"
|
|
|
|
timelogpath = "~/.timelog"
|
|
|
|
timelogenvvar = "TIMELOG"
|
|
|
|
|
2009-01-25 11:44:14 +03:00
|
|
|
usagehdr = printf (
|
|
|
|
"Usage: one of\n" ++
|
|
|
|
" %s [OPTIONS] COMMAND [ACCTPATTERNS] [-- DESCPATTERNS]\n" ++
|
|
|
|
" %s [OPTIONS] [PERIOD [COMMAND [PATTERNS]]]\n" ++
|
2009-01-25 11:09:26 +03:00
|
|
|
"\n" ++
|
|
|
|
"Commands (can be abbreviated):\n" ++
|
|
|
|
" balance - show account balances\n" ++
|
|
|
|
" print - show formatted ledger entries\n" ++
|
|
|
|
" register - show register transactions\n" ++
|
2009-01-20 07:31:11 +03:00
|
|
|
#ifdef VTY
|
2009-01-25 11:09:26 +03:00
|
|
|
" ui - run a simple vty-based text ui\n" ++
|
2009-01-20 07:31:11 +03:00
|
|
|
#endif
|
|
|
|
#ifdef ANSI
|
2009-01-25 11:09:26 +03:00
|
|
|
" ansi - run a simple ansi-based text ui\n" ++
|
2009-01-20 07:31:34 +03:00
|
|
|
#endif
|
|
|
|
#ifdef HAPPS
|
2009-01-25 11:09:26 +03:00
|
|
|
" happs - run a web server providing a minimal web ui\n" ++
|
2009-01-20 07:31:11 +03:00
|
|
|
#endif
|
2009-01-25 11:09:26 +03:00
|
|
|
"\n" ++
|
|
|
|
"Options (before command, unless using --options-anywhere):"
|
2009-01-25 11:44:14 +03:00
|
|
|
) progname timeprogname
|
2009-01-25 11:09:26 +03:00
|
|
|
|
|
|
|
|
2009-01-25 11:44:14 +03:00
|
|
|
usageftr = printf (
|
2009-01-25 11:09:26 +03:00
|
|
|
"\n" ++
|
|
|
|
"All dates can be y/m/d or ledger-style smart dates like \"last month\".\n" ++
|
|
|
|
"\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" ++
|
|
|
|
"and separate account and description patterns with --.\n" ++
|
2009-01-25 11:44:14 +03:00
|
|
|
"(With --options-anywhere, use ^ and ^^. \"%s\" implies --options-anywhere.)\n" ++
|
2009-01-25 11:09:26 +03:00
|
|
|
"\n" ++
|
2009-01-25 11:44:14 +03:00
|
|
|
"Also: %s [-v] test [TESTPATTERNS] to run self-tests.\n" ++
|
2009-01-25 11:09:26 +03:00
|
|
|
"\n"
|
2009-01-25 11:44:14 +03:00
|
|
|
) timeprogname progname
|
2009-01-25 11:09:26 +03:00
|
|
|
|
2008-11-26 08:21:44 +03:00
|
|
|
usage = usageInfo usagehdr options ++ usageftr
|
2007-02-16 12:00:17 +03:00
|
|
|
|
2008-10-08 21:24:59 +04:00
|
|
|
-- | Command-line options we accept.
|
|
|
|
options :: [OptDescr Opt]
|
|
|
|
options = [
|
2008-12-08 20:27:16 +03:00
|
|
|
Option ['f'] ["file"] (ReqArg File "FILE") filehelp
|
|
|
|
,Option ['b'] ["begin"] (ReqArg Begin "DATE") "report on entries on or after this date"
|
|
|
|
,Option ['e'] ["end"] (ReqArg End "DATE") "report on entries prior to this date"
|
|
|
|
,Option ['p'] ["period"] (ReqArg Period "EXPR") ("report on entries during the specified period\n" ++
|
|
|
|
"and/or with the specified reporting interval\n")
|
|
|
|
,Option ['C'] ["cleared"] (NoArg Cleared) "report only on cleared entries"
|
|
|
|
,Option ['B'] ["cost","basis"] (NoArg CostBasis) "report cost basis of commodities"
|
|
|
|
,Option [] ["depth"] (ReqArg Depth "N") "balance report: maximum account depth to show"
|
|
|
|
,Option ['d'] ["display"] (ReqArg Display "EXPR") ("display only transactions matching simple EXPR\n" ++
|
|
|
|
"(where EXPR is 'dOP[DATE]', OP is <, <=, =, >=, >)")
|
|
|
|
,Option ['E'] ["empty"] (NoArg Empty) "balance report: show accounts with zero balance"
|
|
|
|
,Option ['R'] ["real"] (NoArg Real) "report only on real (non-virtual) transactions"
|
|
|
|
,Option ['n'] ["collapse"] (NoArg Collapse) "balance report: no grand 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 ['Y'] ["yearly"] (NoArg YearlyOpt) "register report: show yearly summary"
|
|
|
|
,Option ['h'] ["help"] (NoArg Help) "show this help"
|
|
|
|
,Option ['v'] ["verbose"] (NoArg Verbose) "verbose test output"
|
|
|
|
,Option ['V'] ["version"] (NoArg Version) "show version"
|
2009-01-20 08:57:25 +03:00
|
|
|
,Option [] ["debug-no-ui"] (NoArg DebugNoUI) "run ui commands without no output"
|
|
|
|
,Option [] ["options-anywhere"] (NoArg OptionsAnywhere) "allow options anywhere on the command line"
|
2008-10-08 21:24:59 +04:00
|
|
|
]
|
2008-11-24 03:14:28 +03:00
|
|
|
where
|
|
|
|
filehelp = printf "ledger file; - means use standard input. Defaults\nto the %s environment variable or %s"
|
2009-01-25 11:09:26 +03:00
|
|
|
ledgerenvvar ledgerpath
|
2007-02-09 04:23:12 +03:00
|
|
|
|
2008-10-08 21:24:59 +04:00
|
|
|
-- | An option value from a command-line flag.
|
|
|
|
data Opt =
|
2008-11-27 09:29:29 +03:00
|
|
|
File {value::String} |
|
|
|
|
Begin {value::String} |
|
|
|
|
End {value::String} |
|
|
|
|
Period {value::String} |
|
2008-10-16 13:04:44 +04:00
|
|
|
Cleared |
|
2008-11-22 23:35:17 +03:00
|
|
|
CostBasis |
|
2008-11-27 09:29:29 +03:00
|
|
|
Depth {value::String} |
|
|
|
|
Display {value::String} |
|
2008-11-22 12:39:58 +03:00
|
|
|
Empty |
|
2008-10-16 13:50:16 +04:00
|
|
|
Real |
|
2008-11-25 22:29:33 +03:00
|
|
|
OptionsAnywhere |
|
2008-11-22 12:46:57 +03:00
|
|
|
Collapse |
|
2008-10-17 20:58:09 +04:00
|
|
|
SubTotal |
|
2008-12-04 02:20:38 +03:00
|
|
|
WeeklyOpt |
|
|
|
|
MonthlyOpt |
|
|
|
|
YearlyOpt |
|
2007-05-01 09:55:35 +04:00
|
|
|
Help |
|
2008-11-22 07:49:00 +03:00
|
|
|
Verbose |
|
2007-03-12 10:40:33 +03:00
|
|
|
Version
|
2008-12-08 20:27:16 +03:00
|
|
|
| DebugNoUI
|
2007-03-12 10:40:33 +03:00
|
|
|
deriving (Show,Eq)
|
2007-02-16 15:24:13 +03:00
|
|
|
|
2008-11-27 09:29:29 +03:00
|
|
|
-- yow..
|
2008-12-04 02:20:38 +03:00
|
|
|
optsWithConstructor f opts = concatMap get opts
|
|
|
|
where get o = if f v == o then [o] else [] where v = value o
|
|
|
|
|
2008-11-27 09:29:29 +03:00
|
|
|
optValuesForConstructor f opts = concatMap get opts
|
|
|
|
where get o = if f v == o then [v] else [] where v = value o
|
2008-10-10 05:36:21 +04:00
|
|
|
|
2008-12-04 02:20:38 +03:00
|
|
|
optValuesForConstructors fs opts = concatMap get opts
|
|
|
|
where get o = if any (\f -> f v == o) fs then [v] else [] where v = value o
|
|
|
|
|
2009-01-23 05:04:31 +03:00
|
|
|
-- | Parse the command-line arguments into options, command name, and
|
|
|
|
-- 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
|
|
|
|
-- time. Arguments are parsed differently if the program was invoked as
|
2009-01-25 11:09:26 +03:00
|
|
|
-- \"hours\".
|
2008-10-08 21:24:59 +04:00
|
|
|
parseArguments :: IO ([Opt], String, [String])
|
2008-10-08 21:00:22 +04:00
|
|
|
parseArguments = do
|
|
|
|
args <- getArgs
|
2009-01-23 05:04:31 +03:00
|
|
|
istimequery <- usingTimeProgramName
|
|
|
|
let order = if "--options-anywhere" `elem` args || istimequery
|
|
|
|
then Permute
|
|
|
|
else RequireOrder
|
|
|
|
let (os,as,es) = getOpt order options args
|
|
|
|
os' <- fixOptDates os
|
|
|
|
case istimequery of
|
|
|
|
False ->
|
|
|
|
case (os,as,es) of
|
|
|
|
(opts,cmd:args,[]) -> return (os',cmd,args)
|
|
|
|
(opts,[],[]) -> return (os',"",[])
|
|
|
|
(opts,_,errs) -> ioError (userError (concat errs ++ usage))
|
|
|
|
True ->
|
|
|
|
case (os,as,es) of
|
|
|
|
(opts,p:cmd:args,[]) -> return (os' ++ [Period p],cmd,args)
|
|
|
|
(opts,p:args,[]) -> return ([Period p,SubTotal] ++ os',"balance",args)
|
|
|
|
(opts,[],[]) -> return ([Period "today",SubTotal] ++ os',"balance",[])
|
|
|
|
(opts,_,errs) -> ioError (userError (concat errs ++ usage))
|
|
|
|
|
2008-11-26 07:04:05 +03:00
|
|
|
|
2008-11-27 02:21:24 +03:00
|
|
|
-- | Convert any fuzzy dates within these option values to explicit ones,
|
|
|
|
-- based on today's date.
|
2008-11-27 03:35:00 +03:00
|
|
|
fixOptDates :: [Opt] -> IO [Opt]
|
|
|
|
fixOptDates opts = do
|
2008-11-26 07:51:15 +03:00
|
|
|
t <- today
|
|
|
|
return $ map (fixopt t) opts
|
2008-11-26 07:04:05 +03:00
|
|
|
where
|
2008-11-27 03:35:00 +03:00
|
|
|
fixopt t (Begin s) = Begin $ fixSmartDateStr t s
|
|
|
|
fixopt t (End s) = End $ fixSmartDateStr t s
|
2008-11-26 07:51:15 +03:00
|
|
|
fixopt t (Display s) = -- hacky
|
2008-11-27 02:21:24 +03:00
|
|
|
Display $ gsubRegexPRBy "\\[.+?\\]" fixbracketeddatestr s
|
2008-11-27 03:35:00 +03:00
|
|
|
where fixbracketeddatestr s = "[" ++ (fixSmartDateStr t $ init $ tail s) ++ "]"
|
2008-11-26 07:04:05 +03:00
|
|
|
fixopt _ o = o
|
|
|
|
|
2008-12-04 02:20:38 +03:00
|
|
|
-- | 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.
|
2008-11-27 09:29:29 +03:00
|
|
|
dateSpanFromOpts :: Day -> [Opt] -> DateSpan
|
2008-12-04 02:20:38 +03:00
|
|
|
dateSpanFromOpts refdate opts
|
2008-12-04 23:11:35 +03:00
|
|
|
| not $ null popts = snd $ parsePeriodExpr refdate $ last popts
|
|
|
|
| otherwise = DateSpan lastb laste
|
2007-03-12 10:40:33 +03:00
|
|
|
where
|
2008-12-04 02:20:38 +03:00
|
|
|
popts = optValuesForConstructor Period opts
|
|
|
|
bopts = optValuesForConstructor Begin opts
|
|
|
|
eopts = optValuesForConstructor End opts
|
2008-12-04 23:11:35 +03:00
|
|
|
lastb = listtomaybeday bopts
|
|
|
|
laste = listtomaybeday eopts
|
|
|
|
listtomaybeday vs = if null vs then Nothing else Just $ parse $ last vs
|
2008-12-04 02:20:38 +03:00
|
|
|
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
|
2008-12-04 23:11:35 +03:00
|
|
|
| not $ null popts = fst $ parsePeriodExpr refdate $ last popts
|
|
|
|
| null otheropts = NoInterval
|
|
|
|
| otherwise = case last otheropts of
|
|
|
|
WeeklyOpt -> Weekly
|
|
|
|
MonthlyOpt -> Monthly
|
|
|
|
YearlyOpt -> Yearly
|
2008-12-04 02:20:38 +03:00
|
|
|
where
|
|
|
|
popts = optValuesForConstructor Period opts
|
|
|
|
otheropts = filter (`elem` [WeeklyOpt,MonthlyOpt,YearlyOpt]) opts
|
|
|
|
-- doesn't affect the interval, but parsePeriodExpr needs something
|
|
|
|
refdate = parsedate "0001/01/01"
|
2008-10-08 21:00:22 +04:00
|
|
|
|
2008-12-04 23:11:35 +03:00
|
|
|
-- | Get the value of the (last) depth option, if any.
|
2008-11-22 16:11:54 +03:00
|
|
|
depthFromOpts :: [Opt] -> Maybe Int
|
2008-11-27 09:48:46 +03:00
|
|
|
depthFromOpts opts = listtomaybeint $ optValuesForConstructor Depth opts
|
2008-11-22 16:11:54 +03:00
|
|
|
where
|
2008-11-27 09:48:46 +03:00
|
|
|
listtomaybeint [] = Nothing
|
2008-12-04 23:11:35 +03:00
|
|
|
listtomaybeint vs = Just $ read $ last vs
|
2008-11-22 16:11:54 +03:00
|
|
|
|
2008-12-04 23:11:35 +03:00
|
|
|
-- | Get the value of the (last) display option, if any.
|
2008-11-25 00:51:31 +03:00
|
|
|
displayFromOpts :: [Opt] -> Maybe String
|
2008-11-27 09:48:46 +03:00
|
|
|
displayFromOpts opts = listtomaybe $ optValuesForConstructor Display opts
|
2008-11-25 00:51:31 +03:00
|
|
|
where
|
2008-11-27 09:48:46 +03:00
|
|
|
listtomaybe [] = Nothing
|
2008-12-04 23:11:35 +03:00
|
|
|
listtomaybe vs = Just $ last vs
|
2008-11-25 00:51:31 +03:00
|
|
|
|
2009-01-23 05:04:31 +03:00
|
|
|
-- | Was the program invoked via the \"hours\" alias ?
|
|
|
|
usingTimeProgramName :: IO Bool
|
|
|
|
usingTimeProgramName = do
|
|
|
|
progname <- getProgName
|
|
|
|
return $ map toLower progname == timeprogname
|
|
|
|
|
2008-11-27 09:29:29 +03:00
|
|
|
-- | Get the ledger file path from options, an environment variable, or a default
|
|
|
|
ledgerFilePathFromOpts :: [Opt] -> IO String
|
|
|
|
ledgerFilePathFromOpts opts = do
|
2009-01-23 05:04:31 +03:00
|
|
|
istimequery <- usingTimeProgramName
|
|
|
|
let (e,d) = if istimequery
|
2009-01-25 11:09:26 +03:00
|
|
|
then (timelogenvvar,timelogpath)
|
|
|
|
else (ledgerenvvar,ledgerpath)
|
2009-01-23 05:04:31 +03:00
|
|
|
envordefault <- getEnv e `catch` \_ -> return d
|
2008-11-27 09:48:46 +03:00
|
|
|
paths <- mapM tildeExpand $ [envordefault] ++ optValuesForConstructor File opts
|
2008-11-27 09:29:29 +03:00
|
|
|
return $ last paths
|
|
|
|
|
|
|
|
-- | Expand ~ in a file path (does not handle ~name).
|
|
|
|
tildeExpand :: FilePath -> IO FilePath
|
|
|
|
tildeExpand ('~':[]) = getHomeDirectory
|
|
|
|
tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs))
|
|
|
|
--handle ~name, requires -fvia-C or ghc 6.8:
|
|
|
|
--import System.Posix.User
|
|
|
|
-- tildeExpand ('~':xs) = do let (user, path) = span (/= '/') xs
|
|
|
|
-- pw <- getUserEntryForName user
|
|
|
|
-- return (homeDirectory pw ++ path)
|
|
|
|
tildeExpand xs = return xs
|
|
|
|
|
2008-10-08 22:02:34 +04:00
|
|
|
-- | Gather any ledger-style account/description pattern arguments into
|
|
|
|
-- two lists. These are 0 or more account patterns optionally followed by
|
2008-11-25 22:29:33 +03:00
|
|
|
-- a separator and then 0 or more description patterns. The separator is
|
|
|
|
-- usually -- but with --options-anywhere is ^^ so we need to provide the
|
|
|
|
-- options as well.
|
|
|
|
parseAccountDescriptionArgs :: [Opt] -> [String] -> ([String],[String])
|
|
|
|
parseAccountDescriptionArgs opts args = (as, ds')
|
|
|
|
where (as, ds) = break (==patseparator) args
|
|
|
|
ds' = dropWhile (==patseparator) ds
|
|
|
|
patseparator = replicate 2 negchar
|
2008-11-26 08:21:44 +03:00
|
|
|
negchar
|
|
|
|
| OptionsAnywhere `elem` opts = '^'
|
|
|
|
| otherwise = '-'
|