module Hledger.Cli.Options
where
import System.Console.GetOpt
import System.Environment
import Hledger.Data.Utils
import Hledger.Data.Types
import Hledger.Data.Dates
import Hledger.Read (myJournalPath, myTimelogPath)
progname_cli = "hledger"
progname_cli_time = "hours"
usage_preamble_cli =
"Usage: hledger [OPTIONS] COMMAND [PATTERNS]\n" ++
" hledger [OPTIONS] convert CSVFILE\n" ++
"\n" ++
"Reads your ~/.journal file, or another specified by $LEDGER or -f, and\n" ++
"runs the specified command (may be abbreviated):\n" ++
"\n" ++
" add - prompt for new transactions and add them to the journal\n" ++
" balance - show accounts, with balances\n" ++
" convert - show the specified CSV file as a hledger journal\n" ++
" histogram - show a barchart of transactions per day or other interval\n" ++
" print - show transactions in journal format\n" ++
" register - show transactions as a register with running balance\n" ++
" stats - show various statistics for a journal\n" ++
" test - run self-tests\n" ++
"\n"
usage_options_cli = usageInfo "hledger options:" options_cli
usage_postscript_cli =
"\n" ++
"DATES can be y/m/d or smart dates like \"last month\". PATTERNS are regular\n" ++
"expressions which filter by account name. Prefix a pattern with desc: to\n" ++
"filter by transaction description instead, prefix with not: to negate it.\n" ++
"When using both, not: comes last.\n"
usage_cli = concat [
usage_preamble_cli
,usage_options_cli
,usage_postscript_cli
]
options_cli :: [OptDescr Opt]
options_cli = [
Option "f" ["file"] (ReqArg File "FILE") "use a different journal/timelog file; - means stdin"
,Option "" ["no-new-accounts"] (NoArg NoNewAccts) "don't allow to create new accounts"
,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 "" ["flat"] (NoArg Flat) "balance: show full account names, unindented"
,Option "" ["drop"] (ReqArg Drop "N") "balance: with --flat, elide first N account name components"
,Option "" ["no-total"] (NoArg NoTotal) "balance: hide the final total"
,Option "D" ["daily"] (NoArg DailyOpt) "register, stats: report by day"
,Option "W" ["weekly"] (NoArg WeeklyOpt) "register, stats: report by week"
,Option "M" ["monthly"] (NoArg MonthlyOpt) "register, stats: report by month"
,Option "Q" ["quarterly"] (NoArg QuarterlyOpt) "register, stats: report by quarter"
,Option "Y" ["yearly"] (NoArg YearlyOpt) "register, stats: report by year"
,Option "v" ["verbose"] (NoArg Verbose) "show more verbose output"
,Option "" ["debug"] (NoArg Debug) "show extra debug output; implies verbose"
,Option "" ["binary-filename"] (NoArg BinaryFilename) "show the download filename for this hledger build"
,Option "V" ["version"] (NoArg Version) "show version information"
,Option "h" ["help"] (NoArg Help) "show command-line usage"
]
data Opt =
File {value::String}
| NoNewAccts
| Begin {value::String}
| End {value::String}
| Period {value::String}
| Cleared
| UnCleared
| CostBasis
| Depth {value::String}
| Display {value::String}
| Effective
| Empty
| Real
| Flat
| Drop {value::String}
| NoTotal
| SubTotal
| DailyOpt
| WeeklyOpt
| MonthlyOpt
| QuarterlyOpt
| YearlyOpt
| Help
| Verbose
| Version
| BinaryFilename
| Debug
| DebugVty
| BaseUrl {value::String}
| Port {value::String}
| ChartOutput {value::String}
| ChartItems {value::String}
| ChartSize {value::String}
deriving (Show,Eq)
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
parseArgumentsWith :: [OptDescr Opt] -> IO ([Opt], [String])
parseArgumentsWith options = do
rawargs <- map fromPlatformString `fmap` getArgs
let (opts,args,errs) = getOpt Permute options rawargs
opts' <- fixOptDates opts
let opts'' = if Debug `elem` opts' then Verbose:opts' else opts'
if null errs
then return (opts'',args)
else argsError (concat errs) >> return ([],[])
argsError :: String -> IO ()
argsError = ioError . userError' . (++ " Run with --help to see usage.")
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) =
Display $ gsubRegexPRBy "\\[.+?\\]" fixbracketeddatestr s
where fixbracketeddatestr s = "[" ++ fixSmartDateStr d (init $ tail s) ++ "]"
fixopt _ o = o
dateSpanFromOpts :: Day -> [Opt] -> DateSpan
dateSpanFromOpts refdate opts
| not (null popts) = case parsePeriodExpr refdate $ last popts of
Right (_, s) -> s
Left e -> parseerror e
| 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
intervalFromOpts :: [Opt] -> Interval
intervalFromOpts opts =
case (periodopts, intervalopts) of
((p:_), _) -> case parsePeriodExpr (parsedate "0001/01/01") p of
Right (i, _) -> i
Left e -> parseerror e
(_, (DailyOpt:_)) -> Days 1
(_, (WeeklyOpt:_)) -> Weeks 1
(_, (MonthlyOpt:_)) -> Months 1
(_, (QuarterlyOpt:_)) -> Quarters 1
(_, (YearlyOpt:_)) -> Years 1
(_, _) -> NoInterval
where
periodopts = reverse $ optValuesForConstructor Period opts
intervalopts = reverse $ filter (`elem` [DailyOpt,WeeklyOpt,MonthlyOpt,QuarterlyOpt,YearlyOpt]) opts
depthFromOpts :: [Opt] -> Maybe Int
depthFromOpts opts = listtomaybeint $ optValuesForConstructor Depth opts
where
listtomaybeint [] = Nothing
listtomaybeint vs = Just $ read $ last vs
dropFromOpts :: [Opt] -> Int
dropFromOpts opts = fromMaybe 0 $ listtomaybeint $ optValuesForConstructor Drop opts
where
listtomaybeint [] = Nothing
listtomaybeint vs = Just $ read $ last vs
displayExprFromOpts :: [Opt] -> Maybe String
displayExprFromOpts opts = listtomaybe $ optValuesForConstructor Display opts
where
listtomaybe [] = Nothing
listtomaybe vs = Just $ last vs
baseUrlFromOpts :: [Opt] -> Maybe String
baseUrlFromOpts opts = listtomaybe $ optValuesForConstructor BaseUrl opts
where
listtomaybe [] = Nothing
listtomaybe vs = Just $ last vs
portFromOpts :: [Opt] -> Maybe Int
portFromOpts opts = listtomaybeint $ optValuesForConstructor Port opts
where
listtomaybeint [] = Nothing
listtomaybeint vs = Just $ read $ last vs
clearedValueFromOpts opts | null os = Nothing
| last os == Cleared = Just True
| otherwise = Just False
where os = optsWithConstructors [Cleared,UnCleared] opts
usingTimeProgramName :: IO Bool
usingTimeProgramName = do
progname <- getProgName
return $ map toLower progname == progname_cli_time
journalFilePathFromOpts :: [Opt] -> IO String
journalFilePathFromOpts opts = do
istimequery <- usingTimeProgramName
f <- if istimequery then myTimelogPath else myJournalPath
return $ last $ f : optValuesForConstructor File opts
parsePatternArgs :: [String] -> ([String],[String])
parsePatternArgs args = (as, ds')
where
descprefix = "desc:"
(ds, as) = partition (descprefix `isPrefixOf`) args
ds' = map (drop (length descprefix)) ds
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
tests_Hledger_Cli_Options = TestList
[
"dateSpanFromOpts" ~: do
let todaysdate = parsedate "2008/11/26"
let gives = is . show . dateSpanFromOpts todaysdate
[] `gives` "DateSpan Nothing Nothing"
[Begin "2008", End "2009"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"
[Period "in 2008"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"
[Begin "2005", End "2007",Period "in 2008"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"
,"intervalFromOpts" ~: do
let gives = is . intervalFromOpts
[] `gives` NoInterval
[DailyOpt] `gives` Days 1
[WeeklyOpt] `gives` Weeks 1
[MonthlyOpt] `gives` Months 1
[QuarterlyOpt] `gives` Quarters 1
[YearlyOpt] `gives` Years 1
[Period "weekly"] `gives` Weeks 1
[Period "monthly"] `gives` Months 1
[Period "quarterly"] `gives` Quarters 1
[WeeklyOpt, Period "yearly"] `gives` Years 1
]