{-|
hledger - a ledger-compatible accounting tool.
Copyright (c) 2007-2022 Simon Michael <simon@joyful.com>
Released under GPL version 3 or later.

hledger is a partial haskell clone of John Wiegley's "ledger".  It
generates ledger-compatible register & balance reports from a plain text
journal, and demonstrates a functional implementation of ledger.
For more information, see http:\/\/hledger.org .

This module provides the main function for the hledger command-line
executable. It is exposed here so that it can be imported by eg benchmark
scripts.

You can use the command line:

> $ hledger --help

or ghci:

> $ ghci hledger
> > Right j <- readJournalFile definputopts "examples/sample.journal"
> > register [] ["income","expenses"] j
> 2008/01/01 income               income:salary                   $-1          $-1
> 2008/06/01 gift                 income:gifts                    $-1          $-2
> 2008/06/03 eat & shop           expenses:food                    $1          $-1
>                                 expenses:supplies                $1            0
> > balance [Depth "1"] [] l
>                  $-1  assets
>                   $2  expenses
>                  $-2  income
>                   $1  liabilities
> > j <- defaultJournal

etc.

-}

{-# LANGUAGE LambdaCase #-}

module Hledger.Cli.Main where

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)


-- | The overall cmdargs mode describing hledger's command-line options and subcommands.
mainmode :: [[Char]] -> Mode RawOpts
mainmode [[Char]]
addons = Mode RawOpts
defMode {
  modeNames :: [[Char]]
modeNames = [[Char]
progname forall a. [a] -> [a] -> [a]
++ [Char]
" [CMD]"]
 ,modeArgs :: ([Arg RawOpts], Maybe (Arg RawOpts))
modeArgs = ([], forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char] -> Arg RawOpts
argsFlag [Char]
"[ARGS]")
 ,modeHelp :: [Char]
modeHelp = [[Char]] -> [Char]
unlines [[Char]
"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 {
    -- subcommands in the unnamed group, shown first:
    groupUnnamed :: [Mode RawOpts]
groupUnnamed = [
     ]
    -- subcommands in named groups:
   ,groupNamed :: [([Char], [Mode RawOpts])]
groupNamed = [
     ]
    -- subcommands handled but not shown in the help:
   ,groupHidden :: [Mode RawOpts]
groupHidden = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Mode RawOpts, CliOpts -> Journal -> IO ())]
builtinCommands forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Mode RawOpts
addonCommandMode [[Char]]
addons
   }
 ,modeGroupFlags :: Group (Flag RawOpts)
modeGroupFlags = Group {
     -- flags in named groups:
     groupNamed :: [([Char], [Flag RawOpts])]
groupNamed = [
        (  [Char]
"General input flags",     [Flag RawOpts]
inputflags)
       ,([Char]
"\nGeneral reporting flags", [Flag RawOpts]
reportflags)
       ,([Char]
"\nGeneral help flags",      [Flag RawOpts]
helpflags)
       ]
     -- flags in the unnamed group, shown last:
    ,groupUnnamed :: [Flag RawOpts]
groupUnnamed = []
     -- flags handled but not shown in the help:
    ,groupHidden :: [Flag RawOpts]
groupHidden =
        [Flag RawOpts
detailedversionflag]
        -- ++ inputflags -- included here so they'll not raise a confusing error if present with no COMMAND
    }
 ,modeHelpSuffix :: [[Char]]
modeHelpSuffix = [Char]
"Examples:" forall a. a -> [a] -> [a]
:
    forall a b. (a -> b) -> [a] -> [b]
map ([Char]
progname forall a. [a] -> [a] -> [a]
++) [
     [Char]
"                         list commands"
    ,[Char]
" CMD [--] [OPTS] [ARGS]  run a command (use -- with addon commands)"
    ,[Char]
"-CMD [OPTS] [ARGS]       or run addon commands directly"
    ,[Char]
" -h                      show general usage"
    ,[Char]
" CMD -h                  show command usage"
    ,[Char]
" help [MANUAL]           show any of the hledger manuals in various formats"
    ]
 }

