module Hledger.Cli.Options
where
import qualified Control.Exception as C
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 as P
import Text.Printf
import Hledger
import Hledger.Data.FormatStrings as Format
import Hledger.Cli.Version
type RawOpts = [(String,String)]
defmode :: Mode RawOpts
defmode = Mode {
modeNames = []
,modeHelp = ""
,modeHelpSuffix = []
,modeValue = []
,modeCheck = Right
,modeReform = const Nothing
,modeExpandAt = True
,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 = [
convertmode
]
,groupNamed = [
("Misc commands", [
addmode
,testmode
])
,("\nReport commands", [
accountsmode
,entriesmode
,postingsmode
,activitymode
,incomestatementmode
,balancesheetmode
,cashflowmode
,statsmode
])
]
++ case addons of [] -> []
cs -> [("\nAdd-on commands found", map addonmode cs)]
}
}
convertmode = (commandmode ["convert"]) {
modeValue = [("command","convert")]
,modeHelp = ""
,modeArgs = ([], Just $ flagArg (\s opts -> Right $ setopt "args" s opts) "[CSVFILE]")
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = []
}
}
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 ["rules-file"] (\s opts -> Right $ setopt "rules-file" s opts) "RULESFILE" "conversion rules for CSV (default: FILE.rules)"
,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 ["date2","aux-date","effective"] (\opts -> setboolopt "date2" opts) "use transactions' secondary 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)]
}
}
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","bal","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 = [
flagOpt (show defaultWidthWithFlag) ["width","w"] (\s opts -> Right $ setopt "width" s opts) "N" "increase or set the output width (default: 80)"
,flagNone ["related","r"] (\opts -> setboolopt "related" opts) "show the other postings in the transactions of those that would have been shown"
]
,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)]
}
}
incomestatementmode = (commandmode ["incomestatement","is"]) {
modeHelp = "show a standard income statement"
,modeArgs = ([], Just commandargsflag)
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
}
}
balancesheetmode = (commandmode ["balancesheet","bs"]) {
modeHelp = "show a standard balance sheet"
,modeArgs = ([], Just commandargsflag)
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
}
}
cashflowmode = (commandmode ["cashflow","cf"]) {
modeHelp = "show a simple cashflow statement"
,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
,rules_file_ :: Maybe FilePath
,alias_ :: [String]
,debug_ :: Bool
,no_new_accounts_ :: Bool
,width_ :: Maybe String
,reportopts_ :: ReportOpts
} deriving (Show)
defcliopts = CliOpts
def
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
,rules_file_ = maybestringopt "rules-file" rawopts
,alias_ = map stripquotes $ listofstringopt "alias" rawopts
,debug_ = boolopt "debug" rawopts
,no_new_accounts_ = boolopt "no-new-accounts" rawopts
,width_ = maybestringopt "width" 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
,date2_ = boolopt "date2" 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
,related_ = boolopt "related" rawopts
,query_ = unwords $ 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 `C.catch` (\(_::C.IOException) -> return "")
getDirectoryContentsSafe d = getDirectoryContents d `C.catch` (\(_::C.IOException) -> return [])
decodeRawOpts = map (\(name,val) -> (name, fromSystemString 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 = [v | (k,v) <- rawopts, k==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 ()
case widthFromOpts opts of
Left err -> optserror $ "could not parse width 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 TotalField
, FormatLiteral " "
, FormatField True (Just 2) Nothing DepthSpacerField
, FormatField True Nothing Nothing AccountField
]
data OutputWidth = TotalWidth Width | FieldWidths [Width] deriving Show
data Width = Width Int | Auto deriving Show
defaultWidth = 80
defaultWidthWithFlag = 120
widthFromOpts :: CliOpts -> Either String OutputWidth
widthFromOpts CliOpts{width_=Nothing} = Right $ TotalWidth $ Width defaultWidth
widthFromOpts CliOpts{width_=Just ""} = Right $ TotalWidth $ Width defaultWidthWithFlag
widthFromOpts CliOpts{width_=Just s} = parseWidth s
parseWidth :: String -> Either String OutputWidth
parseWidth s = case (runParser outputwidth () "(unknown)") s of
Left e -> Left $ show e
Right x -> Right x
outputwidth :: GenParser Char st OutputWidth
outputwidth =
try (do w <- width
ws <- many1 (char ',' >> width)
return $ FieldWidths $ w:ws)
<|> TotalWidth `fmap` width
width :: GenParser Char st Width
width = (string "auto" >> return Auto)
<|> (Width . read) `fmap` many1 digit
journalFilePathFromOpts :: CliOpts -> IO String
journalFilePathFromOpts opts = do
f <- defaultJournalPath
d <- getCurrentDirectory
expandPath d $ fromMaybe f $ file_ opts
rulesFilePathFromOpts :: CliOpts -> IO (Maybe FilePath)
rulesFilePathFromOpts opts = do
d <- getCurrentDirectory
maybe (return Nothing) (fmap Just . expandPath d) $ rules_file_ opts
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 :: Mode a -> String
showModeHelp =
(showText defaultWrap :: [Text] -> String)
.
(helpText [] HelpFormatDefault :: Mode a -> [Text])
tests_Hledger_Cli_Options = TestList
[
]