module Hledger.Cli.CliOptions (
helpflags,
detailedversionflag,
inputflags,
reportflags,
outputflags,
generalflagsgroup1,
generalflagsgroup2,
generalflagsgroup3,
defMode,
defCommandMode,
defAddonCommandMode,
argsFlag,
showModeHelp,
withAliases,
CliOpts(..),
defcliopts,
getCliOpts,
decodeRawOpts,
rawOptsToCliOpts,
checkCliOpts,
outputFormats,
defaultOutputFormat,
defaultBalanceLineFormat,
aliasesFromOpts,
journalFilePathFromOpts,
rulesFilePathFromOpts,
outputFileFromOpts,
outputFormatFromOpts,
defaultWidth,
widthFromOpts,
registerWidthsFromOpts,
maybeAccountNameDrop,
lineFormatFromOpts,
hledgerAddons,
tests_Hledger_Cli_CliOptions
)
where
import Prelude ()
import Prelude.Compat
import qualified Control.Exception as C
import Control.Monad (when)
#if !MIN_VERSION_base(4,8,0)
import Data.Functor.Compat ((<$>))
#endif
import Data.List.Compat
import Data.List.Split (splitOneOf)
import Data.Maybe
import Safe
import System.Console.CmdArgs
import System.Console.CmdArgs.Explicit
import System.Console.CmdArgs.Text
#ifndef mingw32_HOST_OS
import System.Console.Terminfo
#endif
import System.Directory
import System.Environment
import System.Exit (exitSuccess)
import System.FilePath
import Test.HUnit
import Text.Parsec
import Hledger
import Hledger.Cli.Version
helpflags :: [Flag RawOpts]
helpflags = [
flagNone ["help","h"] (setboolopt "help") "show general help or (after command) command help"
,flagReq ["debug"] (\s opts -> Right $ setopt "debug" s opts) "N" "show debug output if N is 1-9 (default: 0)"
,flagNone ["version"] (setboolopt "version") "show version information"
]
detailedversionflag :: Flag RawOpts
detailedversionflag = flagNone ["version+"] (setboolopt "version+") "show version information with extra detail"
inputflags :: [Flag RawOpts]
inputflags = [
flagReq ["file","f"] (\s opts -> Right $ setopt "file" s opts) "FILE" "use a different input file. For stdin, use -"
,flagReq ["rules-file"] (\s opts -> Right $ setopt "rules-file" s opts) "RFILE" "CSV conversion rules file (default: FILE.rules)"
,flagReq ["alias"] (\s opts -> Right $ setopt "alias" s opts) "OLD=NEW" "display accounts named OLD as NEW"
,flagNone ["ignore-assertions"] (setboolopt "ignore-assertions") "ignore any balance assertions in the journal"
]
reportflags :: [Flag RawOpts]
reportflags = [
flagReq ["begin","b"] (\s opts -> Right $ setopt "begin" s opts) "DATE" "include postings/txns on or after this date"
,flagReq ["end","e"] (\s opts -> Right $ setopt "end" s opts) "DATE" "include postings/txns before this date"
,flagNone ["daily","D"] (setboolopt "daily") "multiperiod/multicolumn report by day"
,flagNone ["weekly","W"] (setboolopt "weekly") "multiperiod/multicolumn report by week"
,flagNone ["monthly","M"] (setboolopt "monthly") "multiperiod/multicolumn report by month"
,flagNone ["quarterly","Q"] (setboolopt "quarterly") "multiperiod/multicolumn report by quarter"
,flagNone ["yearly","Y"] (setboolopt "yearly") "multiperiod/multicolumn report by year"
,flagReq ["period","p"] (\s opts -> Right $ setopt "period" s opts) "PERIODEXP" "set start date, end date, and/or reporting interval all at once (overrides the flags above)"
,flagNone ["date2","aux-date"] (setboolopt "date2") "use postings/txns' secondary dates instead"
,flagNone ["cleared","C"] (setboolopt "cleared") "include only cleared postings/txns"
,flagNone ["pending"] (setboolopt "pending") "include only pending postings/txns"
,flagNone ["uncleared","U"] (setboolopt "uncleared") "include only uncleared (and pending) postings/txns"
,flagNone ["real","R"] (setboolopt "real") "include only non-virtual postings"
,flagReq ["depth"] (\s opts -> Right $ setopt "depth" s opts) "N" "hide accounts/postings deeper than N"
,flagNone ["empty","E"] (setboolopt "empty") "show empty/zero things which are normally omitted"
,flagNone ["cost","B"] (setboolopt "cost") "show amounts in their cost price's commodity"
]
outputflags = [
flagReq ["output-file","o"] (\s opts -> Right $ setopt "output-file" s opts) "FILE[.FMT]" "write output to FILE instead of stdout. A recognised FMT suffix influences the format."
,flagReq ["output-format","O"] (\s opts -> Right $ setopt "output-format" s opts) "FMT" "select the output format. Supported formats: txt, csv."
]
argsFlag :: FlagHelp -> Arg RawOpts
argsFlag desc = flagArg (\s opts -> Right $ setopt "args" s opts) desc
generalflagstitle :: String
generalflagstitle = "\nGeneral flags"
generalflagsgroup1, generalflagsgroup2, generalflagsgroup3 :: (String, [Flag RawOpts])
generalflagsgroup1 = (generalflagstitle, inputflags ++ reportflags ++ helpflags)
generalflagsgroup2 = (generalflagstitle, inputflags ++ helpflags)
generalflagsgroup3 = (generalflagstitle, helpflags)
defMode :: Mode RawOpts
defMode = Mode {
modeNames = []
,modeHelp = ""
,modeHelpSuffix = []
,modeValue = []
,modeCheck = Right
,modeReform = const Nothing
,modeExpandAt = True
,modeGroupFlags = Group {
groupNamed = []
,groupUnnamed = [
flagNone ["help","h","?"] (setboolopt "help") "Show command help."
]
,groupHidden = []
}
,modeArgs = ([], Nothing)
,modeGroupModes = toGroup []
}
defCommandMode :: [Name] -> Mode RawOpts
defCommandMode names = defMode {
modeNames=names
,modeValue=[("command", headDef "" names)]
,modeArgs = ([], Just $ argsFlag "[PATTERNS]")
}
defAddonCommandMode :: Name -> Mode RawOpts
defAddonCommandMode addon = defMode {
modeNames = [addon]
,modeHelp = fromMaybe "" $ lookup (stripAddonExtension addon) standardAddonsHelp
,modeValue=[("command",addon)]
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [generalflagsgroup1]
}
,modeArgs = ([], Just $ argsFlag "[ARGS]")
}
standardAddonsHelp :: [(String,String)]
standardAddonsHelp = [
("chart", "generate simple balance pie charts")
,("interest", "generate interest transaction entries")
,("irr", "calculate internal rate of return")
,("vty", "start the curses-style interface")
,("web", "start the web interface")
,("accounts", "list account names")
,("balance-csv", "output a balance report as CSV")
,("equity", "show a transaction entry zeroing all accounts")
,("print-unique", "print only transactions with unique descriptions")
,("register-csv", "output a register report as CSV")
,("rewrite", "add specified postings to matched transaction entries")
,("addon", "dummy add-on command for testing")
,("addon2", "dummy add-on command for testing")
,("addon3", "dummy add-on command for testing")
,("addon4", "dummy add-on command for testing")
,("addon5", "dummy add-on command for testing")
,("addon6", "dummy add-on command for testing")
,("addon7", "dummy add-on command for testing")
,("addon8", "dummy add-on command for testing")
,("addon9", "dummy add-on command for testing")
]
showModeHelp :: Mode a -> String
showModeHelp = (showText defaultWrap :: [Text] -> String) .
(helpText [] HelpFormatDefault :: Mode a -> [Text])
withAliases :: String -> [String] -> String
s `withAliases` [] = s
s `withAliases` as = s ++ " (" ++ intercalate ", " as ++ ")"
data CliOpts = CliOpts {
rawopts_ :: RawOpts
,command_ :: String
,file_ :: [FilePath]
,rules_file_ :: Maybe FilePath
,output_file_ :: Maybe FilePath
,output_format_ :: Maybe String
,alias_ :: [String]
,ignore_assertions_ :: Bool
,debug_ :: Int
,no_new_accounts_ :: Bool
,width_ :: Maybe String
,available_width_ :: Int
,reportopts_ :: ReportOpts
} deriving (Show, Data, Typeable)
instance Default CliOpts where def = defcliopts
defcliopts :: CliOpts
defcliopts = CliOpts
def
def
def
def
def
def
def
def
def
def
def
defaultWidth
def
decodeRawOpts :: RawOpts -> RawOpts
decodeRawOpts = map (\(name',val) -> (name', fromSystemString val))
defaultWidth :: Int
defaultWidth = 80
rawOptsToCliOpts :: RawOpts -> IO CliOpts
rawOptsToCliOpts rawopts = checkCliOpts <$> do
ropts <- rawOptsToReportOpts rawopts
mcolumns <- readMay <$> getEnvSafe "COLUMNS"
mtermwidth <-
#ifdef mingw32_HOST_OS
return Nothing
#else
setupTermFromEnv >>= return . flip getCapability termColumns
#endif
let availablewidth = head $ catMaybes [mcolumns, mtermwidth, Just defaultWidth]
return defcliopts {
rawopts_ = rawopts
,command_ = stringopt "command" rawopts
,file_ = map stripquotes $ listofstringopt "file" rawopts
,rules_file_ = maybestringopt "rules-file" rawopts
,output_file_ = maybestringopt "output-file" rawopts
,output_format_ = maybestringopt "output-format" rawopts
,alias_ = map stripquotes $ listofstringopt "alias" rawopts
,debug_ = intopt "debug" rawopts
,ignore_assertions_ = boolopt "ignore-assertions" rawopts
,no_new_accounts_ = boolopt "no-new-accounts" rawopts
,width_ = maybestringopt "width" rawopts
,available_width_ = availablewidth
,reportopts_ = ropts
}
checkCliOpts :: CliOpts -> CliOpts
checkCliOpts opts =
either optserror (const opts) $ do
case lineFormatFromOpts $ reportopts_ opts of
Left err -> Left $ "could not parse format option: "++err
Right _ -> Right ()
getCliOpts :: Mode RawOpts -> IO CliOpts
getCliOpts mode' = do
args' <- getArgs
let rawopts = decodeRawOpts $ processValue mode' args'
opts <- rawOptsToCliOpts rawopts
debugArgs args' opts
when ("help" `inRawOpts` rawopts_ opts) $
putStr (showModeHelp mode') >> exitSuccess
return opts
where
debugArgs :: [String] -> CliOpts -> IO ()
debugArgs args' opts =
when ("--debug" `elem` args') $ do
progname' <- getProgName
putStrLn $ "running: " ++ progname'
putStrLn $ "raw args: " ++ show args'
putStrLn $ "processed opts:\n" ++ show opts
d <- getCurrentDay
putStrLn $ "search query: " ++ show (queryFromOpts d $ reportopts_ opts)
aliasesFromOpts :: CliOpts -> [AccountAlias]
aliasesFromOpts = map (\a -> fromparse $ runParser accountaliasp () ("--alias "++quoteIfNeeded a) a)
. alias_
journalFilePathFromOpts :: CliOpts -> IO [String]
journalFilePathFromOpts opts = do
f <- defaultJournalPath
d <- getCurrentDirectory
mapM (expandPath d) $ ifEmpty (file_ opts) [f]
where
ifEmpty [] d = d
ifEmpty l _ = l
outputFileFromOpts :: CliOpts -> IO FilePath
outputFileFromOpts opts = do
d <- getCurrentDirectory
case output_file_ opts of
Just p -> expandPath d p
Nothing -> return "-"
defaultOutputFormat = "txt"
outputFormats =
[defaultOutputFormat] ++
["csv"
]
outputFormatFromOpts :: CliOpts -> String
outputFormatFromOpts opts =
case output_format_ opts of
Just f -> f
Nothing ->
case filePathExtension <$> output_file_ opts of
Just ext | ext `elem` outputFormats -> ext
_ -> defaultOutputFormat
filePathExtension :: FilePath -> String
filePathExtension = dropWhile (=='.') . snd . splitExtension . snd . splitFileName
rulesFilePathFromOpts :: CliOpts -> IO (Maybe FilePath)
rulesFilePathFromOpts opts = do
d <- getCurrentDirectory
maybe (return Nothing) (fmap Just . expandPath d) $ rules_file_ opts
widthFromOpts :: CliOpts -> Int
widthFromOpts CliOpts{width_=Nothing, available_width_=w} = w
widthFromOpts CliOpts{width_=Just s} =
case runParser (read `fmap` many1 digit <* eof) () "(unknown)" s of
Left e -> optserror $ "could not parse width option: "++show e
Right w -> w
registerWidthsFromOpts :: CliOpts -> (Int, Maybe Int)
registerWidthsFromOpts CliOpts{width_=Nothing, available_width_=w} = (w, Nothing)
registerWidthsFromOpts CliOpts{width_=Just s} =
case runParser registerwidthp () "(unknown)" s of
Left e -> optserror $ "could not parse width option: "++show e
Right ws -> ws
where
registerwidthp :: Stream [Char] m t => ParsecT [Char] st m (Int, Maybe Int)
registerwidthp = do
totalwidth <- read `fmap` many1 digit
descwidth <- optionMaybe (char ',' >> read `fmap` many1 digit)
eof
return (totalwidth, descwidth)
maybeAccountNameDrop :: ReportOpts -> AccountName -> AccountName
maybeAccountNameDrop opts a | tree_ opts = a
| otherwise = accountNameDrop (drop_ opts) a
lineFormatFromOpts :: ReportOpts -> Either String StringFormat
lineFormatFromOpts = maybe (Right defaultBalanceLineFormat) parseStringFormat . format_
defaultBalanceLineFormat :: StringFormat
defaultBalanceLineFormat = BottomAligned [
FormatField False (Just 20) Nothing TotalField
, FormatLiteral " "
, FormatField True (Just 2) Nothing DepthSpacerField
, FormatField True Nothing Nothing AccountField
]
hledgerAddons :: IO ([String],[String])
hledgerAddons = do
exes <- hledgerExecutablesInPath
let precisenames =
map stripprefix exes
let displaynames = concatMap stripext $
groupBy (\a b -> dropExtension a == dropExtension b) precisenames
return (precisenames, displaynames)
where
stripprefix = drop (length progname + 1)
stripext [f] = [dropExtension f]
stripext fs = fs
hledgerExecutablesInPath :: IO [String]
hledgerExecutablesInPath = do
pathdirs <- splitOneOf "[:;]" `fmap` getEnvSafe "PATH"
pathfiles <- concat `fmap` mapM getDirectoryContentsSafe pathdirs
return $ nub $ sort $ filter isHledgerExeName pathfiles
isHledgerExeName :: String -> Bool
isHledgerExeName = isRight . parsewith hledgerexenamep
where
hledgerexenamep = do
_ <- string progname
_ <- char '-'
_ <- many1 (noneOf ".")
optional (string "." >> choice' (map string addonExtensions))
eof
stripAddonExtension :: String -> String
stripAddonExtension = regexReplace re "" where re = "\\.(" ++ intercalate "|" addonExtensions ++ ")$"
addonExtensions :: [String]
addonExtensions =
["bat"
,"com"
,"exe"
,"hs"
,"lhs"
,"pl"
,"py"
,"rb"
,"rkt"
,"sh"
]
getEnvSafe :: String -> IO String
getEnvSafe v = getEnv v `C.catch` (\(_::C.IOException) -> return "")
getDirectoryContentsSafe :: FilePath -> IO [String]
getDirectoryContentsSafe d =
(filter (not . (`elem` [".",".."])) `fmap` getDirectoryContents d) `C.catch` (\(_::C.IOException) -> return [])
tests_Hledger_Cli_CliOptions :: Test
tests_Hledger_Cli_CliOptions = TestList
[
]