-- | Let's go!
main :: IO ()
main :: IO ()
main = do
  POSIXTime
starttime <- IO POSIXTime
getPOSIXTime

  -- Choose and run the appropriate internal or external command based
  -- on the raw command-line arguments, cmdarg's interpretation of
  -- same, and hledger-* executables in the user's PATH. A somewhat
  -- complex mishmash of cmdargs and custom processing, hence all the
  -- debugging support and tests. See also Hledger.Cli.CliOptions and
  -- command-line.test.

  -- some preliminary (imperfect) argument parsing to supplement cmdargs
  [[Char]]
args <- IO [[Char]]
getArgs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [[Char]] -> IO [[Char]]
expandArgsAt
  let
    args' :: [[Char]]
args'                = [[Char]] -> [[Char]]
moveFlagsAfterCommand forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
replaceNumericFlags [[Char]]
args
    isFlag :: [Char] -> Bool
isFlag               = ([Char]
"-" 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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
s)
    rawcmd :: [Char]
rawcmd               = forall a. a -> [a] -> a
headDef [Char]
"" forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile [Char] -> Bool
isNonEmptyNonFlag [[Char]]
args'
    isNullCommand :: Bool
isNullCommand        = forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
rawcmd
    ([[Char]]
argsbeforecmd, [[Char]]
argsaftercmd') = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
==[Char]
rawcmd) [[Char]]
args
    argsaftercmd :: [[Char]]
argsaftercmd         = 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 = forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> [Char] -> a -> m ()
ptraceAtIO Int
8

  forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"running" [Char]
prognameandversion
  forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"raw args" [[Char]]
args
  forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"raw args rearranged for cmdargs" [[Char]]
args'
  forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"raw command is probably" [Char]
rawcmd
  forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"raw args before command" [[Char]]
argsbeforecmd
  forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"raw args after command" [[Char]]
argsaftercmd

  -- Search PATH for add-ons, excluding any that match built-in command names
  [[Char]]
addons' <- IO [[Char]]
hledgerAddons
  let addons :: [[Char]]
addons = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
builtinCommandNames) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
dropExtension) [[Char]]
addons'

  -- parse arguments with cmdargs
  CliOpts
opts' <- [[Char]] -> [[Char]] -> IO CliOpts
argsToCliOpts [[Char]]
args [[Char]]
addons
  let opts :: CliOpts
opts = CliOpts
opts'{progstarttime_ :: POSIXTime
progstarttime_=POSIXTime
starttime}

  -- select an action and run it.
  let
    cmd :: [Char]
cmd                  = CliOpts -> [Char]
command_ CliOpts
opts -- the full matched internal or external command name, if any
    isInternalCommand :: Bool
isInternalCommand    = [Char]
cmd forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
builtinCommandNames -- not (null cmd) && not (cmd `elem` addons)
    isExternalCommand :: Bool
isExternalCommand    = Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
cmd) Bool -> Bool -> Bool
&& [Char]
cmd forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
addons -- probably
    isBadCommand :: Bool
isBadCommand         = Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
rawcmd) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
cmd
    hasVersion :: [[Char]] -> Bool
