module Hledger.Cli.Options
where
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Time.Calendar
import Safe
import System.Console.CmdArgs
import System.Console.CmdArgs.Explicit
import System.Console.CmdArgs.Text
import System.Directory
import System.Environment
import Test.HUnit
import Text.ParserCombinators.Parsec
import Text.Printf
import Hledger
import Hledger.Cli.Format as Format
import Hledger.Cli.Version
type RawOpts = [(String,String)]
defmode :: Mode RawOpts
defmode = Mode {
modeNames = []
,modeHelp = ""
,modeHelpSuffix = []
,modeValue = []
,modeCheck = Right
,modeReform = const Nothing
,modeGroupFlags = toGroup []
,modeArgs = ([], Nothing)
,modeGroupModes = toGroup []
}
mainmode addons = defmode {
modeNames = [progname]
,modeHelp = "run the specified hledger command. hledger COMMAND --help for more detail. \nIn general, COMMAND should precede OPTIONS."
,modeHelpSuffix = [""]
,modeGroupFlags = Group {
groupUnnamed = helpflags
,groupHidden = [flagNone ["binary-filename"] (setboolopt "binary-filename") "show the download filename for this executable, and exit"]
++ fileflags
,groupNamed = []
}
,modeArgs = ([], Just mainargsflag)
,modeGroupModes = Group {
groupUnnamed = [
]
,groupHidden = [
]
,groupNamed = [
("Misc commands", [
addmode
,convertmode
,testmode
])
,("\nReport commands", [
accountsmode
,entriesmode
,postingsmode
,activitymode
,statsmode
])
]
++ case addons of [] -> []
cs -> [("\nAdd-on commands found", map addonmode cs)]
}
}
addonmode name = defmode {
modeNames = [name]
,modeHelp = printf "[-- OPTIONS] run the %s-%s program" progname name
,modeValue=[("command",name)]
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
}
,modeArgs = ([], Just addonargsflag)
}
help_postscript = [
]
generalflagstitle = "\nGeneral flags"
generalflags1 = fileflags ++ reportflags ++ helpflags
generalflags2 = fileflags ++ helpflags
generalflags3 = helpflags
fileflags = [
flagReq ["file","f"] (\s opts -> Right $ setopt "file" s opts) "FILE" "use a different journal file; - means stdin"
,flagReq ["alias"] (\s opts -> Right $ setopt "alias" s opts) "ACCT=ALIAS" "display ACCT's name as ALIAS in reports"
]
reportflags = [
flagReq ["begin","b"] (\s opts -> Right $ setopt "begin" s opts) "DATE" "report on transactions on or after this date"
,flagReq ["end","e"] (\s opts -> Right $ setopt "end" s opts) "DATE" "report on transactions before this date"
,flagReq ["period","p"] (\s opts -> Right $ setopt "period" s opts) "PERIODEXP" "report on transactions during the specified period and/or with the specified reporting interval"
,flagNone ["daily","D"] (\opts -> setboolopt "daily" opts) "report by day"
,flagNone ["weekly","W"] (\opts -> setboolopt "weekly" opts) "report by week"
,flagNone ["monthly","M"] (\opts -> setboolopt "monthly" opts) "report by month"
,flagNone ["quarterly","Q"] (\opts -> setboolopt "quarterly" opts) "report by quarter"
,flagNone ["yearly","Y"] (\opts -> setboolopt "yearly" opts) "report by year"
,flagNone ["cleared","C"] (\opts -> setboolopt "cleared" opts) "report only on cleared transactions"
,flagNone ["uncleared","U"] (\opts -> setboolopt "uncleared" opts) "report only on uncleared transactions"
,flagNone ["cost","B"] (\opts -> setboolopt "cost" opts) "report cost of commodities"
,flagReq ["depth"] (\s opts -> Right $ setopt "depth" s opts) "N" "hide accounts/transactions deeper than this"
,flagReq ["display","d"] (\s opts -> Right $ setopt "display" s opts) "DISPLAYEXP" "show only transactions matching the expression, which is 'dOP[DATE]' where OP is <, <=, =, >=, >"
,flagNone ["effective"] (\opts -> setboolopt "effective" opts) "use transactions' effective dates, if any"
,flagNone ["empty","E"] (\opts -> setboolopt "empty" opts) "show empty/zero things which are normally elided"
,flagNone ["real","R"] (\opts -> setboolopt "real" opts) "report only on real (non-virtual) transactions"
]
helpflags = [
flagHelpSimple (setboolopt "help")
,flagNone ["debug"] (setboolopt "debug") "Show extra debug output"
,flagVersion (setboolopt "version")
]
mainargsflag = flagArg (\s opts -> Right $ setopt "args" s opts) ""
commandargsflag = flagArg (\s opts -> Right $ setopt "args" s opts) "[PATTERNS]"
addonargsflag = flagArg (\s opts -> Right $ setopt "args" s opts) "[ARGS]"
commandmode names = defmode {modeNames=names, modeValue=[("command",headDef "" names)]}
addmode = (commandmode ["add"]) {
modeHelp = "prompt for new transactions and append them to the journal"
,modeHelpSuffix = ["Defaults come from previous similar transactions; use query patterns to restrict these."]
,modeArgs = ([], Just commandargsflag)
,modeGroupFlags = Group {
groupUnnamed = [
flagNone ["no-new-accounts"] (\opts -> setboolopt "no-new-accounts" opts) "don't allow creating new accounts"
]
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags2)]
}
}
convertmode = (commandmode ["convert"]) {
modeValue = [("command","convert")]
,modeHelp = "show the specified CSV file as hledger journal entries"
,modeArgs = ([], Just $ flagArg (\s opts -> Right $ setopt "args" s opts) "[CSVFILE]")
,modeGroupFlags = Group {
groupUnnamed = [
flagReq ["rules-file"] (\s opts -> Right $ setopt "rules-file" s opts) "FILE" "rules file to use (default: CSVFILE.rules)"
]
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags3)]
}
}
testmode = (commandmode ["test"]) {
modeHelp = "run self-tests, or just the ones matching REGEXPS"
,modeArgs = ([], Just $ flagArg (\s opts -> Right $ setopt "args" s opts) "[REGEXPS]")
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags3)]
}
}
accountsmode = (commandmode ["balance","accounts"]) {
modeHelp = "(or accounts) show matched accounts and their balances"
,modeArgs = ([], Just commandargsflag)
,modeGroupFlags = Group {
groupUnnamed = [
flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show full account names, unindented"
,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "with --flat, omit this many leading account name components"
,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format"
,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "no eliding at all, stronger than --empty"
,flagNone ["no-total"] (\opts -> setboolopt "no-total" opts) "don't show the final total"
]
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
}
}
entriesmode = (commandmode ["print","entries"]) {
modeHelp = "(or entries) show matched journal entries"
,modeArgs = ([], Just commandargsflag)
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
}
}
postingsmode = (commandmode ["register","postings"]) {
modeHelp = "(or postings) show matched postings and running total"
,modeArgs = ([], Just commandargsflag)
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
}
}
transactionsmode = (commandmode ["transactions"]) {
modeHelp = "show matched transactions and balance in some account(s)"
,modeArgs = ([], Just commandargsflag)
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
}
}
activitymode = (commandmode ["activity","histogram"]) {
modeHelp = "show a barchart of transactions per interval"
,modeHelpSuffix = ["The default interval is daily."]
,modeArgs = ([], Just commandargsflag)
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
}
}
statsmode = (commandmode ["stats"]) {
modeHelp = "show quick statistics for a journal (or part of it)"
,modeArgs = ([], Just commandargsflag)
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
}
}
data CliOpts = CliOpts {
rawopts_ :: RawOpts
,command_ :: String
,file_ :: Maybe FilePath
,alias_ :: [String]
,debug_ :: Bool
,no_new_accounts_ :: Bool
,rules_file_ :: Maybe FilePath
,reportopts_ :: ReportOpts
} deriving (Show)
defcliopts = CliOpts
def
def
def
def
def
def
def
def
instance Default CliOpts where def = defcliopts
toCliOpts :: RawOpts -> IO CliOpts
toCliOpts rawopts = do
d <- getCurrentDay
return defcliopts {
rawopts_ = rawopts
,command_ = stringopt "command" rawopts
,file_ = maybestringopt "file" rawopts
,alias_ = listofstringopt "alias" rawopts
,debug_ = boolopt "debug" rawopts
,no_new_accounts_ = boolopt "no-new-accounts" rawopts
,rules_file_ = maybestringopt "rules-file" rawopts
,reportopts_ = defreportopts {
begin_ = maybesmartdateopt d "begin" rawopts
,end_ = maybesmartdateopt d "end" rawopts
,period_ = maybeperiodopt d rawopts
,cleared_ = boolopt "cleared" rawopts
,uncleared_ = boolopt "uncleared" rawopts
,cost_ = boolopt "cost" rawopts
,depth_ = maybeintopt "depth" rawopts
,display_ = maybedisplayopt d rawopts
,effective_ = boolopt "effective" rawopts
,empty_ = boolopt "empty" rawopts
,no_elide_ = boolopt "no-elide" rawopts
,real_ = boolopt "real" rawopts
,flat_ = boolopt "flat" rawopts
,drop_ = intopt "drop" rawopts
,no_total_ = boolopt "no-total" rawopts
,daily_ = boolopt "daily" rawopts
,weekly_ = boolopt "weekly" rawopts
,monthly_ = boolopt "monthly" rawopts
,quarterly_ = boolopt "quarterly" rawopts
,yearly_ = boolopt "yearly" rawopts
,format_ = maybestringopt "format" rawopts
,patterns_ = listofstringopt "args" rawopts
}
}
getHledgerCliOpts :: [String] -> IO CliOpts
getHledgerCliOpts addons = do
args <- getArgs
toCliOpts (decodeRawOpts $ processValue (mainmode addons) $ rearrangeForCmdArgs args) >>= checkCliOpts
getHledgerAddonCommands :: IO [String]
getHledgerAddonCommands = map (drop (length progname + 1)) `fmap` getHledgerProgramsInPath
getHledgerProgramsInPath :: IO [String]
getHledgerProgramsInPath = do
pathdirs <- splitOn ":" `fmap` getEnvSafe "PATH"
pathexes <- concat `fmap` mapM getDirectoryContentsSafe pathdirs
return $ nub $ sort $ filter (isRight . parsewith hledgerprog) pathexes
where
hledgerprog = string progname >> char '-' >> many1 (letter <|> char '-') >> eof
getEnvSafe v = getEnv v `catch` (\_ -> return "")
getDirectoryContentsSafe d = getDirectoryContents d `catch` (\_ -> return [])
decodeRawOpts = map (\(name,val) -> (name, fromPlatformString val))
rearrangeForCmdArgs (fopt@('-':'f':_:_):cmd:rest) = cmd:fopt:rest
rearrangeForCmdArgs ("-f":fval:cmd:rest) = cmd:"-f":fval:rest
rearrangeForCmdArgs as = as
optserror = error' . (++ " (run with --help for usage)")
setopt name val = (++ [(name,singleQuoteIfNeeded val)])
setboolopt name = (++ [(name,"")])
in_ :: String -> RawOpts -> Bool
in_ name = isJust . lookup name
boolopt = in_
maybestringopt name = maybe Nothing (Just . stripquotes) . lookup name
stringopt name = fromMaybe "" . maybestringopt name
listofstringopt name rawopts = [stripquotes v | (n,v) <- rawopts, n==name]
maybeintopt :: String -> RawOpts -> Maybe Int
maybeintopt name rawopts =
let ms = maybestringopt name rawopts in
case ms of Nothing -> Nothing
Just s -> Just $ readDef (optserror $ "could not parse "++name++" number: "++s) s
intopt name = fromMaybe 0 . maybeintopt name
maybesmartdateopt :: Day -> String -> RawOpts -> Maybe Day
maybesmartdateopt d name rawopts =
case maybestringopt name rawopts of
Nothing -> Nothing
Just s -> either
(\e -> optserror $ "could not parse "++name++" date: "++show e)
Just
$ fixSmartDateStrEither' d s
maybedisplayopt :: Day -> RawOpts -> Maybe DisplayExp
maybedisplayopt d rawopts =
maybe Nothing (Just . regexReplaceBy "\\[.+?\\]" fixbracketeddatestr) $ maybestringopt "display" rawopts
where
fixbracketeddatestr "" = ""
fixbracketeddatestr s = "[" ++ fixSmartDateStr d (init $ tail s) ++ "]"
maybeperiodopt :: Day -> RawOpts -> Maybe (Interval,DateSpan)
maybeperiodopt d rawopts =
case maybestringopt "period" rawopts of
Nothing -> Nothing
Just s -> either
(\e -> optserror $ "could not parse period option: "++show e)
Just
$ parsePeriodExpr d s
checkCliOpts :: CliOpts -> IO CliOpts
checkCliOpts opts@CliOpts{reportopts_=ropts} = do
case formatFromOpts ropts of
Left err -> optserror $ "could not parse format option: "++err
Right _ -> return ()
return opts
formatFromOpts :: ReportOpts -> Either String [FormatString]
formatFromOpts = maybe (Right defaultBalanceFormatString) parseFormatString . format_
defaultBalanceFormatString :: [FormatString]
defaultBalanceFormatString = [
FormatField False (Just 20) Nothing Total
, FormatLiteral " "
, FormatField True (Just 2) Nothing DepthSpacer
, FormatField True Nothing Nothing Format.Account
]
journalFilePathFromOpts :: CliOpts -> IO String
journalFilePathFromOpts opts = do
f <- myJournalPath
let f' = fromMaybe f $ file_ opts
if '~' `elem` f'
then error' $ printf "~ in the journal file path is not supported, please adjust (%s)" f'
else return f'
aliasesFromOpts :: CliOpts -> [(AccountName,AccountName)]
aliasesFromOpts = map parseAlias . alias_
where
parseAlias :: String -> (AccountName,AccountName)
parseAlias s = (accountNameWithoutPostingType $ strip orig
,accountNameWithoutPostingType $ strip alias')
where
(orig, alias) = break (=='=') s
alias' = case alias of ('=':rest) -> rest
_ -> orig
showModeHelp = showText defaultWrap . helpText [] HelpFormatDefault
tests_Hledger_Cli_Options = TestList
[
]