diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index cd442b5ff..3803af7b9 100644 --- a/hledger/Hledger/Cli.hs +++ b/hledger/Hledger/Cli.hs @@ -64,10 +64,9 @@ etc. -} -{-# LANGUAGE LambdaCase #-} - {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# HLINT ignore "Unused LANGUAGE pragma" #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} @@ -90,8 +89,15 @@ module Hledger.Cli ( where import Control.Monad (when, unless) +import Data.Bifunctor (second) +import Data.Char (isDigit) +import Data.Either (isRight) +import Data.Function ((&)) +import Data.Functor ((<&>)) import Data.List import qualified Data.List.NonEmpty as NE +import Data.Maybe (isJust) +import Data.Text (pack, Text) import Data.Time.Clock.POSIX (getPOSIXTime) import Safe import System.Console.CmdArgs.Explicit @@ -100,6 +106,8 @@ import System.Environment import System.Exit import System.FilePath import System.Process +import Text.Megaparsec (optional, takeWhile1P) +import Text.Megaparsec.Char (char) import Text.Printf import Hledger @@ -109,10 +117,6 @@ import Hledger.Cli.Commands import Hledger.Cli.DocFiles import Hledger.Cli.Utils import Hledger.Cli.Version -import Data.Bifunctor (second) -import Data.Function ((&)) -import Data.Functor ((<&>)) -import Data.Maybe (isJust) verboseDebugLevel = 8 @@ -460,29 +464,33 @@ moveFlagsAfterCommand args = where moveFlagArgs :: ([String], [String]) -> ([String], [String]) moveFlagArgs ((a:b:cs), moved) - | isMovableFlagArg a == 2 = moveFlagArgs (cs, moved++[a,b]) - | isMovableFlagArg a == 1 = moveFlagArgs (b:cs, moved++[a]) - | otherwise = (a:b:cs, moved) + | isMovableFlagArg a b == 2 = moveFlagArgs (cs, moved++[a,b]) + | isMovableFlagArg a b == 1 = moveFlagArgs (b:cs, moved++[a]) + | otherwise = (a:b:cs, moved) where -- Is this a short or long flag argument that should be moved, -- and is its following argument a value that also should be moved ? -- Returns: - -- 0 (not a flag) - -- 1 (single flag, maybe with joined argument; or multiple joined short flags) - -- 2 (flag with value in the next argument). - isMovableFlagArg :: String -> Int - isMovableFlagArg a1 + -- 0 (not a flag; don't move this argument) + -- 1 (a valueless flag, or a long flag with joined argument, or multiple joined valueless short flags; move this argument) + -- 2 (a short or long flag with a value in the next argument; move this and next argument). + isMovableFlagArg :: String -> String -> Int + isMovableFlagArg a1 a2 | a1 `elem` noValFlagArgs = 1 -- short or long no-val flag - | a1 `elem` reqValFlagArgs, not $ "--debug" `isPrefixOf` a1 = 2 - -- short or long req-val flag, value is in next argument - -- --debug is really optional-value (see CliOptions), assume it has no value or joined value + | a1 == "--debug" && not (isDebugValue a2) = 1 --debug without a value + | a1 `elem` reqValFlagArgs = 2 -- short or long req-val flag (or --debug) with a separate value | a1 `elem` optValFlagArgs = 1 -- long (or short ?) opt-val flag, assume no value - | any (`isPrefixOf` a1) shortReqValFlagArgs = 1 -- short req-val flag, value is joined - | any (`isPrefixOf` a1) longReqValFlagArgs_ = 1 -- long req-val flag, value is joined with = - | any (`isPrefixOf` a1) longOptValFlagArgs_ = 1 -- long opt-val flag, value is joined with = + | any (`isPrefixOf` a1) shortReqValFlagArgs = 1 -- short req-val flag with a joined value + -- or possibly multiple joined valueless short flags, we won't move those correctly + | any (`isPrefixOf` a1) longReqValFlagArgs_ = 1 -- long req-val flag (or --debug) with a joined value + | any (`isPrefixOf` a1) longOptValFlagArgs_ = 1 -- long opt-val flag with a joined value -- | isLongFlagArg a1 && any (takeWhile (/='=') `isPrefixOf`) longReqValFlagArgs_ ... -- try to move abbreviated long flags ? | isFlagArg a1 = 1 -- an addon flag (or mistyped flag) we don't know, assume no value or value is joined | otherwise = 0 -- not a flag + where + -- Is this string a valid --debug value ? + isDebugValue s = isRight $ parsewith isdebugvalp $ pack s + where isdebugvalp = optional (char '-') >> takeWhile1P Nothing isDigit :: TextParser m Text moveFlagArgs (as, moved) = (as, moved) -- Flag arguments are command line arguments beginning with - or -- diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 0d708cfd8..023aa24b4 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -243,10 +243,8 @@ helpflags = [ ,flagNone ["info"] (setboolopt "info") "show the manual with info" ,flagNone ["man"] (setboolopt "man") "show the manual with man" ,flagNone ["version"] (setboolopt "version") "show version information" - -- ,flagOpt "1" ["debug"] (\s opts -> Right $ setopt "debug" s opts) "LVL" "show debug output (levels 1-9, default: 1)" - -- flagOpt would be more correct for --debug, showing --debug[=LVL] rather than --debug=[LVL]. - -- But because we handle --debug specially, flagReq also works, and it does not need =, removing a source of confusion. - -- (This involves specially adding the flag value if missing in Cli.hs.) + -- flagOpt would be more correct for --debug, showing --debug[=LVL] rather than --debug=[LVL] in help. + -- But flagReq plus special handling in Cli.hs makes the = optional, removing a source of confusion. ,flagReq ["debug"] (\s opts -> Right $ setopt "debug" s opts) "[1-9]" "show this much debug output (default: 1)" ] -- XXX why are these duplicated in defCommandMode below ? diff --git a/hledger/test/cli/cli.test b/hledger/test/cli/cli.test index b6cbd9d00..29df58997 100644 --- a/hledger/test/cli/cli.test +++ b/hledger/test/cli/cli.test @@ -114,9 +114,25 @@ $ hledger --no-conf check -f/dev/null # ** 15. --conf CONFFILE works with builtin commands. $ hledger --conf /dev/null check -f/dev/null -# ** 16. when moving options written before the command name: +# ** 16. When moving options written before the command name: # if the flag name is used in general options and also one or more commands, # the general option's arity determines whether a value is expected. # Here -p is a help command flag taking no value, but also a general option requiring a value, # so the value ("today") is detected. $ hledger -p today check -f/dev/null + +# ** 17. The specially-handled --debug option is also moved properly, with no value: +$ hledger --debug check -f/dev/null +>2 // + +# ** 18. a joined value: +$ hledger --debug=1 check -f/dev/null +>2 // + +# ** 19. or a separate value: +$ hledger --debug 1 check -f/dev/null +>2 // + +# ** 20. A short flag with joined value, or multiple valueless short flags joined together, are moved properly. +$ hledger -f/dev/null -BI check +>2 //