module Hledger.Cli.Main where
import Data.Char (isDigit)
import Data.List
import Safe
import System.Console.CmdArgs.Explicit as C
import System.Environment
import System.Exit
import System.FilePath
import System.Process
import Text.Printf
import Hledger (ensureJournalFileExists)
import Hledger.Cli.Add
import Hledger.Cli.Accounts
import Hledger.Cli.Balance
import Hledger.Cli.Balancesheet
import Hledger.Cli.Cashflow
import Hledger.Cli.Histogram
import Hledger.Cli.Incomestatement
import Hledger.Cli.Print
import Hledger.Cli.Register
import Hledger.Cli.Stats
import Hledger.Cli.Options
import Hledger.Cli.Tests
import Hledger.Cli.Utils
import Hledger.Cli.Version
import Hledger.Data.Dates (getCurrentDay)
import Hledger.Data.RawOptions (RawOpts, optserror)
import Hledger.Reports.ReportOptions (dateSpanFromOpts, intervalFromOpts, queryFromOpts)
import Hledger.Utils
mainmode addons = defMode {
modeNames = [progname]
,modeHelp = unlines []
,modeHelpSuffix = [""]
,modeArgs = ([], Just $ argsFlag "[ARGS]")
,modeGroupModes = Group {
groupNamed = [
("Data entry commands", [
addmode
])
,("\nReporting commands", [
printmode
,accountsmode
,balancemode
,registermode
,incomestatementmode
,balancesheetmode
,cashflowmode
,activitymode
,statsmode
])
]
++ case addons of [] -> []
cs -> [("\nAdd-on commands", map defAddonCommandMode cs)]
,groupUnnamed = [
]
,groupHidden = [
testmode
,oldconvertmode
]
}
,modeGroupFlags = Group {
groupNamed = [generalflagsgroup3]
,groupUnnamed = []
,groupHidden = inputflags
}
}
oldconvertmode = (defCommandMode ["convert"]) {
modeValue = [("command","convert")]
,modeHelp = "convert is no longer needed, just use -f FILE.csv"
,modeArgs = ([], Just $ argsFlag "[CSVFILE]")
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = helpflags
,groupNamed = []
}
}
builtinCommands :: [Mode RawOpts]
builtinCommands =
let gs = modeGroupModes $ mainmode []
in concatMap snd (groupNamed gs) ++ groupUnnamed gs ++ groupHidden gs
builtinCommandNames :: [String]
builtinCommandNames = concatMap modeNames builtinCommands
argsToCliOpts :: [String] -> [String] -> IO CliOpts
argsToCliOpts args addons = do
let
args' = moveFlagsAfterCommand args
cmdargsopts = processValue (mainmode addons) args'
cmdargsopts' = decodeRawOpts cmdargsopts
rawOptsToCliOpts cmdargsopts' >>= checkCliOpts
moveFlagsAfterCommand :: [String] -> [String]
moveFlagsAfterCommand args = move args
where
move (f:a:as) | isMovableNoArgFlag f = (move $ a:as) ++ [f]
move (f:v:a:as) | isMovableReqArgFlag f = (move $ a:as) ++ [f,v]
move (fv:a:as) | isMovableReqArgFlagAndValue fv = (move $ a:as) ++ [fv]
move ("--debug":v:a:as) | not (null v) && all isDigit v = (move $ a:as) ++ ["--debug",v]
move ("--debug":a:as) = (move $ a:as) ++ ["--debug"]
move (fv@('-':'-':'d':'e':'b':'u':'g':'=':_):a:as) = (move $ a:as) ++ [fv]
move as = as
isMovableNoArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` noargflagstomove
isMovableReqArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` reqargflagstomove
isMovableReqArgFlagAndValue ('-':'-':a:as) = case break (== '=') (a:as) of (f:fs,_) -> (f:fs) `elem` reqargflagstomove
_ -> False
isMovableReqArgFlagAndValue ('-':f:_:_) = [f] `elem` reqargflagstomove
isMovableReqArgFlagAndValue _ = False
noargflagstomove = concatMap flagNames $ filter ((==FlagNone).flagInfo) flagstomove
reqargflagstomove = concatMap flagNames $ filter ((==FlagReq ).flagInfo) flagstomove
flagstomove = inputflags ++ helpflags
main :: IO ()
main = do
args <- getArgs
let
args' = moveFlagsAfterCommand args
isFlag = ("-" `isPrefixOf`)
isNonEmptyNonFlag s = not (isFlag s) && not (null s)
rawcmd = headDef "" $ takeWhile isNonEmptyNonFlag args'
isNullCommand = null rawcmd
(argsbeforecmd, argsaftercmd') = break (==rawcmd) args
argsaftercmd = drop 1 argsaftercmd'
dbgM :: Show a => String -> a -> IO ()
dbgM = dbgAtM 2
dbgM "running" prognameandversion
dbgM "raw args" args
dbgM "raw args rearranged for cmdargs" args'
dbgM "raw command is probably" rawcmd
dbgM "raw args before command" argsbeforecmd
dbgM "raw args after command" argsaftercmd
(addonPreciseNames', addonDisplayNames') <- hledgerAddons
let addonPreciseNames = filter (not . (`elem` builtinCommandNames) . dropExtension) addonPreciseNames'
let addonDisplayNames = filter (not . (`elem` builtinCommandNames)) addonDisplayNames'
opts <- argsToCliOpts args addonPreciseNames
let
cmd = command_ opts
isInternalCommand = cmd `elem` builtinCommandNames
isExternalCommand = not (null cmd) && cmd `elem` addonPreciseNames
isBadCommand = not (null rawcmd) && null cmd
hasHelp args = any (`elem` args) ["--help","-h","-?"]
hasVersion = ("--version" `elem`)
generalHelp = putStr $ showModeHelp $ mainmode addonDisplayNames
version = putStrLn prognameandversion
badCommandError = error' ("command "++rawcmd++" is not recognized, run with no command to see a list") >> exitFailure
f `orShowHelp` mode = if hasHelp args then putStr (showModeHelp mode) else f
dbgM "processed opts" opts
dbgM "command matched" cmd
dbgM "isNullCommand" isNullCommand
dbgM "isInternalCommand" isInternalCommand
dbgM "isExternalCommand" isExternalCommand
dbgM "isBadCommand" isBadCommand
d <- getCurrentDay
dbgM "date span from opts" (dateSpanFromOpts d $ reportopts_ opts)
dbgM "interval from opts" (intervalFromOpts $ reportopts_ opts)
dbgM "query from opts & args" (queryFromOpts d $ reportopts_ opts)
let
runHledgerCommand
| hasHelp argsbeforecmd = dbgM "" "--help before command, showing general help" >> generalHelp
| not (hasHelp argsaftercmd) && (hasVersion argsbeforecmd || (hasVersion argsaftercmd && isInternalCommand))
= version
| isNullCommand = dbgM "" "no command, showing general help" >> generalHelp
| isBadCommand = badCommandError
| cmd == "activity" = withJournalDo opts histogram `orShowHelp` activitymode
| cmd == "add" = (journalFilePathFromOpts opts >>= ensureJournalFileExists >> withJournalDo opts add) `orShowHelp` addmode
| cmd == "accounts" = withJournalDo opts accounts `orShowHelp` accountsmode
| cmd == "balance" = withJournalDo opts balance `orShowHelp` balancemode
| cmd == "balancesheet" = withJournalDo opts balancesheet `orShowHelp` balancesheetmode
| cmd == "cashflow" = withJournalDo opts cashflow `orShowHelp` cashflowmode
| cmd == "incomestatement" = withJournalDo opts incomestatement `orShowHelp` incomestatementmode
| cmd == "print" = withJournalDo opts print' `orShowHelp` printmode
| cmd == "register" = withJournalDo opts register `orShowHelp` registermode
| cmd == "stats" = withJournalDo opts stats `orShowHelp` statsmode
| cmd == "test" = test' opts `orShowHelp` testmode
| isExternalCommand = do
let externalargs = argsbeforecmd ++ filter (not.(=="--")) argsaftercmd
let shellcmd = printf "%s-%s %s" progname cmd (unwords' externalargs) :: String
dbgM "external command selected" cmd
dbgM "external command arguments" (map quoteIfNeeded externalargs)
dbgM "running shell command" shellcmd
system shellcmd >>= exitWith
| cmd == "convert" = error' (modeHelp oldconvertmode) >> exitFailure
| otherwise = optserror ("could not understand the arguments "++show args) >> exitFailure
runHledgerCommand