{-# LANGUAGE LambdaCase #-}
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
import Data.Time.Clock.POSIX (getPOSIXTime)
mainmode :: [String] -> Mode RawOpts
mainmode [String]
addons = Mode RawOpts
defMode {
modeNames :: [String]
modeNames = [String
progname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" [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
$ String -> Arg RawOpts
argsFlag String
"[ARGS]")
,modeHelp :: String
modeHelp = [String] -> String
unlines [String
"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] -> [(String, [a])] -> Group a
Group {
groupUnnamed :: [Mode RawOpts]
groupUnnamed = [
]
,groupNamed :: [(String, [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]
++ (String -> Mode RawOpts) -> [String] -> [Mode RawOpts]
forall a b. (a -> b) -> [a] -> [b]
map String -> Mode RawOpts
addonCommandMode [String]
addons
}
,modeGroupFlags :: Group (Flag RawOpts)
modeGroupFlags = Group :: forall a. [a] -> [a] -> [(String, [a])] -> Group a
Group {
groupNamed :: [(String, [Flag RawOpts])]
groupNamed = [
( String
"General input flags", [Flag RawOpts]
inputflags)
,(String
"\nGeneral reporting flags", [Flag RawOpts]
reportflags)
,(String
"\nGeneral help flags", [Flag RawOpts]
helpflags)
]
,groupUnnamed :: [Flag RawOpts]
groupUnnamed = []
,groupHidden :: [Flag RawOpts]
groupHidden =
[Flag RawOpts
detailedversionflag]
}
,modeHelpSuffix :: [String]
modeHelpSuffix = String
"Examples:" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
(String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
progname String -> String -> String
forall a. [a] -> [a] -> [a]
++) [
String
" list commands"
,String
" CMD [--] [OPTS] [ARGS] run a command (use -- with addon commands)"
,String
"-CMD [OPTS] [ARGS] or run addon commands directly"
,String
" -h show general usage"
,String
" CMD -h show command usage"
,String
" help [MANUAL] show any of the hledger manuals in various formats"
]
}
main :: IO ()
main :: IO ()
main = do
POSIXTime
progstarttime <- IO POSIXTime
getPOSIXTime
[String]
args <- IO [String]
getArgs IO [String] -> ([String] -> IO [String]) -> IO [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> IO [String]
expandArgsAt
let
args' :: [String]
args' = [String] -> [String]
moveFlagsAfterCommand ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
replaceNumericFlags [String]
args
isFlag :: String -> Bool
isFlag = (String
"-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)
isNonEmptyNonFlag :: String -> Bool
isNonEmptyNonFlag String
s = Bool -> Bool
not (String -> Bool
isFlag String
s) Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s)
rawcmd :: String
rawcmd = String -> [String] -> String
forall a. a -> [a] -> a
headDef String
"" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile String -> Bool
isNonEmptyNonFlag [String]
args'
isNullCommand :: Bool
isNullCommand = String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rawcmd
([String]
argsbeforecmd, [String]
argsaftercmd') = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
rawcmd) [String]
args
argsaftercmd :: [String]
argsaftercmd = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
argsaftercmd'
dbgIO :: Show a => String -> a -> IO ()
dbgIO :: forall a. Show a => String -> a -> IO ()
dbgIO = Int -> String -> a -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO Int
8
String -> String -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"running" String
prognameandversion
String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"raw args" [String]
args
String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"raw args rearranged for cmdargs" [String]
args'
String -> String -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"raw command is probably" String
rawcmd
String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"raw args before command" [String]
argsbeforecmd
String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"raw args after command" [String]
argsaftercmd
[String]
addons' <- IO [String]
hledgerAddons
let addons :: [String]
addons = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
builtinCommandNames) (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dropExtension) [String]
addons'
CliOpts
opts' <- [String] -> [String] -> IO CliOpts
argsToCliOpts [String]
args [String]
addons
let opts :: CliOpts
opts = CliOpts
opts'{progstarttime_ :: POSIXTime
progstarttime_=POSIXTime
progstarttime}
let
cmd :: String
cmd = CliOpts -> String
command_ CliOpts
opts
isInternalCommand :: Bool
isInternalCommand = String
cmd String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
builtinCommandNames
isExternalCommand :: Bool
isExternalCommand = Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cmd) Bool -> Bool -> Bool
&& String
cmd String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
addons
isBadCommand :: Bool
isBadCommand = Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rawcmd) Bool -> Bool -> Bool
&& String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cmd
hasVersion :: [String] -> Bool
hasVersion = (String
"--version" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`)
printUsage :: IO ()
printUsage = String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> String
forall a. Mode a -> String
showModeUsage (Mode RawOpts -> String) -> Mode RawOpts -> String
forall a b. (a -> b) -> a -> b
$ [String] -> Mode RawOpts
mainmode [String]
addons
badCommandError :: IO b
badCommandError = String -> IO Any
forall a. String -> a
error' (String
"command "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
rawcmdString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" 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 String -> Bool
hasHelpFlag t String
args = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> t String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t String
args) [String
"-h",String
"--help"]
hasManFlag :: t String -> Bool
hasManFlag t String
args = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> t String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t String
args) [String
"--man"]
hasInfoFlag :: t String -> Bool
hasInfoFlag t String
args = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> t String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t String
args) [String
"--info"]
IO ()
f orShowHelp :: IO () -> Mode a -> IO ()
`orShowHelp` Mode a
mode
| [String] -> Bool
forall {t :: * -> *}. Foldable t => t String -> Bool
hasHelpFlag [String]
args = String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Mode a -> String
forall a. Mode a -> String
showModeUsage Mode a
mode
| [String] -> Bool
forall {t :: * -> *}. Foldable t => t String -> Bool
hasInfoFlag [String]
args = String -> Maybe String -> IO ()
runInfoForTopic String
"hledger" ([String] -> Maybe String
forall a. [a] -> Maybe a
headMay ([String] -> Maybe String) -> [String] -> Maybe String
forall a b. (a -> b) -> a -> b
$ Mode a -> [String]
forall a. Mode a -> [String]
modeNames Mode a
mode)
| [String] -> Bool
forall {t :: * -> *}. Foldable t => t String -> Bool
hasManFlag [String]
args = String -> Maybe String -> IO ()
runManForTopic String
"hledger" ([String] -> Maybe String
forall a. [a] -> Maybe a
headMay ([String] -> Maybe String) -> [String] -> Maybe String
forall a b. (a -> b) -> a -> b
$ Mode a -> [String]
forall a. Mode a -> [String]
modeNames Mode a
mode)
| Bool
otherwise = IO ()
f
String -> CliOpts -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"processed opts" CliOpts
opts
String -> String -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"command matched" String
cmd
String -> Bool -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"isNullCommand" Bool
isNullCommand
String -> Bool -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"isInternalCommand" Bool
isInternalCommand
String -> Bool -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"isExternalCommand" Bool
isExternalCommand
String -> Bool -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"isBadCommand" Bool
isBadCommand
String -> Period -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"period from opts" (ReportOpts -> Period
period_ (ReportOpts -> Period)
-> (ReportSpec -> ReportOpts) -> ReportSpec -> Period
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportSpec -> ReportOpts
_rsReportOpts (ReportSpec -> Period) -> ReportSpec -> Period
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
opts)
String -> Interval -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"interval from opts" (ReportOpts -> Interval
interval_ (ReportOpts -> Interval)
-> (ReportSpec -> ReportOpts) -> ReportSpec -> Interval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportSpec -> ReportOpts
_rsReportOpts (ReportSpec -> Interval) -> ReportSpec -> Interval
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
opts)
String -> Query -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"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 = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
cmdString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" tried to read the journal but is not supposed to"
runHledgerCommand :: IO ()
runHledgerCommand
| Bool
isNullCommand Bool -> Bool -> Bool
&& [String] -> Bool
forall {t :: * -> *}. Foldable t => t String -> Bool
hasHelpFlag [String]
args = String -> String -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"" String
"-h/--help with no command, showing general help" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
printUsage
| Bool
isNullCommand Bool -> Bool -> Bool
&& [String] -> Bool
forall {t :: * -> *}. Foldable t => t String -> Bool
hasInfoFlag [String]
args = String -> String -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"" String
"--info with no command, showing general info manual" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Maybe String -> IO ()
runInfoForTopic String
"hledger" Maybe String
forall a. Maybe a
Nothing
| Bool
isNullCommand Bool -> Bool -> Bool
&& [String] -> Bool
forall {t :: * -> *}. Foldable t => t String -> Bool
hasManFlag [String]
args = String -> String -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"" String
"--man with no command, showing general man page" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Maybe String -> IO ()
runManForTopic String
"hledger" Maybe String
forall a. Maybe a
Nothing
| Bool -> Bool
not (Bool
isExternalCommand Bool -> Bool -> Bool
|| [String] -> Bool
forall {t :: * -> *}. Foldable t => t String -> Bool
hasHelpFlag [String]
args Bool -> Bool -> Bool
|| [String] -> Bool
forall {t :: * -> *}. Foldable t => t String -> Bool
hasInfoFlag [String]
args Bool -> Bool -> Bool
|| [String] -> Bool
forall {t :: * -> *}. Foldable t => t String -> Bool
hasManFlag [String]
args)
Bool -> Bool -> Bool
&& ([String] -> Bool
hasVersion [String]
args)
= String -> IO ()
putStrLn String
prognameandversion
| Bool
isNullCommand = String -> String -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"" String
"no command, showing commands list" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> [String] -> IO ()
printCommandsList String
prognameandversion [String]
addons
| Bool
isBadCommand = IO ()
forall a. IO a
badCommandError
| Just (Mode RawOpts
cmdmode, CliOpts -> Journal -> IO ()
cmdaction) <- String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findCommand String
cmd =
(case Bool
True of
Bool
_ | String
cmd String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"test",String
"help"] -> CliOpts -> Journal -> IO ()
cmdaction CliOpts
opts Journal
forall {a}. a
journallesserror
Bool
_ | String
cmd String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"add",String
"import"] -> do
String -> IO ()
ensureJournalFileExists (String -> IO ()) -> ([String] -> String) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. [a] -> a
head ([String] -> IO ()) -> IO [String] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CliOpts -> IO [String]
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 :: [String]
externalargs = [String]
argsbeforecmd [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=String
"--") [String]
argsaftercmd
let shellcmd :: String
shellcmd = String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s-%s %s" String
progname String
cmd ([String] -> String
unwords' [String]
externalargs) :: String
String -> String -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"external command selected" String
cmd
String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"external command arguments" ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
quoteIfNeeded [String]
externalargs)
String -> String -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"running shell command" String
shellcmd
String -> IO ExitCode
system String
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 = String -> IO Any
forall a. String -> a
usageError (String
"could not understand the arguments "String -> String -> String
forall a. [a] -> [a] -> [a]
++[String] -> String
forall a. Show a => a -> String
show [String]
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 :: [String] -> [String] -> IO CliOpts
argsToCliOpts [String]
args [String]
addons = do
let
args' :: [String]
args' = [String] -> [String]
moveFlagsAfterCommand ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
replaceNumericFlags [String]
args
cmdargsopts :: RawOpts
cmdargsopts = (String -> RawOpts)
-> (RawOpts -> RawOpts) -> Either String RawOpts -> RawOpts
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> RawOpts
forall a. String -> a
usageError RawOpts -> RawOpts
forall a. a -> a
id (Either String RawOpts -> RawOpts)
-> Either String RawOpts -> RawOpts
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> [String] -> Either String RawOpts
forall a. Mode a -> [String] -> Either String a
C.process ([String] -> Mode RawOpts
mainmode [String]
addons) [String]
args'
RawOpts -> IO CliOpts
rawOptsToCliOpts RawOpts
cmdargsopts
moveFlagsAfterCommand :: [String] -> [String]
moveFlagsAfterCommand :: [String] -> [String]
moveFlagsAfterCommand [String]
args = [String] -> [String]
moveArgs ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
ensureDebugHasArg [String]
args
where
ensureDebugHasArg :: [String] -> [String]
ensureDebugHasArg [String]
as =
case (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"--debug") [String]
as of
([String]
bs,String
"--debug":String
c:[String]
cs) | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
c Bool -> Bool -> Bool
|| Bool -> Bool
not ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
c) -> [String]
bs[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++String
"--debug=1"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
cString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
cs
([String]
bs,[String
"--debug"]) -> [String]
bs[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String
"--debug=1"]
([String], [String])
_ -> [String]
as
moveArgs :: [String] -> [String]
moveArgs [String]
args = ([String], [String]) -> [String]
forall {a}. ([a], [a]) -> [a]
insertFlagsAfterCommand (([String], [String]) -> [String])
-> ([String], [String]) -> [String]
forall a b. (a -> b) -> a -> b
$ ([String], [String]) -> ([String], [String])
moveArgs' ([String]
args, [])
where
moveArgs' :: ([String], [String]) -> ([String], [String])
moveArgs' ((String
f:String
v:String
a:[String]
as), [String]
flags) | String -> Bool
isMovableReqArgFlag String
f, String -> Bool
isValue String
v = ([String], [String]) -> ([String], [String])
moveArgs' (String
aString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
as, [String]
flags [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
f,String
v])
moveArgs' ((String
fv:String
a:[String]
as), [String]
flags) | String -> Bool
isMovableArgFlagAndValue String
fv = ([String], [String]) -> ([String], [String])
moveArgs' (String
aString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
as, [String]
flags [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
fv])
moveArgs' ((String
f:String
a:[String]
as), [String]
flags) | String -> Bool
isMovableReqArgFlag String
f, Bool -> Bool
not (String -> Bool
isValue String
a) = ([String], [String]) -> ([String], [String])
moveArgs' (String
aString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
as, [String]
flags [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
f])
moveArgs' ((String
f:String
a:[String]
as), [String]
flags) | String -> Bool
isMovableNoArgFlag String
f = ([String], [String]) -> ([String], [String])
moveArgs' (String
aString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
as, [String]
flags [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
f])
moveArgs' ([String]
as, [String]
flags) = ([String]
as, [String]
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 :: String -> Bool
isMovableNoArgFlag String
a = String
"-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
a Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'-') String
a String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
optargflagstomove [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
noargflagstomove
isMovableReqArgFlag :: String -> Bool
isMovableReqArgFlag String
a = String
"-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
a Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'-') String
a String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
reqargflagstomove
isMovableArgFlagAndValue :: String -> Bool
isMovableArgFlagAndValue (Char
'-':Char
'-':Char
a:String
as) = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') (Char
aChar -> String -> String
forall a. a -> [a] -> [a]
:String
as) of
(Char
f:String
fs,Char
_:String
_) -> (Char
fChar -> String -> String
forall a. a -> [a] -> [a]
:String
fs) String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
optargflagstomove [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
reqargflagstomove
(String, String)
_ -> Bool
False
isMovableArgFlagAndValue (Char
'-':Char
shortflag:Char
_:String
_) = [Char
shortflag] String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
reqargflagstomove
isMovableArgFlagAndValue String
_ = Bool
False
isValue :: String -> Bool
isValue String
"-" = Bool
True
isValue (Char
'-':String
_) = Bool
False
isValue String
_ = 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 :: [String]
noargflagstomove = (Flag RawOpts -> [String]) -> [Flag RawOpts] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [String]
forall a. Flag a -> [String]
flagNames ([Flag RawOpts] -> [String]) -> [Flag RawOpts] -> [String]
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 :: [String]
reqargflagstomove =
(Flag RawOpts -> [String]) -> [Flag RawOpts] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [String]
forall a. Flag a -> [String]
flagNames ([Flag RawOpts] -> [String]) -> [Flag RawOpts] -> [String]
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
optargflagstomove :: [String]
optargflagstomove = (Flag RawOpts -> [String]) -> [Flag RawOpts] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [String]
forall a. Flag a -> [String]
flagNames ([Flag RawOpts] -> [String]) -> [Flag RawOpts] -> [String]
forall a b. (a -> b) -> a -> b
$ (Flag RawOpts -> Bool) -> [Flag RawOpts] -> [Flag RawOpts]
forall a. (a -> Bool) -> [a] -> [a]
filter (FlagInfo -> Bool
isFlagOpt (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
where
isFlagOpt :: FlagInfo -> Bool
isFlagOpt = \case
FlagOpt String
_ -> Bool
True
FlagOptRare String
_ -> Bool
True
FlagInfo
_ -> Bool
False