{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Unused LANGUAGE pragma" #-}
module Hledger.Cli (
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 Data.Time.Clock.POSIX (getPOSIXTime)
import Safe
import System.Console.CmdArgs.Explicit hiding (Name)
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
import Hledger.Cli.CliOptions
import Hledger.Cli.Commands
import Hledger.Cli.DocFiles
import Hledger.Cli.Utils
import Hledger.Cli.Version
mainmode :: [[Char]] -> Mode RawOpts
mainmode [[Char]]
addons = Mode RawOpts
defMode {
modeNames = [progname ++ " [COMMAND]"]
,modeArgs = ([], Just $ argsFlag "[ARGS]")
,modeHelp = unlines ["hledger's main command line interface. Run with no ARGS to list commands."]
,modeGroupModes = Group {
groupUnnamed = [
]
,groupNamed = [
]
,groupHidden = map fst builtinCommands ++ map addonCommandMode addons
}
,modeGroupFlags = Group {
groupNamed = cligeneralflagsgroups1
,groupUnnamed = []
,groupHidden =
[detailedversionflag]
}
,modeHelpSuffix = []
}
main :: IO ()
main :: IO ()
main = IO () -> IO ()
forall {a}. a -> a
withGhcDebug' (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GhcDebugMode
ghcDebugMode GhcDebugMode -> GhcDebugMode -> Bool
forall a. Eq a => a -> a -> Bool
== GhcDebugMode
GDPauseAtStart) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO ()
ghcDebugPause'
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
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 ([[Char]] -> Mode RawOpts
mainmode [[Char]]
addons) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
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
helpFlag :: Bool
helpFlag = [Char] -> RawOpts -> Bool
boolopt [Char]
"help" (RawOpts -> Bool) -> RawOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts
tldrFlag :: Bool
tldrFlag = [Char] -> RawOpts -> Bool
boolopt [Char]
"tldr" (RawOpts -> Bool) -> RawOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts
infoFlag :: Bool
infoFlag = [Char] -> RawOpts -> Bool
boolopt [Char]
"info" (RawOpts -> Bool) -> RawOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts
manFlag :: Bool
manFlag = [Char] -> RawOpts -> Bool
boolopt [Char]
"man" (RawOpts -> Bool) -> RawOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts
versionFlag :: Bool
versionFlag = [Char] -> RawOpts -> Bool
boolopt [Char]
"version" (RawOpts -> Bool) -> RawOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts
IO ()
f orShowHelp :: IO () -> Mode a -> IO ()
`orShowHelp` Mode a
mode1
| Bool
helpFlag = [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] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
| Bool
tldrFlag = [Char] -> IO ()
runTldrForPage ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ([Char] -> [Char]) -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"hledger" (([Char]
"hledger-"[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>)) (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[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
infoFlag = [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)
| Bool
manFlag = [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
runHledgerCommand :: IO ()
runHledgerCommand
| Bool
isNullCommand Bool -> Bool -> Bool
&& Bool
helpFlag = [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
&& Bool
tldrFlag = [Char] -> [Char] -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"" [Char]
"--tldr with no command, showing general tldr 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] -> IO ()
runTldrForPage [Char]
"hledger"
| Bool
isNullCommand Bool -> Bool -> Bool
&& Bool
infoFlag = [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
&& Bool
manFlag = [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
versionFlag Bool -> Bool -> Bool
&& Bool -> Bool
not (Bool
isExternalCommand Bool -> Bool -> Bool
|| Bool
helpFlag Bool -> Bool -> Bool
|| Bool
tldrFlag Bool -> Bool -> Bool
|| Bool
infoFlag Bool -> Bool -> Bool
|| Bool
manFlag) = [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 -> IO ()) -> Journal -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Journal
forall a. [Char] -> a
error' ([Char] -> Journal) -> [Char] -> Journal
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"
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
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GhcDebugMode
ghcDebugMode GhcDebugMode -> GhcDebugMode -> Bool
forall a. Eq a => a -> a -> Bool
== GhcDebugMode
GDPauseAtEnd) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO ()
ghcDebugPause'
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 -> 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)
[[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"tl", [Char]
"tld"]
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