hasVersion           = ([Char]
"--version" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`)
    printUsage :: IO ()
printUsage           = [Char] -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> [Char]
showModeUsage forall a b. (a -> b) -> a -> b
$ [[Char]] -> Mode RawOpts
mainmode [[Char]]
addons
    badCommandError :: IO b
badCommandError      = forall a. [Char] -> a
error' ([Char]
"command "forall a. [a] -> [a] -> [a]
++[Char]
rawcmdforall a. [a] -> [a] -> [a]
++[Char]
" is not recognized, run with no command to see a list") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. IO a
exitFailure  -- PARTIAL:
    hasHelpFlag :: t [Char] -> Bool
hasHelpFlag t [Char]
args1     = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (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      = (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     = (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
      | forall {t :: * -> *}. Foldable t => t [Char] -> Bool
hasHelpFlag [[Char]]
args = [Char] -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> [Char]
showModeUsage Mode a
mode1
      | forall {t :: * -> *}. Foldable t => t [Char] -> Bool
hasInfoFlag [[Char]]
args = [Char] -> Maybe [Char] -> IO ()
runInfoForTopic [Char]
"hledger" (forall a. [a] -> Maybe a
headMay forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> [[Char]]
modeNames Mode a
mode1)
      | forall {t :: * -> *}. Foldable t => t [Char] -> Bool
hasManFlag [[Char]]
args  = [Char] -> Maybe [Char] -> IO ()
runManForTopic [Char]
"hledger" (forall a. [a] -> Maybe a
headMay forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> [[Char]]
modeNames Mode a
mode1)
      | Bool
otherwise        = IO ()
f
      -- where
      --   lastdocflag
  forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"processed opts" CliOpts
opts
  forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"command matched" [Char]
cmd
  forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"isNullCommand" Bool
isNullCommand
  forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"isInternalCommand" Bool
isInternalCommand
  forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"isExternalCommand" Bool
isExternalCommand
  forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"isBadCommand" Bool
isBadCommand
  forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"period from opts" (ReportOpts -> Period
period_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportSpec -> ReportOpts
_rsReportOpts forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
opts)
  forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"interval from opts" (ReportOpts -> Interval
interval_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportSpec -> ReportOpts
_rsReportOpts forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
opts)
  forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"query from opts & args" (ReportSpec -> Query
_rsQuery forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
opts)
  let
    journallesserror :: a
journallesserror = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
cmdforall a. [a] -> [a] -> [a]
++[Char]
" tried to read the journal but is not supposed to"
    runHledgerCommand :: IO ()
runHledgerCommand
      -- high priority flags and situations. -h, then --help, then --info are highest priority.
      | Bool
isNullCommand Bool -> Bool -> Bool
&& forall {t :: * -> *}. Foldable t => t [Char] -> Bool
hasHelpFlag [[Char]]
args = forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"" [Char]
"-h/--help with no command, showing general help" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
printUsage
      | Bool
isNullCommand Bool -> Bool -> Bool
&& forall {t :: * -> *}. Foldable t => t [Char] -> Bool
hasInfoFlag [[Char]]
args = forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"" [Char]
"--info with no command, showing general info manual" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Maybe [Char] -> IO ()
runInfoForTopic [Char]
"hledger" forall a. Maybe a
Nothing
      | Bool
isNullCommand Bool -> Bool -> Bool
&& forall {t :: * -> *}. Foldable t => t [Char] -> Bool
hasManFlag [[Char]]
args  = forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"" [Char]
"--man with no command, showing general man page" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Maybe [Char] -> IO ()
runManForTopic [Char]
"hledger" forall a. Maybe a
Nothing
      | Bool -> Bool
not (Bool
isExternalCommand Bool -> Bool -> Bool
|| forall {t :: * -> *}. Foldable t => t [Char] -> Bool
hasHelpFlag [[Char]]
args Bool -> Bool -> Bool
|| forall {t :: * -> *}. Foldable t => t [Char] -> Bool
hasInfoFlag [[Char]]
args Bool -> Bool -> Bool
|| forall {t :: * -> *}. Foldable t => t [Char] -> Bool
hasManFlag [[Char]]
args)
        Bool -> Bool -> Bool
&& ([[Char]] -> Bool
hasVersion [[Char]]
args) --  || (hasVersion argsaftercmd && isInternalCommand))
                                 = [Char] -> IO ()
putStrLn [Char]
prognameandversion
      -- \| (null externalcmd) && "binary-filename" `inRawOpts` rawopts = putStrLn $ binaryfilename progname
      -- \| "--browse-args" `elem` args     = System.Console.CmdArgs.Helper.execute "cmdargs-browser" mainmode' args >>= (putStr . show)
      | Bool
isNullCommand            = forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"" [Char]
"no command, showing commands list" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> [[Char]] -> IO ()
printCommandsList [Char]
prognameandversion [[Char]]
addons
      | Bool
isBadCommand             = forall a. IO a
badCommandError

      -- builtin commands
      | Just (Mode RawOpts
cmdmode, CliOpts -> Journal -> IO ()
cmdaction) <- [Char] -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findCommand [Char]
cmd =
        (case Bool
True of
           -- these commands should not require or read the journal
          Bool
_ | [Char]
cmd forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"test",[Char]
"help"] -> CliOpts -> Journal -> IO ()
cmdaction CliOpts
opts forall {a}. a
journallesserror
          -- these commands should create the journal if missing
          Bool
_ | [Char]
cmd forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"add",[Char]
"import"] -> do
            [Char] -> IO ()
ensureJournalFileExists forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CliOpts -> IO [[Char]]
journalFilePathFromOpts CliOpts
opts
            forall a. CliOpts -> (Journal -> IO a) -> IO a
withJournalDo CliOpts
opts (CliOpts -> Journal -> IO ()
cmdaction CliOpts
opts)
          -- other commands read the journal and should fail if it's missing
          Bool
_ -> forall a. CliOpts -> (Journal -> IO a) -> IO a
withJournalDo CliOpts
opts (CliOpts -> Journal -> IO ()
cmdaction CliOpts
opts)
        )
        forall {a}. IO () -> Mode a -> IO ()
`orShowHelp` Mode RawOpts
cmdmode

      -- addon commands
      | Bool
isExternalCommand = do
          let externalargs :: [[Char]]
externalargs = [[Char]]
argsbeforecmd forall a. [a] -> [a] -> [a]
++ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=[Char]
"--") [[Char]]
argsaftercmd
          let shellcmd :: [Char]
shellcmd = forall r. PrintfType r => [Char] -> r
printf [Char]
"%s-%s %s" [Char]
progname [Char]
cmd ([[Char]] -> [Char]
unwords' [[Char]]
externalargs) :: String
          forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"external command selected" [Char]
cmd
          forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"external command arguments" (forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
quoteIfNeeded [[Char]]
externalargs)
          forall a. Show a => [Char] -> a -> IO ()
dbgIO [Char]
"running shell command" [Char]
shellcmd
          [Char] -> IO ExitCode
system [Char]
shellcmd forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. ExitCode -> IO a
exitWith

      -- deprecated commands
      -- cmd == "convert"         = error' (modeHelp oldconvertmode) >> exitFailure

      -- shouldn't reach here
      | Bool
otherwise                = forall a. [Char] -> a
usageError ([Char]
"could not understand the arguments "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show [[Char]]
args) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. IO a
exitFailure

  IO ()
runHledgerCommand

-- | Parse hledger CLI options from these command line arguments and
-- add-on command names, or raise any error.
argsToCliOpts :: [String] -> [String] -> IO CliOpts
argsToCliOpts :: [[Char]] -> [[Char]] -> IO CliOpts
argsToCliOpts [[Char]]
args [[Char]]
addons = do
  let
    args' :: [[Char]]
args'        = [[Char]] -> [[Char]]
moveFlagsAfterCommand forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
replaceNumericFlags [[Char]]
args
    cmdargsopts :: RawOpts
cmdargsopts  = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. [Char] -> a
usageError forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> [[Char]] -> Either [Char] a
C.process ([[Char]] -> Mode RawOpts
mainmode [[Char]]
addons) [[Char]]
args'
  RawOpts -> IO CliOpts
rawOptsToCliOpts RawOpts
cmdargsopts

-- | A hacky workaround for cmdargs not accepting flags before the
-- subcommand name: try to detect and move such flags after the
-- command.  This allows the user to put them in either position.
-- The order of options is not preserved, but that should be ok.
--
-- Since we're not parsing flags as precisely as cmdargs here, this is
-- imperfect. We make a decent effort to:
-- - move all no-argument help/input/report flags
-- - move all required-argument help/input/report flags along with their values, space-separated or not
-- - ensure --debug has an argument (because.. "or this all goes to hell")
-- - not confuse things further or cause misleading errors.
moveFlagsAfterCommand :: [String] -> [String]
moveFlagsAfterCommand :: [[Char]] -> [[Char]]
moveFlagsAfterCommand [[Char]]
args = [[Char]] -> [[Char]]
moveArgs forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Eq (t Char), IsString (t Char), Foldable t) =>
[t Char] -> [t Char]
ensureDebugHasArg [[Char]]
args
  where
    moveArgs :: [[Char]] -> [[Char]]
moveArgs [[Char]]
args1 = forall {a}. ([a], [a]) -> [a]
insertFlagsAfterCommand forall a b. (a -> b) -> a -> b
$ ([[Char]], [[Char]]) -> ([[Char]], [[Char]])
moveArgs' ([[Char]]
args1, [])
      where
        -- -f FILE ..., --alias ALIAS ...
        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]
aforall a. a -> [a] -> [a]
:[[Char]]
as, [[Char]]
flags forall a. [a] -> [a] -> [a]
++ [[Char]
f,[Char]
v])
        -- -fFILE ..., --alias=ALIAS ...
        moveArgs' (([Char]
fv:[Char]
a:[[Char]]
as), [[Char]]
flags)  | [Char] -> Bool
isMovableArgFlagAndValue [Char]
fv            = ([[Char]], [[Char]]) -> ([[Char]], [[Char]])
moveArgs' ([Char]
aforall a. a -> [a] -> [a]
:[[Char]]
as, [[Char]]
flags forall a. [a] -> [a] -> [a]
++ [[Char]
fv])
        -- -f(missing arg)
        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]
aforall a. a -> [a] -> [a]
:[[Char]]
as, [[Char]]
flags forall a. [a] -> [a] -> [a]
++ [[Char]
f])
        -- -h ..., --version ...
        moveArgs' (([Char]
f:[Char]
a:[[Char]]
as), [[Char]]
flags)   | [Char] -> Bool
isMovableNoArgFlag [Char]
f                   = ([[Char]], [[Char]]) -> ([[Char]], [[Char]])
moveArgs' ([Char]
aforall a. a -> [a] -> [a]
:[[Char]]
as, [[Char]]
flags forall a. [a] -> [a] -> [a]
++ [[Char]
f])
        -- anything else
        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] forall a. [a] -> [a] -> [a]
++ [a]
flags forall a. [a] -> [a] -> [a]
++ [a]
args2

isMovableNoArgFlag :: [Char] -> Bool
isMovableNoArgFlag [Char]
a  = [Char]
"-" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
a Bool -> Bool -> Bool
&& forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==Char
'-') [Char]
a forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
optargflagstomove forall a. [a] -> [a] -> [a]
++ [[Char]]
noargflagstomove

isMovableReqArgFlag :: [Char] -> Bool
isMovableReqArgFlag [Char]
a = [Char]
"-" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
a Bool -> Bool -> Bool
&& forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==Char
'-') [Char]
a 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 forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'=') (Char
aforall a. a -> [a] -> [a]
:[Char]
as) of
    (Char
f:[Char]
fs,Char
_:[Char]
_) -> (Char
fforall a. a -> [a] -> [a]
:[Char]
fs) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
optargflagstomove forall a. [a] -> [a] -> [a]
++ [[Char]]
reqargflagstomove
    ([Char], [Char])
_          -> Bool
False
isMovableArgFlagAndValue (Char
'-':Char
shortflag:Char
_:[Char]
_) = [Char
shortflag] 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 forall a. [a] -> [a] -> [a]
++ [Flag RawOpts]
reportflags forall a. [a] -> [a] -> [a]
++ [Flag RawOpts]
helpflags
noargflagstomove :: [[Char]]
noargflagstomove  = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Flag a -> [[Char]]
flagNames forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
==FlagInfo
FlagNone)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Flag a -> FlagInfo
flagInfo) [Flag RawOpts]
flagstomove
reqargflagstomove :: [[Char]]
reqargflagstomove = -- filter (/= "debug") $
                    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Flag a -> [[Char]]
flagNames forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
==FlagInfo
FlagReq )forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Flag a -> FlagInfo
flagInfo) [Flag RawOpts]
flagstomove
optargflagstomove :: [[Char]]
optargflagstomove = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Flag a -> [[Char]]
flagNames forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (FlagInfo -> Bool
isFlagOpt   forall b c a. (b -> c) -> (a -> b) -> a -> c
.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