-- Copyright (C) 2002,2003,2005 David Roundy
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2, or (at your option)
-- any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; see the file COPYING.  If not, write to
-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-- Boston, MA 02110-1301, USA.

{-# LANGUAGE OverloadedStrings #-}
-- | This is the actual heavy lifter code, which is responsible for parsing the
-- arguments and then running the command itself.
module Darcs.UI.RunCommand
  ( runTheCommand
  , runWithHooks -- exported for darcsden
  ) where

import Darcs.Prelude

import Control.Monad ( unless, when )
import Data.List ( intercalate )
import System.Console.GetOpt( ArgOrder( Permute, RequireOrder ),
                              OptDescr( Option ),
                              getOpt )
import System.Exit ( ExitCode ( ExitSuccess ), exitWith )

import Darcs.UI.Options ( (^), odesc, oparse, parseFlags, optDescr, (?) )
import Darcs.UI.Options.All
    ( stdCmdActions, StdCmdAction(..)
    , debugging, verbosity, Verbosity(..)
    , HooksConfig(..), hooks )

import Darcs.UI.Defaults ( applyDefaults )
import Darcs.UI.External ( viewDoc )
import Darcs.UI.Flags ( DarcsFlag, matchAny, withNewRepo )
import Darcs.UI.Commands
    ( CommandArgs( CommandOnly, SuperCommandOnly, SuperCommandSub )
    , CommandControl
    , DarcsCommand
    , commandName
    , commandCommand
    , commandPrereq
    , commandExtraArgHelp
    , commandExtraArgs
    , commandArgdefaults
    , commandCompleteArgs
    , commandOptDescr
    , commandName
    , disambiguateCommands
    , getSubcommands
    , extractCommands
    , superName
    )
import Darcs.UI.Commands.GZCRCs ( doCRCWarnings )
import Darcs.UI.Commands.Clone ( makeRepoName, cloneToSSH )
import Darcs.UI.RunHook ( runPosthook, runPrehook )
import Darcs.UI.Usage
    ( getCommandHelp
    , getCommandMiniHelp
    , subusage
    )

import Darcs.Patch.Match ( checkMatchSyntax )
import Darcs.Repository.Prefs ( Pref(Defaults), getGlobal, getPreflist )
import Darcs.Util.AtExit ( atexit )
import Darcs.Util.Exception ( die )
import Darcs.Util.Global ( setDebugMode, setTimingsMode )
import Darcs.Util.Path ( AbsolutePath, getCurrentDirectory, toPath, ioAbsoluteOrRemote, makeAbsolute )
import Darcs.Util.Printer ( (<+>), ($+$), renderString, text, vcat )
import Darcs.Util.Printer.Color ( ePutDocLn )
import Darcs.Util.Progress ( setProgressMode )

runTheCommand :: [CommandControl] -> String -> [String] -> IO ()
runTheCommand :: [CommandControl] -> String -> [String] -> IO ()
runTheCommand [CommandControl]
commandControlList String
cmd [String]
args =
  (String -> IO ())
-> ((CommandArgs, [String]) -> IO ())
-> Either String (CommandArgs, [String])
-> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO ()
forall a. String -> IO a
die (CommandArgs, [String]) -> IO ()
rtc (Either String (CommandArgs, [String]) -> IO ())
-> Either String (CommandArgs, [String]) -> IO ()
forall a b. (a -> b) -> a -> b
$ [CommandControl]
-> String -> [String] -> Either String (CommandArgs, [String])
disambiguateCommands [CommandControl]
commandControlList String
cmd [String]
args
 where
  rtc :: (CommandArgs, [String]) -> IO ()
rtc (CommandOnly DarcsCommand
c,       [String]
as) = Maybe DarcsCommand -> DarcsCommand -> [String] -> IO ()
runCommand Maybe DarcsCommand
forall a. Maybe a
Nothing DarcsCommand
c [String]
as
  rtc (SuperCommandOnly DarcsCommand
c,  [String]
as) = DarcsCommand -> [String] -> IO ()
runRawSupercommand DarcsCommand
c [String]
as
  rtc (SuperCommandSub DarcsCommand
c DarcsCommand
s, [String]
as) = Maybe DarcsCommand -> DarcsCommand -> [String] -> IO ()
runCommand (DarcsCommand -> Maybe DarcsCommand
forall a. a -> Maybe a
Just DarcsCommand
c) DarcsCommand
s [String]
as

runCommand :: Maybe DarcsCommand -> DarcsCommand -> [String] -> IO ()
runCommand :: Maybe DarcsCommand -> DarcsCommand -> [String] -> IO ()
runCommand Maybe DarcsCommand
_ DarcsCommand
_ [String]
args -- Check for "dangerous" typoes...
    | String
"-all" String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
args = -- -all indicates --all --look-for-adds!
        String -> IO ()
forall a. String -> IO a
die String
"Are you sure you didn't mean --all rather than -all?"
runCommand Maybe DarcsCommand
msuper DarcsCommand
cmd [String]
args = do
  old_wd <- IO AbsolutePath
getCurrentDirectory
  let options = AbsolutePath -> DarcsCommand -> [OptDescr DarcsFlag]
commandOptDescr AbsolutePath
old_wd DarcsCommand
cmd
  case fixupMsgs $ getOpt Permute options args of
    ([DarcsFlag]
cmdline_flags,[String]
orig_extra,[String]
getopt_errs) -> do
      -- FIXME This code is highly order-dependent because of hidden state: the
      -- current directory. Like almost all Repository functions, getGlobal and
      -- getPreflist assume that the cwd is the base of our work repo (if any).
      -- This is supposed to be ensured by commandPrereq. Which means we must
      -- first call commandPrereq, then getGlobal and getPreflist, and then we
      -- must use the (saved) original working directory to resolve possibly
      -- relative paths to absolute paths.
      prereq_errors <- DarcsCommand -> [DarcsFlag] -> IO (Either String ())
commandPrereq DarcsCommand
cmd [DarcsFlag]
cmdline_flags
      -- we must get the cwd again because commandPrereq has the side-effect of changing it.
      new_wd <- getCurrentDirectory
      user_defs <- getGlobal Defaults
      repo_defs <- getPreflist Defaults
      let (flags, (flag_warnings, flag_errors)) =
            applyDefaults (fmap commandName msuper) cmd old_wd user_defs repo_defs cmdline_flags
      case parseFlags stdCmdActions flags of
        Just StdCmdAction
Help -> Doc -> IO ()
viewDoc (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe DarcsCommand -> DarcsCommand -> Doc
getCommandHelp Maybe DarcsCommand
msuper DarcsCommand
cmd
        Just StdCmdAction
ListOptions -> do
          Bool -> IO ()
setProgressMode Bool
False
          possible_args <- DarcsCommand
-> (AbsolutePath, AbsolutePath)
-> [DarcsFlag]
-> [String]
-> IO [String]
commandCompleteArgs DarcsCommand
cmd (AbsolutePath
new_wd, AbsolutePath
old_wd) [DarcsFlag]
flags [String]
orig_extra
          mapM_ putStrLn $ optionList options ++ possible_args
        Just StdCmdAction
Disable ->
          String -> IO ()
forall a. String -> IO a
die (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Command "String -> String -> String
forall a. [a] -> [a] -> [a]
++DarcsCommand -> String
commandName DarcsCommand
cmdString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" disabled with --disable option!"
        Maybe StdCmdAction
Nothing -> case Either String ()
prereq_errors of
          Left String
complaint -> String -> IO ()
forall a. String -> IO a
die (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
            String
"Unable to '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"darcs " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe DarcsCommand -> String
superName Maybe DarcsCommand
msuper String -> String -> String
forall a. [a] -> [a] -> [a]
++ DarcsCommand -> String
commandName DarcsCommand
cmd String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
"' here:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
complaint
          Right () -> do
            Doc -> IO ()
ePutDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text ([String] -> [Doc]) -> [String] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [String]
flag_warnings
            case [String]
getopt_errs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
flag_errors of
              [] -> do
                extra <- DarcsCommand
-> [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults DarcsCommand
cmd [DarcsFlag]
flags AbsolutePath
old_wd [String]
orig_extra
                case extraArgumentsError extra cmd msuper of
                  Maybe String
Nothing     -> DarcsCommand
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
runWithHooks DarcsCommand
cmd (AbsolutePath
new_wd, AbsolutePath
old_wd) [DarcsFlag]
flags [String]
extra
                  Just String
msg    -> String -> IO ()
forall a. String -> IO a
die String
msg
              [String]
errors -> String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [String]
errors

fixupMsgs :: (a, b, [String]) -> (a, b, [String])
fixupMsgs :: forall a b. (a, b, [String]) -> (a, b, [String])
fixupMsgs (a
fs,b
as,[String]
es) = (a
fs,b
as,(String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
"command line: "String -> String -> String
forall a. [a] -> [a] -> [a]
++)(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String
chompTrailingNewline) [String]
es)
  where
    chompTrailingNewline :: String -> String
chompTrailingNewline String
"" = String
""
    chompTrailingNewline String
s = if String -> Char
forall a. HasCallStack => [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' then String -> String
forall a. HasCallStack => [a] -> [a]
init String
s else String
s

runWithHooks :: DarcsCommand
             -> (AbsolutePath, AbsolutePath)
             -> [DarcsFlag] -> [String] -> IO ()
runWithHooks :: DarcsCommand
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
runWithHooks DarcsCommand
cmd (AbsolutePath
new_wd, AbsolutePath
old_wd) [DarcsFlag]
flags [String]
extra = do
   [MatchFlag] -> IO ()
checkMatchSyntax ([MatchFlag] -> IO ()) -> [MatchFlag] -> IO ()
forall a b. (a -> b) -> a -> b
$ PrimOptSpec DarcsOptDescr DarcsFlag a [MatchFlag]
MatchOption
matchAny MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
   -- set any global variables
   OptSpec
  DarcsOptDescr
  DarcsFlag
  (IO ())
  (Verbosity -> Bool -> Bool -> IO ())
-> (Verbosity -> Bool -> Bool -> IO ()) -> [DarcsFlag] -> IO ()
forall (d :: * -> *) f a b. OptSpec d f a b -> b -> [f] -> a
oparse (PrimOptSpec
  DarcsOptDescr DarcsFlag (Bool -> Bool -> IO ()) Verbosity
PrimDarcsOption Verbosity
verbosity PrimOptSpec
  DarcsOptDescr DarcsFlag (Bool -> Bool -> IO ()) Verbosity
-> OptSpec DarcsOptDescr DarcsFlag (IO ()) (Bool -> Bool -> IO ())
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (IO ())
     (Verbosity -> Bool -> Bool -> IO ())
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag (IO ()) (Bool -> Bool -> IO ())
forall a. DarcsOption a (Bool -> Bool -> a)
debugging) Verbosity -> Bool -> Bool -> IO ()
setGlobalVariables [DarcsFlag]
flags
   -- actually run the command and its hooks
   let hooksCfg :: HooksConfig
hooksCfg = (forall a. PrimOptSpec DarcsOptDescr DarcsFlag a HooksConfig)
-> [DarcsFlag] -> HooksConfig
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags DarcsOption a (HooksConfig -> a)
forall a. PrimOptSpec DarcsOptDescr DarcsFlag a HooksConfig
hooks [DarcsFlag]
flags
   let verb :: Verbosity
verb = PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr DarcsFlag a Verbosity
PrimDarcsOption Verbosity
verbosity [DarcsFlag]
flags
   preHookExitCode <- HookConfig -> Verbosity -> AbsolutePath -> IO ExitCode
runPrehook (HooksConfig -> HookConfig
pre HooksConfig
hooksCfg) Verbosity
verb AbsolutePath
new_wd
   if preHookExitCode /= ExitSuccess
      then exitWith preHookExitCode
      else do phDir <- getPosthookDir new_wd cmd flags extra
              commandCommand cmd (new_wd, old_wd) flags extra
              postHookExitCode <- runPosthook (post hooksCfg) verb phDir
              exitWith postHookExitCode

setGlobalVariables :: Verbosity -> Bool -> Bool -> IO ()
setGlobalVariables :: Verbosity -> Bool -> Bool -> IO ()
setGlobalVariables Verbosity
verb Bool
debug Bool
timings = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
timings IO ()
setTimingsMode
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug IO ()
setDebugMode
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verb Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
Quiet) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO ()
setProgressMode Bool
False
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Verbosity
verb Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
Quiet) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
atexit (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO ()
doCRCWarnings (Verbosity
verb Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
Verbose)

-- | Returns the working directory for the posthook. For most commands, the
-- first parameter is returned. For the \'get\' command, the path of the newly
-- created repository is returned if it is not an ssh url.
getPosthookDir :: AbsolutePath -> DarcsCommand -> [DarcsFlag] -> [String] -> IO AbsolutePath
getPosthookDir :: AbsolutePath
-> DarcsCommand -> [DarcsFlag] -> [String] -> IO AbsolutePath
getPosthookDir AbsolutePath
new_wd DarcsCommand
cmd [DarcsFlag]
flags [String]
extra | DarcsCommand -> String
commandName DarcsCommand
cmd String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"get",String
"clone"] = do
    case [String]
extra of
      [String
inrepodir, String
outname] -> AbsolutePath
-> DarcsCommand -> [DarcsFlag] -> [String] -> IO AbsolutePath
getPosthookDir AbsolutePath
new_wd DarcsCommand
cmd (String -> [DarcsFlag] -> [DarcsFlag]
withNewRepo String
outname [DarcsFlag]
flags) [String
inrepodir]
      [String
inrepodir] ->
        case [DarcsFlag] -> Maybe String
cloneToSSH [DarcsFlag]
flags of
         Maybe String
Nothing -> do
          repodir <- AbsoluteOrRemotePath -> String
forall a. FilePathOrURL a => a -> String
toPath (AbsoluteOrRemotePath -> String)
-> IO AbsoluteOrRemotePath -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO AbsoluteOrRemotePath
ioAbsoluteOrRemote String
inrepodir
          newRepo <- makeRepoName False flags repodir
          return $ makeAbsolute new_wd newRepo
         Maybe String
_ -> AbsolutePath -> IO AbsolutePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AbsolutePath
new_wd
      [String]
_ -> String -> IO AbsolutePath
forall a. String -> IO a
die String
"You must provide 'clone' with either one or two arguments."
getPosthookDir AbsolutePath
new_wd DarcsCommand
_ [DarcsFlag]
_ [String]
_ = AbsolutePath -> IO AbsolutePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AbsolutePath
new_wd


-- | Checks if the number of extra arguments matches the number of extra
-- arguments supported by the command as specified in `commandExtraArgs`.
-- Extra arguments are arguments that follow the command but aren't
-- considered a flag. In `darcs push xyz`, xyz would be an extra argument.
extraArgumentsError :: [String]             -- extra commands provided by user
                    -> DarcsCommand
                    -> Maybe DarcsCommand
                    -> Maybe String
extraArgumentsError :: [String] -> DarcsCommand -> Maybe DarcsCommand -> Maybe String
extraArgumentsError [String]
extra DarcsCommand
cmd Maybe DarcsCommand
msuper
    | Int
extraArgsCmd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe String
forall a. Maybe a
Nothing
    | Int
extraArgsInput Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
extraArgsCmd = String -> Maybe String
forall a. a -> Maybe a
Just String
badArg
    | Int
extraArgsInput Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
extraArgsCmd = String -> Maybe String
forall a. a -> Maybe a
Just String
missingArg
    | Bool
otherwise = Maybe String
forall a. Maybe a
Nothing
        where
            extraArgsInput :: Int
extraArgsInput = [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
extra
            extraArgsCmd :: Int
extraArgsCmd = DarcsCommand -> Int
commandExtraArgs DarcsCommand
cmd
            badArg :: String
badArg     = String
"Bad argument: `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
extra String -> String -> String
forall a. [a] -> [a] -> [a]
++
                         String
"'\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe DarcsCommand -> DarcsCommand -> String
getCommandMiniHelp Maybe DarcsCommand
msuper DarcsCommand
cmd
            missingArg :: String
missingArg = String
"Missing argument:  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall {t}. (Eq t, Num t) => t -> String
nthArg ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
extra Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> String -> String
forall a. [a] -> [a] -> [a]
++
                         String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe DarcsCommand -> DarcsCommand -> String
getCommandMiniHelp Maybe DarcsCommand
msuper DarcsCommand
cmd
            nthArg :: t -> String
nthArg t
n       = t -> [String] -> String
forall {t} {t}. (Eq t, Num t, IsString t) => t -> [t] -> t
nthOf t
n (DarcsCommand -> [String]
commandExtraArgHelp DarcsCommand
cmd)
            nthOf :: t -> [t] -> t
nthOf t
1 (t
h:[t]
_)  = t
h
            nthOf t
n (t
_:[t]
hs) = t -> [t] -> t
nthOf (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [t]
hs
            nthOf t
_ []     = t
"UNDOCUMENTED"

optionList :: [OptDescr DarcsFlag] -> [String]
optionList :: [OptDescr DarcsFlag] -> [String]
optionList = (OptDescr DarcsFlag -> [String])
-> [OptDescr DarcsFlag] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap OptDescr DarcsFlag -> [String]
forall {a}. OptDescr a -> [String]
names
  where
    names :: OptDescr a -> [String]
names (Option String
sos [String]
los ArgDescr a
_ String
desc) =
      (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Char -> String
short String
desc) String
sos [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
long String
desc) [String]
los
    short :: String -> Char -> String
short String
d Char
o = Char
'-' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
o Char -> String -> String
forall a. a -> [a] -> [a]
: String
";" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d
    long :: String -> String -> String
long String
d String
o = String
"--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d

runRawSupercommand :: DarcsCommand -> [String] -> IO ()
runRawSupercommand :: DarcsCommand -> [String] -> IO ()
runRawSupercommand DarcsCommand
super [] =
  String -> IO ()
forall a. String -> IO a
die (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> String
renderString (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$
    Doc
"Command '" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (DarcsCommand -> String
commandName DarcsCommand
super) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"' requires a subcommand!"
    Doc -> Doc -> Doc
$+$
    DarcsCommand -> Doc
subusage DarcsCommand
super
runRawSupercommand DarcsCommand
super [String]
args = do
  cwd <- IO AbsolutePath
getCurrentDirectory
  case fixupMsgs $ getOpt RequireOrder (map (optDescr cwd) (odesc stdCmdActions)) args of
    -- note: we do not apply defaults here
    ([DarcsFlag]
flags,[String]
_,[String]
getopt_errs) -> case (forall a.
 PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe StdCmdAction))
-> [DarcsFlag] -> Maybe StdCmdAction
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe StdCmdAction)
forall a.
PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe StdCmdAction)
stdCmdActions [DarcsFlag]
flags of
      Just StdCmdAction
Help ->
        Doc -> IO ()
viewDoc (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe DarcsCommand -> DarcsCommand -> Doc
getCommandHelp Maybe DarcsCommand
forall a. Maybe a
Nothing DarcsCommand
super
      Just StdCmdAction
ListOptions -> do
        String -> IO ()
putStrLn String
"--help"
        (DarcsCommand -> IO ()) -> [DarcsCommand] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn (String -> IO ())
-> (DarcsCommand -> String) -> DarcsCommand -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DarcsCommand -> String
commandName) ([CommandControl] -> [DarcsCommand]
extractCommands ([CommandControl] -> [DarcsCommand])
-> [CommandControl] -> [DarcsCommand]
forall a b. (a -> b) -> a -> b
$ DarcsCommand -> [CommandControl]
getSubcommands DarcsCommand
super)
      Just StdCmdAction
Disable -> do
        String -> IO ()
forall a. String -> IO a
die (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> String
renderString (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$
          Doc
"Command" Doc -> Doc -> Doc
<+> String -> Doc
text (DarcsCommand -> String
commandName DarcsCommand
super) Doc -> Doc -> Doc
<+> Doc
"disabled with --disable option!"
      Maybe StdCmdAction
Nothing ->
        String -> IO ()
forall a. String -> IO a
die (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> String
renderString (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$
          case [String]
getopt_errs of
            [] -> String -> Doc
text String
"Invalid subcommand!" Doc -> Doc -> Doc
$+$ DarcsCommand -> Doc
subusage DarcsCommand
super
            [String]
_ -> [Doc] -> Doc
vcat ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [String]
getopt_errs)