{-|
hledger - a ledger-compatible accounting tool.
Copyright (c) 2007-2011 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
> > j <- readJournalFile def "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
> > l <- myLedger

See "Hledger.Data.Ledger" for more examples.

-}

{-# LANGUAGE QuasiQuotes #-}

module Hledger.Cli.Main where

import Data.Char (isDigit)
import Data.List
import Safe
import qualified System.Console.CmdArgs.Explicit as C
import System.Environment
import System.Exit
import System.FilePath
import System.Process
import Text.Printf

import Hledger.Cli


-- | The overall cmdargs mode describing hledger's command-line options and subcommands.
mainmode :: [Name] -> Mode RawOpts
mainmode addons :: [Name]
addons = Mode RawOpts
defMode {
  modeNames :: [Name]
modeNames = [Name
progname Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ " [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
$ Name -> Arg RawOpts
argsFlag "[ARGS]")
 ,modeHelp :: Name
modeHelp = [Name] -> Name
unlines ["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] -> [(Name, [a])] -> Group a
Group {
    -- subcommands in the unnamed group, shown first:
    groupUnnamed :: [Mode RawOpts]
groupUnnamed = [
     ]
    -- subcommands in named groups:
   ,groupNamed :: [(Name, [Mode RawOpts])]
groupNamed = [
     ]
    -- subcommands handled but not shown in the help:
   ,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]
++ (Name -> Mode RawOpts) -> [Name] -> [Mode RawOpts]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Mode RawOpts
addonCommandMode [Name]
addons
   }
 ,modeGroupFlags :: Group (Flag RawOpts)
modeGroupFlags = Group :: forall a. [a] -> [a] -> [(Name, [a])] -> Group a
Group {
     -- flags in named groups:
     groupNamed :: [(Name, [Flag RawOpts])]
groupNamed = [
        (  "General input flags",     [Flag RawOpts]
inputflags)
       ,("\nGeneral reporting flags", [Flag RawOpts]
reportflags)
       ,("\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 :: [Name]
modeHelpSuffix = (Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Name -> Name -> Name
regexReplace "PROGNAME" Name
progname) [
     "Examples:"
    ,"PROGNAME                         list commands"
    ,"PROGNAME CMD [--] [OPTS] [ARGS]  run a command (use -- with addon commands)"
    ,"PROGNAME-CMD [OPTS] [ARGS]       or run addon commands directly"
    ,"PROGNAME -h                      show general usage"
    ,"PROGNAME CMD -h                  show command usage"
    ,"PROGNAME help [MANUAL]           show any of the hledger manuals in various formats"
    ]
 }

-- | Let's go!
main :: IO ()
main :: IO ()
main = do

  -- 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
  [Name]
args <- IO [Name]
getArgs IO [Name] -> ([Name] -> IO [Name]) -> IO [Name]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Name] -> IO [Name]
expandArgsAt
  let
    args' :: [Name]
args'                = [Name] -> [Name]
moveFlagsAfterCommand ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ [Name] -> [Name]
replaceNumericFlags [Name]
args
    isFlag :: Name -> Bool
isFlag               = ("-" Name -> Name -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)
    isNonEmptyNonFlag :: Name -> Bool
isNonEmptyNonFlag s :: Name
s  = Bool -> Bool
not (Name -> Bool
isFlag Name
s) Bool -> Bool -> Bool
&& Bool -> Bool
not (Name -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Name
s)
    rawcmd :: Name
rawcmd               = Name -> [Name] -> Name
forall a. a -> [a] -> a
headDef "" ([Name] -> Name) -> [Name] -> Name
forall a b. (a -> b) -> a -> b
$ (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Name -> Bool
isNonEmptyNonFlag [Name]
args'
    isNullCommand :: Bool
isNullCommand        = Name -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Name
rawcmd
    (argsbeforecmd :: [Name]
argsbeforecmd, argsaftercmd' :: [Name]
argsaftercmd') = (Name -> Bool) -> [Name] -> ([Name], [Name])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==Name
rawcmd) [Name]
args
    argsaftercmd :: [Name]
argsaftercmd         = Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
drop 1 [Name]
argsaftercmd'
    dbgIO :: Show a => String -> a -> IO ()
    dbgIO :: Name -> a -> IO ()
dbgIO = Int -> Name -> a -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> Name -> a -> m ()
ptraceAtIO 6

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

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

  -- parse arguments with cmdargs
  CliOpts
opts <- [Name] -> [Name] -> IO CliOpts
argsToCliOpts [Name]
args [Name]
addons

  -- select an action and run it.
  let
    cmd :: Name
cmd                  = CliOpts -> Name
command_ CliOpts
opts -- the full matched internal or external command name, if any
    isInternalCommand :: Bool
isInternalCommand    = Name
cmd Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
builtinCommandNames -- not (null cmd) && not (cmd `elem` addons)
    isExternalCommand :: Bool
isExternalCommand    = Bool -> Bool
not (Name -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Name
cmd) Bool -> Bool -> Bool
&& Name
cmd Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
addons -- probably
    isBadCommand :: Bool
isBadCommand         = Bool -> Bool
not (Name -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Name
rawcmd) Bool -> Bool -> Bool
&& Name -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Name
cmd
    hasVersion :: [Name] -> Bool
hasVersion           = ("--version" Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`)
    hasDetailedVersion :: [Name] -> Bool
hasDetailedVersion   = ("--version+" Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`)
    printUsage :: IO ()
printUsage           = Name -> IO ()
putStr (Name -> IO ()) -> Name -> IO ()
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> Name
forall a. Mode a -> Name
showModeUsage (Mode RawOpts -> Name) -> Mode RawOpts -> Name
forall a b. (a -> b) -> a -> b
$ [Name] -> Mode RawOpts
mainmode [Name]
addons
    badCommandError :: IO b
badCommandError      = Name -> IO Any
forall a. Name -> a
error' ("command "Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
rawcmdName -> Name -> Name
forall a. [a] -> [a] -> [a]
++" 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 Name -> Bool
hasHelpFlag args :: t Name
args     = (Name -> Bool) -> [Name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Name -> t Name -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Name
args) ["-h","--help"]
    f :: IO ()
f orShowHelp :: IO () -> Mode a -> IO ()
`orShowHelp` mode :: Mode a
mode
      | [Name] -> Bool
forall (t :: * -> *). Foldable t => t Name -> Bool
hasHelpFlag [Name]
args = Name -> IO ()
putStr (Name -> IO ()) -> Name -> IO ()
forall a b. (a -> b) -> a -> b
$ Mode a -> Name
forall a. Mode a -> Name
showModeUsage Mode a
mode
      | Bool
otherwise        = IO ()
f
  Name -> CliOpts -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO "processed opts" CliOpts
opts
  Name -> Name -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO "command matched" Name
cmd
  Name -> Bool -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO "isNullCommand" Bool
isNullCommand
  Name -> Bool -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO "isInternalCommand" Bool
isInternalCommand
  Name -> Bool -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO "isExternalCommand" Bool
isExternalCommand
  Name -> Bool -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO "isBadCommand" Bool
isBadCommand
  Day
d <- IO Day
getCurrentDay
  Name -> Period -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO "period from opts" (ReportOpts -> Period
period_ (ReportOpts -> Period) -> ReportOpts -> Period
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportOpts
reportopts_ CliOpts
opts)
  Name -> Interval -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO "interval from opts" (ReportOpts -> Interval
interval_ (ReportOpts -> Interval) -> ReportOpts -> Interval
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportOpts
reportopts_ CliOpts
opts)
  Name -> Query -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO "query from opts & args" (Day -> ReportOpts -> Query
queryFromOpts Day
d (ReportOpts -> Query) -> ReportOpts -> Query
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportOpts
reportopts_ CliOpts
opts)
  let
    journallesserror :: a
journallesserror = Name -> a
forall a. HasCallStack => Name -> a
error "journal-less command tried to use the journal"
    runHledgerCommand :: IO ()
runHledgerCommand
      -- high priority flags and situations. -h, then --help, then --info are highest priority.
      | [Name] -> Bool
forall (t :: * -> *). Foldable t => t Name -> Bool
hasHelpFlag [Name]
argsbeforecmd = Name -> Name -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO "" "-h before command, showing general usage" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
printUsage
      | Bool -> Bool
not ([Name] -> Bool
forall (t :: * -> *). Foldable t => t Name -> Bool
hasHelpFlag [Name]
argsaftercmd) Bool -> Bool -> Bool
&& ([Name] -> Bool
hasVersion [Name]
argsbeforecmd Bool -> Bool -> Bool
|| ([Name] -> Bool
hasVersion [Name]
argsaftercmd Bool -> Bool -> Bool
&& Bool
isInternalCommand))
                                 = Name -> IO ()
putStrLn Name
prognameandversion
      | Bool -> Bool
not ([Name] -> Bool
forall (t :: * -> *). Foldable t => t Name -> Bool
hasHelpFlag [Name]
argsaftercmd) Bool -> Bool -> Bool
&& ([Name] -> Bool
hasDetailedVersion [Name]
argsbeforecmd Bool -> Bool -> Bool
|| ([Name] -> Bool
hasDetailedVersion [Name]
argsaftercmd Bool -> Bool -> Bool
&& Bool
isInternalCommand))
                                 = Name -> IO ()
putStrLn Name
prognameanddetailedversion
      -- \| (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            = Name -> Name -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO "" "no command, showing commands list" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Name] -> IO ()
printCommandsList [Name]
addons
      | Bool
isBadCommand             = IO ()
forall a. IO a
badCommandError

      -- builtin commands
      | Just (cmdmode :: Mode RawOpts
cmdmode, cmdaction :: CliOpts -> Journal -> IO ()
cmdaction) <- Name -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findCommand Name
cmd =
        (case Bool
True of
           -- these commands should not require or read the journal
          _ | Name
cmd Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["test","help"] -> CliOpts -> Journal -> IO ()
cmdaction CliOpts
opts Journal
forall a. a
journallesserror
          -- these commands should create the journal if missing
          _ | Name
cmd Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["add","import"] -> do
            (Name -> IO ()
ensureJournalFileExists (Name -> IO ()) -> IO Name -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ([Name] -> Name
forall a. [a] -> a
head ([Name] -> Name) -> IO [Name] -> IO Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CliOpts -> IO [Name]
journalFilePathFromOpts CliOpts
opts))
            CliOpts -> (Journal -> IO ()) -> IO ()
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
          _ -> 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

      -- addon commands
      | Bool
isExternalCommand = do
          let externalargs :: [Name]
externalargs = [Name]
argsbeforecmd [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Name -> Bool) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
=="--")) [Name]
argsaftercmd
          let shellcmd :: Name
shellcmd = Name -> Name -> Name -> Name -> Name
forall r. PrintfType r => Name -> r
printf "%s-%s %s" Name
progname Name
cmd ([Name] -> Name
unwords' [Name]
externalargs) :: String
          Name -> Name -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO "external command selected" Name
cmd
          Name -> [Name] -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO "external command arguments" ((Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Name
quoteIfNeeded [Name]
externalargs)
          Name -> Name -> IO ()
forall a. Show a => Name -> a -> IO ()
dbgIO "running shell command" Name
shellcmd
          Name -> IO ExitCode
system Name
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

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

      -- shouldn't reach here
      | Bool
otherwise                = Name -> IO Any
forall a. Name -> a
usageError ("could not understand the arguments "Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++[Name] -> Name
forall a. Show a => a -> Name
show [Name]
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

-- | Parse hledger CLI options from these command line arguments and
-- add-on command names, or raise any error.
argsToCliOpts :: [String] -> [String] -> IO CliOpts
argsToCliOpts :: [Name] -> [Name] -> IO CliOpts
argsToCliOpts args :: [Name]
args addons :: [Name]
addons = do
  let
    args' :: [Name]
args'        = [Name] -> [Name]
moveFlagsAfterCommand ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ [Name] -> [Name]
replaceNumericFlags [Name]
args
    cmdargsopts :: RawOpts
cmdargsopts  = (Name -> RawOpts)
-> (RawOpts -> RawOpts) -> Either Name RawOpts -> RawOpts
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Name -> RawOpts
forall a. Name -> a
usageError RawOpts -> RawOpts
forall a. a -> a
id (Either Name RawOpts -> RawOpts) -> Either Name RawOpts -> RawOpts
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> [Name] -> Either Name RawOpts
forall a. Mode a -> [Name] -> Either Name a
C.process ([Name] -> Mode RawOpts
mainmode [Name]
addons) [Name]
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 this 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
-- - not confuse things further or cause misleading errors.
moveFlagsAfterCommand :: [String] -> [String]
moveFlagsAfterCommand :: [Name] -> [Name]
moveFlagsAfterCommand args :: [Name]
args = [Name] -> [Name]
moveArgs ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ [Name] -> [Name]
ensureDebugHasArg [Name]
args
  where
    -- quickly! make sure --debug has a numeric argument, or this all goes to hell
    ensureDebugHasArg :: [Name] -> [Name]
ensureDebugHasArg as :: [Name]
as =
      case (Name -> Bool) -> [Name] -> ([Name], [Name])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
=="--debug") [Name]
as of
       (bs :: [Name]
bs,"--debug":c :: Name
c:cs :: [Name]
cs) | Name -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Name
c Bool -> Bool -> Bool
|| Bool -> Bool
not ((Char -> Bool) -> Name -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit Name
c) -> [Name]
bs[Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++"--debug=1"Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:Name
cName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
cs
       (bs :: [Name]
bs,"--debug":[])                                   -> [Name]
bs[Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++"--debug=1"Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[]
       _                                                   -> [Name]
as

    moveArgs :: [Name] -> [Name]
moveArgs args :: [Name]
args = ([Name], [Name]) -> [Name]
forall a. ([a], [a]) -> [a]
insertFlagsAfterCommand (([Name], [Name]) -> [Name]) -> ([Name], [Name]) -> [Name]
forall a b. (a -> b) -> a -> b
$ ([Name], [Name]) -> ([Name], [Name])
moveArgs' ([Name]
args, [])
      where
        -- -h ..., --version ...
        moveArgs' :: ([Name], [Name]) -> ([Name], [Name])
moveArgs' ((f :: Name
f:a :: Name
a:as :: [Name]
as), flags :: [Name]
flags)   | Name -> Bool
isMovableNoArgFlag Name
f                   = ([Name], [Name]) -> ([Name], [Name])
moveArgs' (Name
aName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
as, [Name]
flags [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name
f])
        -- -f FILE ..., --alias ALIAS ...
        moveArgs' ((f :: Name
f:v :: Name
v:a :: Name
a:as :: [Name]
as), flags :: [Name]
flags) | Name -> Bool
isMovableReqArgFlag Name
f, Name -> Bool
isValue Name
v       = ([Name], [Name]) -> ([Name], [Name])
moveArgs' (Name
aName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
as, [Name]
flags [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name
f,Name
v])
        -- -fFILE ..., --alias=ALIAS ...
        moveArgs' ((fv :: Name
