{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Unused LANGUAGE pragma" #-}
module Hledger.Cli (
prognameandversion,
versionString,
main,
mainmode,
argsToCliOpts,
module Hledger.Cli.CliOptions,
module Hledger.Cli.Commands,
module Hledger.Cli.DocFiles,
module Hledger.Cli.Utils,
module Hledger.Cli.Version,
module Hledger,
module System.Console.CmdArgs.Explicit,
)
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)
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Commands
import Hledger.Cli.DocFiles
import Hledger.Cli.Utils
import Hledger.Cli.Version
prognameandversion :: String
prognameandversion :: String
prognameandversion = String -> String -> String
versionString String
progname String
packageversion
versionString :: ProgramName -> PackageVersion -> String
versionString :: String -> String -> String
versionString = Either String GitInfo -> String -> String -> String
versionStringWith String
String -> Either String GitInfo
forall a b. a -> Either a b
$$tGitInfoCwdTry
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
starttime <- IO POSIXTime
getPOSIXTime
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
useColorOnStdout IO ()
setupPager
[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 :: 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
starttime}
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 ()
pager (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
args1 = (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
args1) [String
"-h",String
"--help"]
hasManFlag :: t String -> Bool
hasManFlag t String
args1 = (String -> t String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t String
args1) String
"--man"
hasInfoFlag :: t String -> Bool
hasInfoFlag t String
args1 = (String -> t String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t String
args1) String
"--info"
IO ()
f orShowHelp :: IO () -> Mode a -> IO ()
`orShowHelp` Mode a
mode1
| [String] -> Bool
forall (t :: * -> *). Foldable t => t String -> Bool
hasHelpFlag [String]
args = String -> IO ()
pager (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Mode a -> String
forall a. Mode a -> String
showModeUsage Mode a
mode1
| [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
mode1)
| [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
mode1)
| 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 ())
findBuiltinCommand 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
"demo",String
"help",String
"test"] -> 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]
forall (t :: * -> *).
(Eq (t Char), IsString (t Char), Foldable t) =>
[t Char] -> [t Char]
ensureDebugHasArg [String]
args
where
moveArgs :: [String] -> [String]
moveArgs [String]
args1 = ([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]
args1, [])
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
command1:[a]
args2, [a]
flags) = [a
command1] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
flags [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
args2
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