slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

imp: cli: Allow general optional argument flags (--pretty and

Browse Source 
--forecast) to be moved after the subcommand name.
This commit is contained in:
Stephen Morgan 2021-09-22 15:29:36 +10:00 committed by Simon Michael
parent 6547624e5d
commit 465a5cf917
1 changed files with 17 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
hledger/Hledger/Cli/Main.hs
View File

@ -36,6 +36,8 @@ etc.
-} -}
{-# LANGUAGE LambdaCase #-}
module Hledger.Cli.Main where module Hledger.Cli.Main where
import Data.Char (isDigit) import Data.Char (isDigit)
@ -234,28 +236,29 @@ moveFlagsAfterCommand args = moveArgs $ ensureDebugHasArg args
moveArgs args = insertFlagsAfterCommand $ moveArgs' (args, []) moveArgs args = insertFlagsAfterCommand $ moveArgs' (args, [])
where where
-- -h ..., --version ...
moveArgs' ((f:a:as), flags) | isMovableNoArgFlag f = moveArgs' (a:as, flags ++ [f])
-- -f FILE ..., --alias ALIAS ... -- -f FILE ..., --alias ALIAS ...
moveArgs' ((f:v:a:as), flags) | isMovableReqArgFlag f, isValue v = moveArgs' (a:as, flags ++ [f,v]) moveArgs' ((f:v:a:as), flags) | isMovableReqArgFlag f, isValue v = moveArgs' (a:as, flags ++ [f,v])
-- -fFILE ..., --alias=ALIAS ... -- -fFILE ..., --alias=ALIAS ...
moveArgs' ((fv:a:as), flags) | isMovableReqArgFlagAndValue fv = moveArgs' (a:as, flags ++ [fv]) moveArgs' ((fv:a:as), flags) | isMovableArgFlagAndValue fv = moveArgs' (a:as, flags ++ [fv])
-- -f(missing arg) -- -f(missing arg)
moveArgs' ((f:a:as), flags) | isMovableReqArgFlag f, not (isValue a) = moveArgs' (a:as, flags ++ [f]) 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 -- anything else
moveArgs' (as, flags) = (as, flags) moveArgs' (as, flags) = (as, flags)
insertFlagsAfterCommand ([], flags) = flags insertFlagsAfterCommand ([], flags) = flags
insertFlagsAfterCommand (command:args, flags) = [command] ++ flags ++ args insertFlagsAfterCommand (command:args, flags) = [command] ++ flags ++ args
isMovableNoArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` noargflagstomove isMovableNoArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` optargflagstomove ++ noargflagstomove
isMovableReqArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` reqargflagstomove isMovableReqArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` reqargflagstomove
isMovableReqArgFlagAndValue ('-':'-':a:as) = case break (== '=') (a:as) of (f:fs,_:_) -> (f:fs) `elem` reqargflagstomove isMovableArgFlagAndValue ('-':'-':a:as) = case break (== '=') (a:as) of
_ -> False (f:fs,_:_) -> (f:fs) `elem` optargflagstomove ++ reqargflagstomove
isMovableReqArgFlagAndValue ('-':shortflag:_:_) = [shortflag] `elem` reqargflagstomove _ -> False
isMovableReqArgFlagAndValue _ = False isMovableArgFlagAndValue ('-':shortflag:_:_) = [shortflag] `elem` reqargflagstomove
isMovableArgFlagAndValue _ = False
isValue "-" = True isValue "-" = True
isValue ('-':_) = False isValue ('-':_) = False
@ -265,3 +268,9 @@ flagstomove = inputflags ++ reportflags ++ helpflags
noargflagstomove = concatMap flagNames $ filter ((==FlagNone).flagInfo) flagstomove noargflagstomove = concatMap flagNames $ filter ((==FlagNone).flagInfo) flagstomove
reqargflagstomove = -- filter (/= "debug") $ reqargflagstomove = -- filter (/= "debug") $
concatMap flagNames $ filter ((==FlagReq ).flagInfo) flagstomove concatMap flagNames $ filter ((==FlagReq ).flagInfo) flagstomove
optargflagstomove = concatMap flagNames $ filter (isFlagOpt .flagInfo) flagstomove
where
isFlagOpt = \case
FlagOpt _ -> True
FlagOptRare _ -> True
_ -> False