fv:a :: Name
a:as :: [Name]
as), flags :: [Name]
flags)  | Name -> Bool
isMovableReqArgFlagAndValue Name
fv         = ([Name], [Name]) -> ([Name], [Name])
moveArgs' (Name
aName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
as, [Name]
flags [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name
fv])
        -- -f(missing arg)
        moveArgs' ((f :: Name
f:a :: Name
a:as :: [Name]
as), flags :: [Name]
flags)   | Name -> Bool
isMovableReqArgFlag Name
f, Bool -> Bool
not (Name -> Bool
isValue Name
a) = ([Name], [Name]) -> ([Name], [Name])
moveArgs' (Name
aName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
as, [Name]
flags [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name
f])
        -- anything else
        moveArgs' (as :: [Name]
as, flags :: [Name]
flags) = ([Name]
as, [Name]
flags)

        insertFlagsAfterCommand :: ([a], [a]) -> [a]
insertFlagsAfterCommand ([],           flags :: [a]
flags) = [a]
flags
        insertFlagsAfterCommand (command :: a
command:args :: [a]
args, flags :: [a]
flags) = [a
command] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
flags [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
args

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

isMovableReqArgFlag :: Name -> Bool
isMovableReqArgFlag a :: Name
a = "-" Name -> Name -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Name
a Bool -> Bool -> Bool
&& (Char -> Bool) -> Name -> Name
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='-') Name
a Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
reqargflagstomove

