{-# 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 qualified Data.List.NonEmpty as NE
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 :: [Char]
prognameandversion = [Char] -> [Char] -> [Char]
versionString [Char]
progname [Char]
packageversion
versionString :: ProgramName -> PackageVersion -> String
versionString :: [Char] -> [Char] -> [Char]
versionString = Either [Char] GitInfo -> [Char] -> [Char] -> [Char]
versionStringWith $$[Char]
[Char] -> Either [Char] GitInfo
forall a b. a -> Either a b
tGitInfoCwdTry
mainmode :: [[Char]] -> Mode RawOpts
mainmode [[Char]]
addons = Mode RawOpts
defMode {
modeNames = [progname ++ " [CMD]"]
,modeArgs = ([], Just $ argsFlag "[ARGS]")
,modeHelp = unlines ["hledger's main command line interface. Runs builtin commands and other hledger executables. Type \"hledger\" to list available commands."]
,modeGroupModes = Group {
groupUnnamed = [
]
,groupNamed = [
]
,groupHidden = map fst builtinCommands ++ map addonCommandMode addons
}
,modeGroupFlags = Group {
groupNamed = [
( "General input flags", inputflags)
,("\nGeneral reporting flags", reportflags)
,("\nGeneral help flags", helpflags)
]
,groupUnnamed = []
,groupHidden =
[detailedversionflag]
}
,modeHelpSuffix = "Examples:" :
map (progname ++) [
" list commands"
," CMD [--] [OPTS] [ARGS] run a command (use -- with addon commands)"
,"-CMD [OPTS] [ARGS] or run addon commands directly"
," -h show general usage"
," CMD -h show command usage"
," 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
[[Char]]
args <- IO [[Char]]
getArgs IO [[Char]] -> ([[Char]] -> IO [[Char]]) -> IO [[Char]]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [[Char]] -> IO [[Char]]
expandArgsAt
let
args' :: [[Char]]
args' = [[Char]] -> [[Char]]
moveFlagsAfterCommand ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
replaceNumericFlags [[Char]]
args
isFlag :: [Char] -> Bool
isFlag = ([Char]
"-" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)
isNonEmptyNonFlag :: [Char] -> Bool
isNonEmptyNonFlag [Char]
s = Bool -> Bool
not ([Char] -> Bool
isFlag [Char]
s) Bool -> Bool -> Bool
&& Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
s)
rawcmd :: [Char]
rawcmd = [Char] -> [[Char]] -> [Char]
forall a. a -> [a] -> a
headDef [Char]
"" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile [Char] -> Bool
isNonEmptyNonFlag [[Char]]
args'
isNullCommand :: Bool
isNullCommand = [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
rawcmd
([[Char]]
argsbeforecmd, [[Char]]
argsaftercmd') = ([Char] -> Bool) -> [[Char]] -> ([[Char]], [[Char]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
==[Char]
rawcmd) [[Char]]
args
argsaftercmd :: [[Char]]
argsaftercmd = Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
drop Int
1 [[Char]]
argsaftercmd'
dbgIO :: Show a => String -> a -> IO ()
dbgIO :: forall a. Show a => [Char] -> a -> IO ()
dbgIO = Int -> [Char] -> a -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> [Char] -> a -> m ()
ptraceAtIO Int
8
[Char] -> [Char] -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"running" [Char]
prognameandversion
[Char] -> [[Char]] -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"raw args" [[Char]]
args
[Char] -> [[Char]] -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"raw args rearranged for cmdargs" [[Char]]
args'
[Char] -> [Char] -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"raw command is probably" [Char]
rawcmd
[Char] -> [[Char]] -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"raw args before command" [[Char]]
argsbeforecmd
[Char] -> [[Char]] -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"raw args after command" [[Char]]
argsaftercmd
[[Char]]
addons' <- IO [[Char]]
hledgerAddons
let addons :: [[Char]]
addons = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
builtinCommandNames) ([Char] -> Bool) -> ([Char] -> [Char]) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
dropExtension) [[Char]]
addons'
CliOpts
opts' <- [[Char]] -> [[Char]] -> IO CliOpts
argsToCliOpts [[Char]]
args [[Char]]
addons
let opts :: CliOpts
opts = CliOpts
opts'{progstarttime_=starttime}
let
cmd :: [Char]
cmd = CliOpts -> [Char]
command_ CliOpts
opts
isInternalCommand :: Bool
isInternalCommand = [Char]
cmd [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
builtinCommandNames
isExternalCommand :: Bool
isExternalCommand = Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
cmd) Bool -> Bool -> Bool
&& [Char]
cmd [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
addons
isBadCommand :: Bool
isBadCommand = Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
rawcmd) Bool -> Bool -> Bool
&& [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
cmd
hasVersion :: [[Char]] -> Bool
hasVersion = ([Char]
"--version" [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`)
printUsage :: IO ()
printUsage = [Char] -> IO ()
pager ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> [Char]
forall a. Mode a -> [Char]
showModeUsage (Mode RawOpts -> [Char]) -> Mode RawOpts -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> Mode RawOpts
mainmode [[Char]]
addons
badCommandError :: IO b
badCommandError = [Char] -> IO Any
forall a. [Char] -> a
error' ([Char]
"command "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
rawcmd[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" is not recognized, run with no command to see a list") IO Any -> IO b -> IO b
forall a b. IO a -> 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 [Char] -> Bool
hasHelpFlag t [Char]
args1 = ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([Char] -> t [Char] -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t [Char]
args1) [[Char]
"-h",[Char]
"--help"]
hasManFlag :: t [Char] -> Bool
hasManFlag t [Char]
args1 = ([Char] -> t [Char] -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t [Char]
args1) [Char]
"--man"
hasInfoFlag :: t [Char] -> Bool
hasInfoFlag t [Char]
args1 = ([Char] -> t [Char] -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t [Char]
args1) [Char]
"--info"
IO ()
f orShowHelp :: IO () -> Mode a -> IO ()
`orShowHelp` Mode a
mode1
| [[Char]] -> Bool
forall {t :: * -> *}. Foldable t => t [Char] -> Bool
hasHelpFlag [[Char]]
args = [Char] -> IO ()
pager ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Mode a -> [Char]
forall a. Mode a -> [Char]
showModeUsage Mode a
mode1
| [[Char]] -> Bool
forall {t :: * -> *}. Foldable t => t [Char] -> Bool
hasInfoFlag [[Char]]
args = [Char] -> Maybe [Char] -> IO ()
runInfoForTopic [Char]
"hledger" ([[Char]] -> Maybe [Char]
forall a. [a] -> Maybe a
headMay ([[Char]] -> Maybe [Char]) -> [[Char]] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Mode a -> [[Char]]
forall a. Mode a -> [[Char]]
modeNames Mode a
mode1)
| [[Char]] -> Bool
forall {t :: * -> *}. Foldable t => t [Char] -> Bool
hasManFlag [[Char]]
args = [Char] -> Maybe [Char] -> IO ()
runManForTopic [Char]
"hledger" ([[Char]] -> Maybe [Char]
forall a. [a] -> Maybe a
headMay ([[Char]] -> Maybe [Char]) -> [[Char]] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Mode a -> [[Char]]
forall a. Mode a -> [[Char]]
modeNames Mode a
mode1)
| Bool
otherwise = IO ()
f
[Char] -> CliOpts -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"processed opts" CliOpts
opts
[Char] -> [Char] -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"command matched" [Char]
cmd
[Char] -> Bool -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"isNullCommand" Bool
isNullCommand
[Char] -> Bool -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"isInternalCommand" Bool
isInternalCommand
[Char] -> Bool -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"isExternalCommand" Bool
isExternalCommand
[Char] -> Bool -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"isBadCommand" Bool
isBadCommand
[Char] -> Period -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"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)
[Char] -> Interval -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"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)
[Char] -> Query -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"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 = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
cmd[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" tried to read the journal but is not supposed to"
runHledgerCommand :: IO ()
runHledgerCommand
| Bool
isNullCommand Bool -> Bool -> Bool
&& [[Char]] -> Bool
forall {t :: * -> *}. Foldable t => t [Char] -> Bool
hasHelpFlag [[Char]]
args = [Char] -> [Char] -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"" [Char]
"-h/--help with no command, showing general help" IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
printUsage
| Bool
isNullCommand Bool -> Bool -> Bool
&& [[Char]] -> Bool
forall {t :: * -> *}. Foldable t => t [Char] -> Bool
hasInfoFlag [[Char]]
args = [Char] -> [Char] -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"" [Char]
"--info with no command, showing general info manual" IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Maybe [Char] -> IO ()
runInfoForTopic [Char]
"hledger" Maybe [Char]
forall a. Maybe a
Nothing
| Bool
isNullCommand Bool -> Bool -> Bool
&& [[Char]] -> Bool
forall {t :: * -> *}. Foldable t => t [Char] -> Bool
hasManFlag [[Char]]
args = [Char] -> [Char] -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"" [Char]
"--man with no command, showing general man page" IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Maybe [Char] -> IO ()
runManForTopic [Char]
"hledger" Maybe [Char]
forall a. Maybe a
Nothing
| Bool -> Bool
not (Bool
isExternalCommand Bool -> Bool -> Bool
|| [[Char]] -> Bool
forall {t :: * -> *}. Foldable t => t [Char] -> Bool
hasHelpFlag [[Char]]
args Bool -> Bool -> Bool
|| [[Char]] -> Bool
forall {t :: * -> *}. Foldable t => t [Char] -> Bool
hasInfoFlag [[Char]]
args Bool -> Bool -> Bool
|| [[Char]] -> Bool
forall {t :: * -> *}. Foldable t => t [Char] -> Bool
hasManFlag [[Char]]
args)
Bool -> Bool -> Bool
&& ([[Char]] -> Bool
hasVersion [[Char]]
args)
= [Char] -> IO ()
putStrLn [Char]
prognameandversion
| Bool
isNullCommand = [Char] -> [Char] -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"" [Char]
"no command, showing commands list" IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> [[Char]] -> IO ()
printCommandsList [Char]
prognameandversion [[Char]]
addons
| Bool
isBadCommand = IO ()
forall a. IO a
badCommandError
| Just (Mode RawOpts
cmdmode, CliOpts -> Journal -> IO ()
cmdaction) <- [Char] -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findBuiltinCommand [Char]
cmd =
(case Bool
True of
Bool
_ | [Char]
cmd [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"demo",[Char]
"help",[Char]
"test"] -> CliOpts -> Journal -> IO ()
cmdaction CliOpts
opts Journal
forall {a}. a
journallesserror
Bool
_ | [Char]
cmd [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"add",[Char]
"import"] -> do
[Char] -> IO ()
ensureJournalFileExists ([Char] -> IO ())
-> (NonEmpty [Char] -> [Char]) -> NonEmpty [Char] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty [Char] -> [Char]
forall a. NonEmpty a -> a
NE.head (NonEmpty [Char] -> IO ()) -> IO (NonEmpty [Char]) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CliOpts -> IO (NonEmpty [Char])
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 :: [[Char]]
externalargs = [[Char]]
argsbeforecmd [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/=[Char]
"--") [[Char]]
argsaftercmd
let shellcmd :: [Char]
shellcmd = [Char] -> [Char] -> [Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%s-%s %s" [Char]
progname [Char]
cmd ([[Char]] -> [Char]
unwords' [[Char]]
externalargs) :: String
[Char] -> [Char] -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"external command selected" [Char]
cmd
[Char] -> [[Char]] -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"external command arguments" (([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
quoteIfNeeded [[Char]]
externalargs)
[Char] -> [Char] -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"running shell command" [Char]
shellcmd
[Char] -> IO ExitCode
system [Char]
shellcmd IO ExitCode -> (ExitCode -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith
| Bool
otherwise = [Char] -> IO Any
forall a. [Char] -> a
usageError ([Char]
"could not understand the arguments "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
args) IO Any -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
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 :: [[Char]] -> [[Char]] -> IO CliOpts
argsToCliOpts [[Char]]
args [[Char]]
addons = do
let
args' :: [[Char]]
args' = [[Char]] -> [[Char]]
moveFlagsAfterCommand ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
replaceNumericFlags [[Char]]
args
cmdargsopts :: RawOpts
cmdargsopts = ([Char] -> RawOpts)
-> (RawOpts -> RawOpts) -> Either [Char] RawOpts -> RawOpts
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> RawOpts
forall a. [Char] -> a
usageError RawOpts -> RawOpts
forall a. a -> a
id (Either [Char] RawOpts -> RawOpts)
-> Either [Char] RawOpts -> RawOpts
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> [[Char]] -> Either [Char] RawOpts
forall a. Mode a -> [[Char]] -> Either [Char] a
C.process ([[Char]] -> Mode RawOpts
mainmode [[Char]]
addons) [[Char]]
args'
RawOpts -> IO CliOpts
rawOptsToCliOpts RawOpts
cmdargsopts
moveFlagsAfterCommand :: [String] -> [String]
moveFlagsAfterCommand :: [[Char]] -> [[Char]]
moveFlagsAfterCommand [[Char]]
args = [[Char]] -> [[Char]]
moveArgs ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
forall {t :: * -> *}.
(Eq (t Char), IsString (t Char), Foldable t) =>
[t Char] -> [t Char]
ensureDebugHasArg [[Char]]
args
where
moveArgs :: [[Char]] -> [[Char]]
moveArgs [[Char]]
args1 = ([[Char]], [[Char]]) -> [[Char]]
forall {a}. ([a], [a]) -> [a]
insertFlagsAfterCommand (([[Char]], [[Char]]) -> [[Char]])
-> ([[Char]], [[Char]]) -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ([[Char]], [[Char]]) -> ([[Char]], [[Char]])
moveArgs' ([[Char]]
args1, [])
where
moveArgs' :: ([[Char]], [[Char]]) -> ([[Char]], [[Char]])
moveArgs' (([Char]
f:[Char]
v:[Char]
a:[[Char]]
as), [[Char]]
flags) | [Char] -> Bool
isMovableReqArgFlag [Char]
f, [Char] -> Bool
isValue [Char]
v = ([[Char]], [[Char]]) -> ([[Char]], [[Char]])
moveArgs' ([Char]
a[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
as, [[Char]]
flags [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
f,[Char]
v])
moveArgs' (([Char]
fv:[Char]
a:[[Char]]
as), [[Char]]
flags) | [Char] -> Bool
isMovableArgFlagAndValue [Char]
fv = ([[Char]], [[Char]]) -> ([[Char]], [[Char]])
moveArgs' ([Char]
a[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
as, [[Char]]
flags [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
fv])
moveArgs' (([Char]
f:[Char]
a:[[Char]]
as), [[Char]]
flags) | [Char] -> Bool
isMovableReqArgFlag [Char]
f, Bool -> Bool
not ([Char] -> Bool
isValue [Char]
a) = ([[Char]], [[Char]]) -> ([[Char]], [[Char]])
moveArgs' ([Char]
a[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
as, [[Char]]
flags [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
f])
moveArgs' (([Char]
f:[Char]
a:[[Char]]
as), [[Char]]
flags) | [Char] -> Bool
isMovableNoArgFlag [Char]
f = ([[Char]], [[Char]]) -> ([[Char]], [[Char]])
moveArgs' ([Char]
a[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
as, [[Char]]
flags [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
f])
moveArgs' ([[Char]]
as, [[Char]]
flags) = ([[Char]]
as, [[Char]]
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 :: [Char] -> Bool
isMovableNoArgFlag [Char]
a = [Char]
"-" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
a Bool -> Bool -> Bool
&& (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'-') [Char]
a [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
optargflagstomove [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
noargflagstomove
isMovableReqArgFlag :: [Char] -> Bool
isMovableReqArgFlag [Char]
a = [Char]
"-" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
a Bool -> Bool -> Bool
&& (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'-') [Char]
a [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
reqargflagstomove
isMovableArgFlagAndValue :: [Char] -> Bool
isMovableArgFlagAndValue (Char
'-':Char
'-':Char
a:[Char]
as) = case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') (Char
aChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
as) of
(Char
f:[Char]
fs,Char
_:[Char]
_) -> (Char
fChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
fs) [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
optargflagstomove [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
reqargflagstomove
([Char], [Char])
_ -> Bool
False
isMovableArgFlagAndValue (Char
'-':Char
shortflag:Char
_:[Char]
_) = [Char
shortflag] [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
reqargflagstomove
isMovableArgFlagAndValue [Char]
_ = Bool
False
isValue :: [Char] -> Bool
isValue [Char]
"-" = Bool
True
isValue (Char
'-':[Char]
_) = Bool
False
isValue [Char]
_ = 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 :: [[Char]]
noargflagstomove = (Flag RawOpts -> [[Char]]) -> [Flag RawOpts] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [[Char]]
forall a. Flag a -> [[Char]]
flagNames ([Flag RawOpts] -> [[Char]]) -> [Flag RawOpts] -> [[Char]]
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 :: [[Char]]
reqargflagstomove =
(Flag RawOpts -> [[Char]]) -> [Flag RawOpts] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [[Char]]
forall a. Flag a -> [[Char]]
flagNames ([Flag RawOpts] -> [[Char]]) -> [Flag RawOpts] -> [[Char]]
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 :: [[Char]]
optargflagstomove = (Flag RawOpts -> [[Char]]) -> [Flag RawOpts] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [[Char]]
forall a. Flag a -> [[Char]]
flagNames ([Flag RawOpts] -> [[Char]]) -> [Flag RawOpts] -> [[Char]]
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 [Char]
_ -> Bool
True
FlagOptRare [Char]
_ -> Bool
True
FlagInfo
_ -> Bool
False