diff --git a/Makefile b/Makefile index 7f5da8064..40bb129f9 100644 --- a/Makefile +++ b/Makefile @@ -408,11 +408,11 @@ ghcid-shake: $(call def-help,ghcid-shake, start ghcid autobuilder on Shake.hs) # multi-package GHCI prompts ghci: $(call def-help,ghci, start ghci REPL on hledger-lib + hledger) - $(STACKGHCI) exec -- $(GHCI) $(BUILDFLAGS) hledger/Hledger/Cli/Main.hs + $(STACKGHCI) exec -- $(GHCI) $(BUILDFLAGS) hledger/Hledger/Cli.hs ghci-prof: $(call def-help,ghci-prof, start ghci REPL on hledger-lib + hledger with profiling/call stack information) stack build --profile hledger --only-dependencies - $(STACKGHCI) exec -- $(GHCI) $(BUILDFLAGS) -fexternal-interpreter -prof -fprof-auto hledger/Hledger/Cli/Main.hs + $(STACKGHCI) exec -- $(GHCI) $(BUILDFLAGS) -fexternal-interpreter -prof -fprof-auto hledger/Hledger/Cli.hs ghci-dev: $(call def-help,ghci-dev, start ghci REPL on hledger-lib + hledger + dev.hs script) $(STACKGHCI) exec -- $(GHCI) $(BUILDFLAGS) -fno-warn-unused-imports -fno-warn-unused-binds dev.hs diff --git a/bin/hledger-register-max.hs b/bin/hledger-register-max.hs index 536401adc..57090ec19 100755 --- a/bin/hledger-register-max.hs +++ b/bin/hledger-register-max.hs @@ -27,7 +27,7 @@ import Safe import System.Environment import Hledger import Hledger.Cli -import Hledger.Cli.Main (argsToCliOpts) +import Hledger.Cli (argsToCliOpts) -- XXX needs --help, see hledger-addon-example.hs diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index 55ad7fc97..20e0b134c 100644 --- a/hledger/Hledger/Cli.hs +++ b/hledger/Hledger/Cli.hs @@ -1,26 +1,108 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +{-# HLINT ignore "Unused LANGUAGE pragma" #-} + {-| -Hledger.Cli re-exports the options, utilities and commands provided by -the hledger command-line program. This module also aggregates the -built-in unit tests defined throughout hledger and hledger-lib, and -adds some more which are easier to define here. +This is the root module of the @hledger@ package, +providing hledger's command-line interface. +The main function, +commands, +command-line options, +and utilities useful to other hledger command-line programs +are exported. +It also re-exports hledger-lib:Hledger +and cmdargs:System.Concole.CmdArgs.Explicit + +See also: + +- [hledger-lib:Hledger]("Hledger") +- [hledger:Hledger.Cli]("Hledger.Cli") +- [hledger-ui:Hledger.UI]("Hledger.UI") +- [hledger-web:Hledger.Web]("Hledger.Web") +- [The README files](https://github.com/search?q=repo%3Asimonmichael%2Fhledger+path%3A**%2FREADME*&type=code&ref=advsearch) +- [The high-level developer docs](https://hledger.org/dev.html) + +== About + +hledger - a fast, reliable, user-friendly plain text accounting tool. +Copyright (c) 2007-2023 Simon Michael and contributors +Released under GPL version 3 or later. + +hledger is a Haskell rewrite of John Wiegley's "ledger". +It generates financial reports from a plain text general journal. +You can use the command line: + +> $ hledger + +or ghci: + +> $ make ghci +> ghci> Right j <- runExceptT $ readJournalFile definputopts "examples/sample.journal" -- or: j <- defaultJournal +> ghci> :t j +> j :: Journal +> ghci> stats defcliopts j +> Main file : examples/sample.journal +> Included files : +> Transactions span : 2008-01-01 to 2009-01-01 (366 days) +> Last transaction : 2008-12-31 (733772 days from now) +> Transactions : 5 (0.0 per day) +> Transactions last 30 days: 0 (0.0 per day) +> Transactions last 7 days : 0 (0.0 per day) +> Payees/descriptions : 5 +> Accounts : 8 (depth 3) +> Commodities : 1 ($) +> Market prices : 0 () +> +> Run time (throughput) : 1695276900.00s (0 txns/s) +> ghci> balance defcliopts j +> $1 assets:bank:saving +> $-2 assets:cash +> $1 expenses:food +> $1 expenses:supplies +> $-1 income:gifts +> $-1 income:salary +> $1 liabilities:debts +> -------------------- +> 0 +> ghci> + +etc. -} module Hledger.Cli ( + prognameandversion, + versionString, + main, + mainmode, + argsToCliOpts, + -- * Re-exports module Hledger.Cli.CliOptions, module Hledger.Cli.Commands, module Hledger.Cli.DocFiles, module Hledger.Cli.Utils, module Hledger.Cli.Version, module Hledger, + -- ** System.Console.CmdArgs.Explicit module System.Console.CmdArgs.Explicit, - prognameandversion, - versionString ) where +import Control.Monad (when) +import Data.List +import Safe +import qualified System.Console.CmdArgs.Explicit as C +import System.Environment +import System.Exit +import System.FilePath +import System.Process +import Text.Printf + +import Data.Time.Clock.POSIX (getPOSIXTime) + + import GitHash (tGitInfoCwdTry) import System.Console.CmdArgs.Explicit hiding (Name) -- don't clash with hledger-ui @@ -31,6 +113,7 @@ import Hledger.Cli.DocFiles import Hledger.Cli.Utils import Hledger.Cli.Version + -- | The program name and version string for this build of the hledger tool, -- including any git info available at build time. prognameandversion :: String @@ -48,4 +131,226 @@ prognameandversion = versionString progname packageversion versionString :: ProgramName -> PackageVersion -> String versionString = versionStringWith $$tGitInfoCwdTry + +-- | The overall cmdargs mode describing hledger's command-line options and subcommands. +mainmode addons = defMode { + modeNames = [progname ++ " [CMD]"] + ,modeArgs = ([], Just $ argsFlag "[ARGS]") + ,modeHelp = unlines ["hledger's main command line interface. Runs builtin commands and other hledger executables. Type \"hledger\" to list available commands."] + ,modeGroupModes = Group { + -- subcommands in the unnamed group, shown first: + groupUnnamed = [ + ] + -- subcommands in named groups: + ,groupNamed = [ + ] + -- subcommands handled but not shown in the help: + ,groupHidden = map fst builtinCommands ++ map addonCommandMode addons + } + ,modeGroupFlags = Group { + -- flags in named groups: + groupNamed = [ + ( "General input flags", inputflags) + ,("\nGeneral reporting flags", reportflags) + ,("\nGeneral help flags", helpflags) + ] + -- flags in the unnamed group, shown last: + ,groupUnnamed = [] + -- flags handled but not shown in the help: + ,groupHidden = + [detailedversionflag] + -- ++ inputflags -- included here so they'll not raise a confusing error if present with no COMMAND + } + ,modeHelpSuffix = "Examples:" : + map (progname ++) [ + " list commands" + ," CMD [--] [OPTS] [ARGS] run a command (use -- with addon commands)" + ,"-CMD [OPTS] [ARGS] or run addon commands directly" + ," -h show general usage" + ," CMD -h show command usage" + ," help [MANUAL] show any of the hledger manuals in various formats" + ] + } + +-- | Let's go! +main :: IO () +main = do + starttime <- getPOSIXTime + -- try to encourage user's $PAGER to properly display ANSI + when useColorOnStdout setupPager + + -- Choose and run the appropriate internal or external command based + -- on the raw command-line arguments, cmdarg's interpretation of + -- same, and hledger-* executables in the user's PATH. A somewhat + -- complex mishmash of cmdargs and custom processing, hence all the + -- debugging support and tests. See also Hledger.Cli.CliOptions and + -- command-line.test. + + -- some preliminary (imperfect) argument parsing to supplement cmdargs + args <- getArgs >>= expandArgsAt + let + args' = moveFlagsAfterCommand $ replaceNumericFlags 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' + dbgIO :: Show a => String -> a -> IO () + dbgIO = ptraceAtIO 8 + + dbgIO "running" prognameandversion + dbgIO "raw args" args + dbgIO "raw args rearranged for cmdargs" args' + dbgIO "raw command is probably" rawcmd + dbgIO "raw args before command" argsbeforecmd + dbgIO "raw args after command" argsaftercmd + + -- Search PATH for add-ons, excluding any that match built-in command names + addons' <- hledgerAddons + let addons = filter (not . (`elem` builtinCommandNames) . dropExtension) addons' + + -- parse arguments with cmdargs + opts' <- argsToCliOpts args addons + let opts = opts'{progstarttime_=starttime} + + -- select an action and run it. + let + cmd = command_ opts -- the full matched internal or external command name, if any + isInternalCommand = cmd `elem` builtinCommandNames -- not (null cmd) && not (cmd `elem` addons) + isExternalCommand = not (null cmd) && cmd `elem` addons -- probably + isBadCommand = not (null rawcmd) && null cmd + hasVersion = ("--version" `elem`) + printUsage = pager $ showModeUsage $ mainmode addons + badCommandError = error' ("command "++rawcmd++" is not recognized, run with no command to see a list") >> exitFailure -- PARTIAL: + hasHelpFlag args1 = any (`elem` args1) ["-h","--help"] + hasManFlag args1 = (`elem` args1) "--man" + hasInfoFlag args1 = (`elem` args1) "--info" + f `orShowHelp` mode1 + | hasHelpFlag args = pager $ showModeUsage mode1 + | hasInfoFlag args = runInfoForTopic "hledger" (headMay $ modeNames mode1) + | hasManFlag args = runManForTopic "hledger" (headMay $ modeNames mode1) + | otherwise = f + -- where + -- lastdocflag + dbgIO "processed opts" opts + dbgIO "command matched" cmd + dbgIO "isNullCommand" isNullCommand + dbgIO "isInternalCommand" isInternalCommand + dbgIO "isExternalCommand" isExternalCommand + dbgIO "isBadCommand" isBadCommand + dbgIO "period from opts" (period_ . _rsReportOpts $ reportspec_ opts) + dbgIO "interval from opts" (interval_ . _rsReportOpts $ reportspec_ opts) + dbgIO "query from opts & args" (_rsQuery $ reportspec_ opts) + let + journallesserror = error $ cmd++" tried to read the journal but is not supposed to" + runHledgerCommand + -- high priority flags and situations. -h, then --help, then --info are highest priority. + | isNullCommand && hasHelpFlag args = dbgIO "" "-h/--help with no command, showing general help" >> printUsage + | isNullCommand && hasInfoFlag args = dbgIO "" "--info with no command, showing general info manual" >> runInfoForTopic "hledger" Nothing + | isNullCommand && hasManFlag args = dbgIO "" "--man with no command, showing general man page" >> runManForTopic "hledger" Nothing + | not (isExternalCommand || hasHelpFlag args || hasInfoFlag args || hasManFlag args) + && (hasVersion args) -- || (hasVersion argsaftercmd && isInternalCommand)) + = putStrLn prognameandversion + -- \| (null externalcmd) && boolopt "binary-filename" rawopts = putStrLn $ binaryfilename progname + -- \| "--browse-args" `elem` args = System.Console.CmdArgs.Helper.execute "cmdargs-browser" mainmode' args >>= (putStr . show) + | isNullCommand = dbgIO "" "no command, showing commands list" >> printCommandsList prognameandversion addons + | isBadCommand = badCommandError + + -- builtin commands + | Just (cmdmode, cmdaction) <- findBuiltinCommand cmd = + (case True of + -- these commands should not require or read the journal + _ | cmd `elem` ["demo","help","test"] -> cmdaction opts journallesserror + -- these commands should create the journal if missing + _ | cmd `elem` ["add","import"] -> do + ensureJournalFileExists . head =<< journalFilePathFromOpts opts + withJournalDo opts (cmdaction opts) + -- other commands read the journal and should fail if it's missing + _ -> withJournalDo opts (cmdaction opts) + ) + `orShowHelp` cmdmode + + -- addon commands + | isExternalCommand = do + let externalargs = argsbeforecmd ++ filter (/="--") argsaftercmd + let shellcmd = printf "%s-%s %s" progname cmd (unwords' externalargs) :: String + dbgIO "external command selected" cmd + dbgIO "external command arguments" (map quoteIfNeeded externalargs) + dbgIO "running shell command" shellcmd + system shellcmd >>= exitWith + + -- deprecated commands + -- cmd == "convert" = error' (modeHelp oldconvertmode) >> exitFailure + + -- shouldn't reach here + | otherwise = usageError ("could not understand the arguments "++show args) >> exitFailure + + runHledgerCommand + +-- | Parse hledger CLI options from these command line arguments and +-- add-on command names, or raise any error. +argsToCliOpts :: [String] -> [String] -> IO CliOpts +argsToCliOpts args addons = do + let + args' = moveFlagsAfterCommand $ replaceNumericFlags args + cmdargsopts = either usageError id $ C.process (mainmode addons) args' + rawOptsToCliOpts cmdargsopts + +-- | A hacky workaround for cmdargs not accepting flags before the +-- subcommand name: try to detect and move such flags after the +-- command. This allows the user to put them in either position. +-- The order of options is not preserved, but that should be ok. +-- +-- Since we're not parsing flags as precisely as cmdargs here, this is +-- imperfect. We make a decent effort to: +-- - move all no-argument help/input/report flags +-- - move all required-argument help/input/report flags along with their values, space-separated or not +-- - ensure --debug has an argument (because.. "or this all goes to hell") +-- - not confuse things further or cause misleading errors. +moveFlagsAfterCommand :: [String] -> [String] +moveFlagsAfterCommand args = moveArgs $ ensureDebugHasArg args + where + moveArgs args1 = insertFlagsAfterCommand $ moveArgs' (args1, []) + where + -- -f FILE ..., --alias ALIAS ... + moveArgs' ((f:v:a:as), flags) | isMovableReqArgFlag f, isValue v = moveArgs' (a:as, flags ++ [f,v]) + -- -fFILE ..., --alias=ALIAS ... + moveArgs' ((fv:a:as), flags) | isMovableArgFlagAndValue fv = moveArgs' (a:as, flags ++ [fv]) + -- -f(missing arg) + moveArgs' ((f:a:as), flags) | isMovableReqArgFlag f, not (isValue a) = moveArgs' (a:as, flags ++ [f]) + -- -h ..., --version ... + moveArgs' ((f:a:as), flags) | isMovableNoArgFlag f = moveArgs' (a:as, flags ++ [f]) + -- anything else + moveArgs' (as, flags) = (as, flags) + + insertFlagsAfterCommand ([], flags) = flags + insertFlagsAfterCommand (command1:args2, flags) = [command1] ++ flags ++ args2 + +isMovableNoArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` optargflagstomove ++ noargflagstomove + +isMovableReqArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` reqargflagstomove + +isMovableArgFlagAndValue ('-':'-':a:as) = case break (== '=') (a:as) of + (f:fs,_:_) -> (f:fs) `elem` optargflagstomove ++ reqargflagstomove + _ -> False +isMovableArgFlagAndValue ('-':shortflag:_:_) = [shortflag] `elem` reqargflagstomove +isMovableArgFlagAndValue _ = False + +isValue "-" = True +isValue ('-':_) = False +isValue _ = True + +flagstomove = inputflags ++ reportflags ++ helpflags +noargflagstomove = concatMap flagNames $ filter ((==FlagNone).flagInfo) flagstomove +reqargflagstomove = -- filter (/= "debug") $ + concatMap flagNames $ filter ((==FlagReq ).flagInfo) flagstomove +optargflagstomove = concatMap flagNames $ filter (isFlagOpt .flagInfo) flagstomove + where + isFlagOpt = \case + FlagOpt _ -> True + FlagOptRare _ -> True + _ -> False + + -- unit tests (tests_Hledger_Cli) are defined in Hledger.Cli.Commands diff --git a/hledger/Hledger/Cli/Main.hs b/hledger/Hledger/Cli/Main.hs deleted file mode 100644 index c079a11d1..000000000 --- a/hledger/Hledger/Cli/Main.hs +++ /dev/null @@ -1,275 +0,0 @@ -{-| -hledger - a ledger-compatible accounting tool. -Copyright (c) 2007-2022 Simon Michael -Released under GPL version 3 or later. - -hledger is a partial haskell clone of John Wiegley's "ledger". It -generates ledger-compatible register & balance reports from a plain text -journal, and demonstrates a functional implementation of ledger. -For more information, see http:\/\/hledger.org . - -This module provides the main function for the hledger command-line -executable. It is exposed here so that it can be imported by eg benchmark -scripts. - -You can use the command line: - -> $ hledger --help - -or ghci: - -> $ ghci hledger -> > Right j <- readJournalFile definputopts "examples/sample.journal" -> > register [] ["income","expenses"] j -> 2008/01/01 income income:salary $-1 $-1 -> 2008/06/01 gift income:gifts $-1 $-2 -> 2008/06/03 eat & shop expenses:food $1 $-1 -> expenses:supplies $1 0 -> > balance [Depth "1"] [] l -> $-1 assets -> $2 expenses -> $-2 income -> $1 liabilities -> > j <- defaultJournal - -etc. - --} - -{-# LANGUAGE LambdaCase #-} - -module Hledger.Cli.Main where - -import Control.Monad (when) -import Data.List -import Safe -import qualified System.Console.CmdArgs.Explicit as C -import System.Environment -import System.Exit -import System.FilePath -import System.Process -import Text.Printf - -import Hledger.Cli -import Data.Time.Clock.POSIX (getPOSIXTime) - - --- | The overall cmdargs mode describing hledger's command-line options and subcommands. -mainmode addons = defMode { - modeNames = [progname ++ " [CMD]"] - ,modeArgs = ([], Just $ argsFlag "[ARGS]") - ,modeHelp = unlines ["hledger's main command line interface. Runs builtin commands and other hledger executables. Type \"hledger\" to list available commands."] - ,modeGroupModes = Group { - -- subcommands in the unnamed group, shown first: - groupUnnamed = [ - ] - -- subcommands in named groups: - ,groupNamed = [ - ] - -- subcommands handled but not shown in the help: - ,groupHidden = map fst builtinCommands ++ map addonCommandMode addons - } - ,modeGroupFlags = Group { - -- flags in named groups: - groupNamed = [ - ( "General input flags", inputflags) - ,("\nGeneral reporting flags", reportflags) - ,("\nGeneral help flags", helpflags) - ] - -- flags in the unnamed group, shown last: - ,groupUnnamed = [] - -- flags handled but not shown in the help: - ,groupHidden = - [detailedversionflag] - -- ++ inputflags -- included here so they'll not raise a confusing error if present with no COMMAND - } - ,modeHelpSuffix = "Examples:" : - map (progname ++) [ - " list commands" - ," CMD [--] [OPTS] [ARGS] run a command (use -- with addon commands)" - ,"-CMD [OPTS] [ARGS] or run addon commands directly" - ," -h show general usage" - ," CMD -h show command usage" - ," help [MANUAL] show any of the hledger manuals in various formats" - ] - } - --- | Let's go! -main :: IO () -main = do - starttime <- getPOSIXTime - -- try to encourage user's $PAGER to properly display ANSI - when useColorOnStdout setupPager - - -- Choose and run the appropriate internal or external command based - -- on the raw command-line arguments, cmdarg's interpretation of - -- same, and hledger-* executables in the user's PATH. A somewhat - -- complex mishmash of cmdargs and custom processing, hence all the - -- debugging support and tests. See also Hledger.Cli.CliOptions and - -- command-line.test. - - -- some preliminary (imperfect) argument parsing to supplement cmdargs - args <- getArgs >>= expandArgsAt - let - args' = moveFlagsAfterCommand $ replaceNumericFlags 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' - dbgIO :: Show a => String -> a -> IO () - dbgIO = ptraceAtIO 8 - - dbgIO "running" prognameandversion - dbgIO "raw args" args - dbgIO "raw args rearranged for cmdargs" args' - dbgIO "raw command is probably" rawcmd - dbgIO "raw args before command" argsbeforecmd - dbgIO "raw args after command" argsaftercmd - - -- Search PATH for add-ons, excluding any that match built-in command names - addons' <- hledgerAddons - let addons = filter (not . (`elem` builtinCommandNames) . dropExtension) addons' - - -- parse arguments with cmdargs - opts' <- argsToCliOpts args addons - let opts = opts'{progstarttime_=starttime} - - -- select an action and run it. - let - cmd = command_ opts -- the full matched internal or external command name, if any - isInternalCommand = cmd `elem` builtinCommandNames -- not (null cmd) && not (cmd `elem` addons) - isExternalCommand = not (null cmd) && cmd `elem` addons -- probably - isBadCommand = not (null rawcmd) && null cmd - hasVersion = ("--version" `elem`) - printUsage = pager $ showModeUsage $ mainmode addons - badCommandError = error' ("command "++rawcmd++" is not recognized, run with no command to see a list") >> exitFailure -- PARTIAL: - hasHelpFlag args1 = any (`elem` args1) ["-h","--help"] - hasManFlag args1 = (`elem` args1) "--man" - hasInfoFlag args1 = (`elem` args1) "--info" - f `orShowHelp` mode1 - | hasHelpFlag args = pager $ showModeUsage mode1 - | hasInfoFlag args = runInfoForTopic "hledger" (headMay $ modeNames mode1) - | hasManFlag args = runManForTopic "hledger" (headMay $ modeNames mode1) - | otherwise = f - -- where - -- lastdocflag - dbgIO "processed opts" opts - dbgIO "command matched" cmd - dbgIO "isNullCommand" isNullCommand - dbgIO "isInternalCommand" isInternalCommand - dbgIO "isExternalCommand" isExternalCommand - dbgIO "isBadCommand" isBadCommand - dbgIO "period from opts" (period_ . _rsReportOpts $ reportspec_ opts) - dbgIO "interval from opts" (interval_ . _rsReportOpts $ reportspec_ opts) - dbgIO "query from opts & args" (_rsQuery $ reportspec_ opts) - let - journallesserror = error $ cmd++" tried to read the journal but is not supposed to" - runHledgerCommand - -- high priority flags and situations. -h, then --help, then --info are highest priority. - | isNullCommand && hasHelpFlag args = dbgIO "" "-h/--help with no command, showing general help" >> printUsage - | isNullCommand && hasInfoFlag args = dbgIO "" "--info with no command, showing general info manual" >> runInfoForTopic "hledger" Nothing - | isNullCommand && hasManFlag args = dbgIO "" "--man with no command, showing general man page" >> runManForTopic "hledger" Nothing - | not (isExternalCommand || hasHelpFlag args || hasInfoFlag args || hasManFlag args) - && (hasVersion args) -- || (hasVersion argsaftercmd && isInternalCommand)) - = putStrLn prognameandversion - -- \| (null externalcmd) && boolopt "binary-filename" rawopts = putStrLn $ binaryfilename progname - -- \| "--browse-args" `elem` args = System.Console.CmdArgs.Helper.execute "cmdargs-browser" mainmode' args >>= (putStr . show) - | isNullCommand = dbgIO "" "no command, showing commands list" >> printCommandsList prognameandversion addons - | isBadCommand = badCommandError - - -- builtin commands - | Just (cmdmode, cmdaction) <- findBuiltinCommand cmd = - (case True of - -- these commands should not require or read the journal - _ | cmd `elem` ["demo","help","test"] -> cmdaction opts journallesserror - -- these commands should create the journal if missing - _ | cmd `elem` ["add","import"] -> do - ensureJournalFileExists . head =<< journalFilePathFromOpts opts - withJournalDo opts (cmdaction opts) - -- other commands read the journal and should fail if it's missing - _ -> withJournalDo opts (cmdaction opts) - ) - `orShowHelp` cmdmode - - -- addon commands - | isExternalCommand = do - let externalargs = argsbeforecmd ++ filter (/="--") argsaftercmd - let shellcmd = printf "%s-%s %s" progname cmd (unwords' externalargs) :: String - dbgIO "external command selected" cmd - dbgIO "external command arguments" (map quoteIfNeeded externalargs) - dbgIO "running shell command" shellcmd - system shellcmd >>= exitWith - - -- deprecated commands - -- cmd == "convert" = error' (modeHelp oldconvertmode) >> exitFailure - - -- shouldn't reach here - | otherwise = usageError ("could not understand the arguments "++show args) >> exitFailure - - runHledgerCommand - --- | Parse hledger CLI options from these command line arguments and --- add-on command names, or raise any error. -argsToCliOpts :: [String] -> [String] -> IO CliOpts -argsToCliOpts args addons = do - let - args' = moveFlagsAfterCommand $ replaceNumericFlags args - cmdargsopts = either usageError id $ C.process (mainmode addons) args' - rawOptsToCliOpts cmdargsopts - --- | A hacky workaround for cmdargs not accepting flags before the --- subcommand name: try to detect and move such flags after the --- command. This allows the user to put them in either position. --- The order of options is not preserved, but that should be ok. --- --- Since we're not parsing flags as precisely as cmdargs here, this is --- imperfect. We make a decent effort to: --- - move all no-argument help/input/report flags --- - move all required-argument help/input/report flags along with their values, space-separated or not --- - ensure --debug has an argument (because.. "or this all goes to hell") --- - not confuse things further or cause misleading errors. -moveFlagsAfterCommand :: [String] -> [String] -moveFlagsAfterCommand args = moveArgs $ ensureDebugHasArg args - where - moveArgs args1 = insertFlagsAfterCommand $ moveArgs' (args1, []) - where - -- -f FILE ..., --alias ALIAS ... - moveArgs' ((f:v:a:as), flags) | isMovableReqArgFlag f, isValue v = moveArgs' (a:as, flags ++ [f,v]) - -- -fFILE ..., --alias=ALIAS ... - moveArgs' ((fv:a:as), flags) | isMovableArgFlagAndValue fv = moveArgs' (a:as, flags ++ [fv]) - -- -f(missing arg) - moveArgs' ((f:a:as), flags) | isMovableReqArgFlag f, not (isValue a) = moveArgs' (a:as, flags ++ [f]) - -- -h ..., --version ... - moveArgs' ((f:a:as), flags) | isMovableNoArgFlag f = moveArgs' (a:as, flags ++ [f]) - -- anything else - moveArgs' (as, flags) = (as, flags) - - insertFlagsAfterCommand ([], flags) = flags - insertFlagsAfterCommand (command1:args2, flags) = [command1] ++ flags ++ args2 - -isMovableNoArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` optargflagstomove ++ noargflagstomove - -isMovableReqArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` reqargflagstomove - -isMovableArgFlagAndValue ('-':'-':a:as) = case break (== '=') (a:as) of - (f:fs,_:_) -> (f:fs) `elem` optargflagstomove ++ reqargflagstomove - _ -> False -isMovableArgFlagAndValue ('-':shortflag:_:_) = [shortflag] `elem` reqargflagstomove -isMovableArgFlagAndValue _ = False - -isValue "-" = True -isValue ('-':_) = False -isValue _ = True - -flagstomove = inputflags ++ reportflags ++ helpflags -noargflagstomove = concatMap flagNames $ filter ((==FlagNone).flagInfo) flagstomove -reqargflagstomove = -- filter (/= "debug") $ - concatMap flagNames $ filter ((==FlagReq ).flagInfo) flagstomove -optargflagstomove = concatMap flagNames $ filter (isFlagOpt .flagInfo) flagstomove - where - isFlagOpt = \case - FlagOpt _ -> True - FlagOptRare _ -> True - _ -> False diff --git a/hledger/Hledger/Cli/Script.hs b/hledger/Hledger/Cli/Script.hs index 7272f0e55..044253e90 100644 --- a/hledger/Hledger/Cli/Script.hs +++ b/hledger/Hledger/Cli/Script.hs @@ -36,4 +36,4 @@ import System.Process as M import Hledger as M import Hledger.Cli as M -import Hledger.Cli.Main as M (argsToCliOpts) +-- import Hledger.Cli as M (argsToCliOpts) diff --git a/hledger/app/hledger-cli.hs b/hledger/app/hledger-cli.hs index a882da11e..b464da8d9 100755 --- a/hledger/app/hledger-cli.hs +++ b/hledger/app/hledger-cli.hs @@ -1,9 +1,9 @@ --- the hledger command-line executable; see Hledger/Cli/Main.hs +-- the hledger command-line executable; see Hledger/Cli.hs module Main (main) where -import qualified Hledger.Cli.Main (main) +import qualified Hledger.Cli (main) -- Have to write this explicitly for GHC 9.0.1a for some reason: main :: IO () -main = Hledger.Cli.Main.main +main = Hledger.Cli.main diff --git a/hledger/package.yaml b/hledger/package.yaml index 7c85768e2..b2e2689fb 100644 --- a/hledger/package.yaml +++ b/hledger/package.yaml @@ -144,7 +144,6 @@ library: cpp-options: -DVERSION="1.31.99" exposed-modules: - Hledger.Cli - - Hledger.Cli.Main - Hledger.Cli.CliOptions - Hledger.Cli.DocFiles - Hledger.Cli.Utils