isMovableReqArgFlagAndValue :: Name -> Bool
isMovableReqArgFlagAndValue ('-':'-':a :: Char
a:as :: Name
as) = case (Char -> Bool) -> Name -> (Name, Name)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '=') (Char
aChar -> Name -> Name
forall a. a -> [a] -> [a]
:Name
as) of (f :: Char
f:fs :: Name
fs,_:_) -> (Char
fChar -> Name -> Name
forall a. a -> [a] -> [a]
:Name
fs) Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
reqargflagstomove
                                                                           _          -> Bool
False
isMovableReqArgFlagAndValue ('-':shortflag :: Char
shortflag:_:_) = [Char
shortflag] Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
reqargflagstomove
isMovableReqArgFlagAndValue _ = Bool
False

isValue :: Name -> Bool
isValue "-"     = Bool
True
isValue ('-':_) = Bool
False
isValue _       = 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 :: [Name]
noargflagstomove  = (Flag RawOpts -> [Name]) -> [Flag RawOpts] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [Name]
forall a. Flag a -> [Name]
flagNames ([Flag RawOpts] -> [Name]) -> [Flag RawOpts] -> [Name]
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 :: [Name]
reqargflagstomove = -- filter (/= "debug") $
                    (Flag RawOpts -> [Name]) -> [Flag RawOpts] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [Name]
forall a. Flag a -> [Name]
flagNames ([Flag RawOpts] -> [Name]) -> [Flag RawOpts] -> [Name]
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