    {-|
    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 = "Examples:" Name -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    :
        (Name -> Name) -> [Name] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name
    progname Name -> Name -> Name
    forall a. [a] -> [a] -> [a]
    ++) [
         "                         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"
        ]
     }

    -- | 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 8

      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  -- PARTIAL:
        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