{-# LANGUAGE QuasiQuotes #-}
module Hledger.Cli.Main where
import Data.Char (isDigit)
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
mainmode :: [Name] -> Mode RawOpts
mainmode [Name]
addons = Mode RawOpts
defMode {
modeNames :: [Name]
modeNames = [Name
progname Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
" [CMD]"]
,modeArgs :: ([Arg RawOpts], Maybe (Arg RawOpts))
modeArgs = ([], Arg RawOpts -> Maybe (Arg RawOpts)
forall a. a -> Maybe a
Just (Arg RawOpts -> Maybe (Arg RawOpts))
-> Arg RawOpts -> Maybe (Arg RawOpts)
forall a b. (a -> b) -> a -> b
$ Name -> Arg RawOpts
argsFlag Name
"[ARGS]")
,modeHelp :: Name
modeHelp = [Name] -> Name
unlines [Name
"hledger's main command line interface. Runs builtin commands and other hledger executables. Type \"hledger\" to list available commands."]
,modeGroupModes :: Group (Mode RawOpts)
modeGroupModes = Group :: forall a. [a] -> [a] -> [(Name, [a])] -> Group a
Group {
groupUnnamed :: [Mode RawOpts]
groupUnnamed = [
]
,groupNamed :: [(Name, [Mode RawOpts])]
groupNamed = [
]
,groupHidden :: [Mode RawOpts]
groupHidden = ((Mode RawOpts, CliOpts -> Journal -> IO ()) -> Mode RawOpts)
-> [(Mode RawOpts, CliOpts -> Journal -> IO ())] -> [Mode RawOpts]
forall a b. (a -> b) -> [a] -> [b]
map (Mode RawOpts, CliOpts -> Journal -> IO ()) -> Mode RawOpts
forall a b. (a, b) -> a
fst [(Mode RawOpts, CliOpts -> Journal -> IO ())]
builtinCommands [Mode RawOpts] -> [Mode RawOpts] -> [Mode RawOpts]
forall a. [a] -> [a] -> [a]
++ (Name -> Mode RawOpts) -> [Name] -> [Mode RawOpts]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Mode RawOpts
addonCommandMode [Name]
addons
}
,modeGroupFlags :: Group (Flag RawOpts)
modeGroupFlags = Group :: forall a. [a] -> [a] -> [(Name, [a])] -> Group a
Group {
groupNamed :: [(Name, [Flag RawOpts])]
groupNamed = [
( Name
"General input flags", [Flag RawOpts]
inputflags)
,(Name
"\nGeneral reporting flags", [Flag RawOpts]
reportflags)
,(Name
"\nGeneral help flags", [Flag RawOpts]
helpflags)
]
,groupUnnamed :: [Flag RawOpts]
groupUnnamed = []
,groupHidden :: [Flag RawOpts]
groupHidden =
[Flag RawOpts
detailedversionflag]
}
,modeHelpSuffix :: [Name]
modeHelpSuffix = Name
"Examples:" Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:
(Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name
progname Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++) [
Name
" list commands"
,Name
" CMD [--] [OPTS] [ARGS] run a command (use -- with addon commands)"
,Name
"-CMD [OPTS] [ARGS] or run addon commands directly"
,Name
" -h show general usage"
,Name
" CMD -h show command usage"
,Name
" help [MANUAL] show any of the hledger manuals in various formats"
]
}
main :: IO ()
main :: IO ()
main = do
[Name]
args <- IO [Name]
getArgs IO [Name] -> ([Name] -> IO [Name]) -> IO [Name]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Name] -> IO [Name]
expandArgsAt
let
args' :: [Name]
args' = [Name] -> [Name]
moveFlagsAfterCommand ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ [Name] -> [Name]
replaceNumericFlags [Name]
args
isFlag :: Name -> Bool
isFlag = (Name
"-" Name -> Name -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)
isNonEmptyNonFlag :: Name -> Bool
isNonEmptyNonFlag Name
s = Bool -> Bool
not (Name -> Bool
isFlag Name
s) Bool -> Bool -> Bool
&& Bool -> Bool
not (Name -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Name
s)
rawcmd :: Name
rawcmd = Name -> [Name] -> Name
forall a. a -> [a] -> a
headDef Name
"" ([Name] -> Name) -> [Name] -> Name
forall a b. (a -> b) -> a -> b
$ (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Name -> Bool
isNonEmptyNonFlag [Name]
args'
isNullCommand :: Bool
isNullCommand = Name -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Name
rawcmd
([Name]
argsbeforecmd, [Name]
argsaftercmd') = (Name -> Bool) -> [Name] -> ([Name], [Name])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==Name
rawcmd) [Name]
args
argsaftercmd :: [Name]
argsaftercmd = Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
drop Int
1 [Name]
argsaftercmd'
dbgIO :: Show a => String -> a -> IO ()
dbgIO :: Name -> a -> IO ()
dbgIO = Int -> Name -> a -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> Name -> a -> m ()
ptraceAtIO Int
8
Name -> Name -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO Name
"running" Name
prognameandversion
Name -> [Name] -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO Name
"raw args" [Name]
args
Name -> [Name] -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO Name
"raw args rearranged for cmdargs" [Name]
args'
Name -> Name -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO Name
"raw command is probably" Name
rawcmd
Name -> [Name] -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO Name
"raw args before command" [Name]
argsbeforecmd
Name -> [Name] -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO Name
"raw args after command" [Name]
argsaftercmd
[Name]
addons' <- IO [Name]
hledgerAddons
let addons :: [Name]
addons = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Name -> Bool) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
builtinCommandNames) (Name -> Bool) -> (Name -> Name) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Name
dropExtension) [Name]
addons'
CliOpts
opts <- [Name] -> [Name] -> IO CliOpts
argsToCliOpts [Name]
args [Name]
addons
let
cmd :: Name
cmd = CliOpts -> Name
command_ CliOpts
opts
isInternalCommand :: Bool
isInternalCommand = Name
cmd Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
builtinCommandNames
isExternalCommand :: Bool
isExternalCommand = Bool -> Bool
not (Name -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Name
cmd) Bool -> Bool -> Bool
&& Name
cmd Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
addons
isBadCommand :: Bool
isBadCommand = Bool -> Bool
not (Name -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Name
rawcmd) Bool -> Bool -> Bool
&& Name -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Name
cmd
hasVersion :: [Name] -> Bool
hasVersion = (Name
"--version" Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`)
hasDetailedVersion :: [Name] -> Bool
hasDetailedVersion = (Name
"--version+" Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`)
printUsage :: IO ()
printUsage = Name -> IO ()
putStr (Name -> IO ()) -> Name -> IO ()
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> Name
forall a. Mode a -> Name
showModeUsage (Mode RawOpts -> Name) -> Mode RawOpts -> Name
forall a b. (a -> b) -> a -> b
$ [Name] -> Mode RawOpts
mainmode [Name]
addons
badCommandError :: IO b
badCommandError = Name -> IO Any
forall a. Name -> a
error' (Name
"command "Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
rawcmdName -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
" is not recognized, run with no command to see a list") IO Any -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO b
forall a. IO a
exitFailure
hasHelpFlag :: t Name -> Bool
hasHelpFlag t Name
args = (Name -> Bool) -> [Name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Name -> t Name -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Name
args) [Name
"-h",Name
"--help"]
IO ()
f orShowHelp :: IO () -> Mode a -> IO ()
`orShowHelp` Mode a
mode
| [Name] -> Bool
forall (t :: * -> *). Foldable t => t Name -> Bool
hasHelpFlag [Name]
args = Name -> IO ()
putStr (Name -> IO ()) -> Name -> IO ()
forall a b. (a -> b) -> a -> b
$ Mode a -> Name
forall a. Mode a -> Name
showModeUsage Mode a
mode
| Bool
otherwise = IO ()
f
Name -> CliOpts -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO Name
"processed opts" CliOpts
opts
Name -> Name -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO Name
"command matched" Name
cmd
Name -> Bool -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO Name
"isNullCommand" Bool
isNullCommand
Name -> Bool -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO Name
"isInternalCommand" Bool
isInternalCommand
Name -> Bool -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO Name
"isExternalCommand" Bool
isExternalCommand
Name -> Bool -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO Name
"isBadCommand" Bool
isBadCommand
Name -> Period -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO Name
"period from opts" (ReportOpts -> Period
period_ (ReportOpts -> Period)
-> (ReportSpec -> ReportOpts) -> ReportSpec -> Period
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportSpec -> ReportOpts
rsOpts (ReportSpec -> Period) -> ReportSpec -> Period
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
opts)
Name -> Interval -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO Name
"interval from opts" (ReportOpts -> Interval
interval_ (ReportOpts -> Interval)
-> (ReportSpec -> ReportOpts) -> ReportSpec -> Interval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportSpec -> ReportOpts
rsOpts (ReportSpec -> Interval) -> ReportSpec -> Interval
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
opts)
Name -> Query -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO Name
"query from opts & args" (ReportSpec -> Query
rsQuery (ReportSpec -> Query) -> ReportSpec -> Query
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
opts)
let
journallesserror :: a
journallesserror = Name -> a
forall a. HasCallStack => Name -> a
error (Name -> a) -> Name -> a
forall a b. (a -> b) -> a -> b
$ Name
cmdName -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
" tried to read the journal but is not supposed to"
runHledgerCommand :: IO ()
runHledgerCommand
| [Name] -> Bool
forall (t :: * -> *). Foldable t => t Name -> Bool
hasHelpFlag [Name]
argsbeforecmd = Name -> Name -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO Name
"" Name
"-h before command, showing general usage" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
printUsage
| Bool -> Bool
not ([Name] -> Bool
forall (t :: * -> *). Foldable t => t Name -> Bool
hasHelpFlag [Name]
argsaftercmd) Bool -> Bool -> Bool
&& ([Name] -> Bool
hasVersion [Name]
argsbeforecmd Bool -> Bool -> Bool
|| ([Name] -> Bool
hasVersion [Name]
argsaftercmd Bool -> Bool -> Bool
&& Bool
isInternalCommand))
= Name -> IO ()
putStrLn Name
prognameandversion
| Bool -> Bool
not ([Name] -> Bool
forall (t :: * -> *). Foldable t => t Name -> Bool
hasHelpFlag [Name]
argsaftercmd) Bool -> Bool -> Bool
&& ([Name] -> Bool
hasDetailedVersion [Name]
argsbeforecmd Bool -> Bool -> Bool
|| ([Name] -> Bool
hasDetailedVersion [Name]
argsaftercmd Bool -> Bool -> Bool
&& Bool
isInternalCommand))
= Name -> IO ()
putStrLn Name
prognameanddetailedversion
| Bool
isNullCommand = Name -> Name -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO Name
"" Name
"no command, showing commands list" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Name] -> IO ()
printCommandsList [Name]
addons
| Bool
isBadCommand = IO ()
forall a. IO a
badCommandError
| Just (Mode RawOpts
cmdmode, CliOpts -> Journal -> IO ()
cmdaction) <- Name -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findCommand Name
cmd =
(case Bool
True of
Bool
_ | Name
cmd Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name
"test",Name
"help"] -> CliOpts -> Journal -> IO ()
cmdaction CliOpts
opts Journal
forall a. a
journallesserror
Bool
_ | Name
cmd Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name
"add",Name
"import"] -> do
(Name -> IO ()
ensureJournalFileExists (Name -> IO ()) -> IO Name -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ([Name] -> Name
forall a. [a] -> a
head ([Name] -> Name) -> IO [Name] -> IO Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CliOpts -> IO [Name]
journalFilePathFromOpts CliOpts
opts))
CliOpts -> (Journal -> IO ()) -> IO ()
forall a. CliOpts -> (Journal -> IO a) -> IO a
withJournalDo CliOpts
opts (CliOpts -> Journal -> IO ()
cmdaction CliOpts
opts)
Bool
_ -> CliOpts -> (Journal -> IO ()) -> IO ()
forall a. CliOpts -> (Journal -> IO a) -> IO a
withJournalDo CliOpts
opts (CliOpts -> Journal -> IO ()
cmdaction CliOpts
opts)
)
IO () -> Mode RawOpts -> IO ()
forall a. IO () -> Mode a -> IO ()
`orShowHelp` Mode RawOpts
cmdmode
| Bool
isExternalCommand = do
let externalargs :: [Name]
externalargs = [Name]
argsbeforecmd [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Name -> Bool) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==Name
"--")) [Name]
argsaftercmd
let shellcmd :: Name
shellcmd = Name -> Name -> Name -> Name -> Name
forall r. PrintfType r => Name -> r
printf Name
"%s-%s %s" Name
progname Name
cmd ([Name] -> Name
unwords' [Name]
externalargs) :: String
Name -> Name -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO Name
"external command selected" Name
cmd
Name -> [Name] -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO Name
"external command arguments" ((Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Name
quoteIfNeeded [Name]
externalargs)
Name -> Name -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO Name
"running shell command" Name
shellcmd
Name -> IO ExitCode
system Name
shellcmd IO ExitCode -> (ExitCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith
| Bool
otherwise = Name -> IO Any
forall a. Name -> a
usageError (Name
"could not understand the arguments "Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++[Name] -> Name
forall a. Show a => a -> Name
show [Name]
args) IO Any -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitFailure
IO ()
runHledgerCommand
argsToCliOpts :: [String] -> [String] -> IO CliOpts
argsToCliOpts :: [Name] -> [Name] -> IO CliOpts
argsToCliOpts [Name]
args [Name]
addons = do
let
args' :: [Name]
args' = [Name] -> [Name]
moveFlagsAfterCommand ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ [Name] -> [Name]
replaceNumericFlags [Name]
args
cmdargsopts :: RawOpts
cmdargsopts = (Name -> RawOpts)
-> (RawOpts -> RawOpts) -> Either Name RawOpts -> RawOpts
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Name -> RawOpts
forall a. Name -> a
usageError RawOpts -> RawOpts
forall a. a -> a
id (Either Name RawOpts -> RawOpts) -> Either Name RawOpts -> RawOpts
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> [Name] -> Either Name RawOpts
forall a. Mode a -> [Name] -> Either Name a
C.process ([Name] -> Mode RawOpts
mainmode [Name]
addons) [Name]
args'
RawOpts -> IO CliOpts
rawOptsToCliOpts RawOpts
cmdargsopts
moveFlagsAfterCommand :: [String] -> [String]
moveFlagsAfterCommand :: [Name] -> [Name]
moveFlagsAfterCommand [Name]
args = [Name] -> [Name]
moveArgs ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ [Name] -> [Name]
ensureDebugHasArg [Name]
args
where
ensureDebugHasArg :: [Name] -> [Name]
ensureDebugHasArg [Name]
as =
case (Name -> Bool) -> [Name] -> ([Name], [Name])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==Name
"--debug") [Name]
as of
([Name]
bs,Name
"--debug":Name
c:[Name]
cs) | Name -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Name
c Bool -> Bool -> Bool
|| Bool -> Bool
not ((Char -> Bool) -> Name -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit Name
c) -> [Name]
bs[Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++Name
"--debug=1"Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:Name
cName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
cs
([Name]
bs,Name
"--debug":[]) -> [Name]
bs[Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++Name
"--debug=1"Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[]
([Name], [Name])
_ -> [Name]
as
moveArgs :: [Name] -> [Name]
moveArgs [Name]
args = ([Name], [Name]) -> [Name]
forall a. ([a], [a]) -> [a]
insertFlagsAfterCommand (([Name], [Name]) -> [Name]) -> ([Name], [Name]) -> [Name]
forall a b. (a -> b) -> a -> b
$ ([Name], [Name]) -> ([Name], [Name])
moveArgs' ([Name]
args, [])
where
moveArgs' :: ([Name], [Name]) -> ([Name], [Name])
moveArgs' ((Name
f:Name
a:[Name]
as), [Name]
flags) | Name -> Bool
isMovableNoArgFlag Name
f = ([Name], [Name]) -> ([Name], [Name])
moveArgs' (Name
aName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
as, [Name]
flags [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name
f])
moveArgs' ((Name
f:Name
v:Name
a:[Name]
as), [Name]
flags) | Name -> Bool
isMovableReqArgFlag Name
f, Name -> Bool
isValue Name
v = ([Name], [Name]) -> ([Name], [Name])
moveArgs' (Name
aName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
as, [Name]
flags [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name
f,Name
v])
moveArgs' ((Name
fv:Name
a:[Name]
as), [Name]
flags) | Name -> Bool
isMovableReqArgFlagAndValue Name
fv = ([Name], [Name]) -> ([Name], [Name])
moveArgs' (Name
aName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
as, [Name]
flags [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name
fv])
moveArgs' ((Name
f:Name
a:[Name]
as), [Name]
flags) | Name -> Bool
isMovableReqArgFlag Name
f, Bool -> Bool
not (Name -> Bool
isValue Name
a) = ([Name], [Name]) -> ([Name], [Name])
moveArgs' (Name
aName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
as, [Name]
flags [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name
f])
moveArgs' ([Name]
as, [Name]
flags) = ([Name]
as, [Name]
flags)
insertFlagsAfterCommand :: ([a], [a]) -> [a]
insertFlagsAfterCommand ([], [a]
flags) = [a]
flags
insertFlagsAfterCommand (a
command:[a]
args, [a]
flags) = [a
command] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
flags [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
args
isMovableNoArgFlag :: Name -> Bool
isMovableNoArgFlag Name
a = Name
"-" Name -> Name -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Name
a Bool -> Bool -> Bool
&& (Char -> Bool) -> Name -> Name
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'-') Name
a Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
noargflagstomove
isMovableReqArgFlag :: Name -> Bool
isMovableReqArgFlag Name
a = Name
"-" Name -> Name -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Name
a Bool -> Bool -> Bool
&& (Char -> Bool) -> Name -> Name
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'-') Name
a Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
reqargflagstomove
isMovableReqArgFlagAndValue :: Name -> Bool
isMovableReqArgFlagAndValue (Char
'-':Char
'-':Char
a:Name
as) = case (Char -> Bool) -> Name -> (Name, Name)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') (Char
aChar -> Name -> Name
forall a. a -> [a] -> [a]
:Name
as) of (Char
f:Name
fs,Char
_:Name
_) -> (Char
fChar -> Name -> Name
forall a. a -> [a] -> [a]
:Name
fs) Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
reqargflagstomove
(Name, Name)
_ -> Bool
False
isMovableReqArgFlagAndValue (Char
'-':Char
shortflag:Char
_:Name
_) = [Char
shortflag] Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
reqargflagstomove
isMovableReqArgFlagAndValue Name
_ = Bool
False
isValue :: Name -> Bool
isValue Name
"-" = Bool
True
isValue (Char
'-':Name
_) = Bool
False
isValue Name
_ = Bool
True
flagstomove :: [Flag RawOpts]
flagstomove = [Flag RawOpts]
inputflags [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. [a] -> [a] -> [a]
++ [Flag RawOpts]
reportflags [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. [a] -> [a] -> [a]
++ [Flag RawOpts]
helpflags
noargflagstomove :: [Name]
noargflagstomove = (Flag RawOpts -> [Name]) -> [Flag RawOpts] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [Name]
forall a. Flag a -> [Name]
flagNames ([Flag RawOpts] -> [Name]) -> [Flag RawOpts] -> [Name]
forall a b. (a -> b) -> a -> b
$ (Flag RawOpts -> Bool) -> [Flag RawOpts] -> [Flag RawOpts]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FlagInfo -> FlagInfo -> Bool
forall a. Eq a => a -> a -> Bool
==FlagInfo
FlagNone)(FlagInfo -> Bool)
-> (Flag RawOpts -> FlagInfo) -> Flag RawOpts -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Flag RawOpts -> FlagInfo
forall a. Flag a -> FlagInfo
flagInfo) [Flag RawOpts]
flagstomove
reqargflagstomove :: [Name]
reqargflagstomove =
(Flag RawOpts -> [Name]) -> [Flag RawOpts] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [Name]
forall a. Flag a -> [Name]
flagNames ([Flag RawOpts] -> [Name]) -> [Flag RawOpts] -> [Name]
forall a b. (a -> b) -> a -> b
$ (Flag RawOpts -> Bool) -> [Flag RawOpts] -> [Flag RawOpts]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FlagInfo -> FlagInfo -> Bool
forall a. Eq a => a -> a -> Bool
==FlagInfo
FlagReq )(FlagInfo -> Bool)
-> (Flag RawOpts -> FlagInfo) -> Flag RawOpts -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Flag RawOpts -> FlagInfo
forall a. Flag a -> FlagInfo
flagInfo) [Flag RawOpts]
flagstomove