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

-- | 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 ) where

import Prelude ()
import Darcs.Prelude

import Data.List ( intercalate )
import Control.Monad ( unless, when )
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(..)
    , anyVerbosity, verbosity, Verbosity(..), network, NetworkOptions(..)
    , HooksConfig(..), hooks )

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

import Darcs.Patch.Match ( checkMatchSyntax )
import Darcs.Repository.Prefs ( getGlobal, getPreflist )
import Darcs.Repository.Test ( runPosthook, runPrehook )
import Darcs.Util.AtExit ( atexit )
import Darcs.Util.Download ( setDebugHTTP, disableHTTPPipelining )
import Darcs.Util.Exception ( die )
import Darcs.Util.Global ( setDebugMode, setTimingsMode )
import Darcs.Util.Path ( AbsolutePath, getCurrentDirectory, toPath, ioAbsoluteOrRemote, makeAbsolute )
import Darcs.Util.Progress ( setProgressMode )
import Darcs.Util.Text ( chompTrailingNewline, quote )

runTheCommand :: [CommandControl] -> String -> [String] -> IO ()
runTheCommand :: [CommandControl] -> String -> [String] -> IO ()
runTheCommand commandControlList :: [CommandControl]
commandControlList cmd :: String
cmd args :: [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 c :: DarcsCommand parsedFlags
c,       as :: [String]
as) = Maybe (DarcsCommand Any)
-> DarcsCommand parsedFlags -> [String] -> IO ()
forall pf1 pf2.
Maybe (DarcsCommand pf1) -> DarcsCommand pf2 -> [String] -> IO ()
runCommand Maybe (DarcsCommand Any)
forall a. Maybe a
Nothing DarcsCommand parsedFlags
c [String]
as
  rtc (SuperCommandOnly c :: DarcsCommand parsedFlags
c,  as :: [String]
as) = DarcsCommand parsedFlags -> [String] -> IO ()
forall pf. DarcsCommand pf -> [String] -> IO ()
runRawSupercommand DarcsCommand parsedFlags
c [String]
as
  rtc (SuperCommandSub c :: DarcsCommand parsedFlags1
c s :: DarcsCommand parsedFlags2
s, as :: [String]
as) = Maybe (DarcsCommand parsedFlags1)
-> DarcsCommand parsedFlags2 -> [String] -> IO ()
forall pf1 pf2.
Maybe (DarcsCommand pf1) -> DarcsCommand pf2 -> [String] -> IO ()
runCommand (DarcsCommand parsedFlags1 -> Maybe (DarcsCommand parsedFlags1)
forall a. a -> Maybe a
Just DarcsCommand parsedFlags1
c) DarcsCommand parsedFlags2
s [String]
as

runCommand :: Maybe (DarcsCommand pf1) -> DarcsCommand pf2 -> [String] -> IO ()
runCommand :: Maybe (DarcsCommand pf1) -> DarcsCommand pf2 -> [String] -> IO ()
runCommand _ _ args :: [String]
args -- Check for "dangerous" typoes...
    | "-all" String -> [String] -> 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 "Are you sure you didn't mean --all rather than -all?"
runCommand msuper :: Maybe (DarcsCommand pf1)
msuper cmd :: DarcsCommand pf2
cmd args :: [String]
args = do
  AbsolutePath
old_wd <- IO AbsolutePath
getCurrentDirectory
  let options :: [OptDescr DarcsFlag]
options = AbsolutePath -> DarcsCommand pf2 -> [OptDescr DarcsFlag]
forall pf. AbsolutePath -> DarcsCommand pf -> [OptDescr DarcsFlag]
commandOptions AbsolutePath
old_wd DarcsCommand pf2
cmd
  case ([DarcsFlag], [String], [String])
-> ([DarcsFlag], [String], [String])
forall a b. (a, b, [String]) -> (a, b, [String])
fixupMsgs (([DarcsFlag], [String], [String])
 -> ([DarcsFlag], [String], [String]))
-> ([DarcsFlag], [String], [String])
-> ([DarcsFlag], [String], [String])
forall a b. (a -> b) -> a -> b
$ ArgOrder DarcsFlag
-> [OptDescr DarcsFlag]
-> [String]
-> ([DarcsFlag], [String], [String])
forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt ArgOrder DarcsFlag
forall a. ArgOrder a
Permute [OptDescr DarcsFlag]
options [String]
args of
    (cmdline_flags :: [DarcsFlag]
cmdline_flags,orig_extra :: [String]
orig_extra,getopt_errs :: [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.
      Either String ()
prereq_errors <- DarcsCommand pf2 -> [DarcsFlag] -> IO (Either String ())
forall parsedFlags.
DarcsCommand parsedFlags -> [DarcsFlag] -> IO (Either String ())
commandPrereq DarcsCommand pf2
cmd [DarcsFlag]
cmdline_flags
      -- we must get the cwd again because commandPrereq has the side-effect of changing it.
      AbsolutePath
new_wd <- IO AbsolutePath
getCurrentDirectory
      [String]
user_defs <- String -> IO [String]
getGlobal   "defaults"
      [String]
repo_defs <- String -> IO [String]
getPreflist "defaults"
      let (flags :: [DarcsFlag]
flags,flag_errors :: [String]
flag_errors) =
            Maybe String
-> DarcsCommand pf2
-> AbsolutePath
-> [String]
-> [String]
-> [DarcsFlag]
-> ([DarcsFlag], [String])
forall pf.
Maybe String
-> DarcsCommand pf
-> AbsolutePath
-> [String]
-> [String]
-> [DarcsFlag]
-> ([DarcsFlag], [String])
applyDefaults ((DarcsCommand pf1 -> String)
-> Maybe (DarcsCommand pf1) -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DarcsCommand pf1 -> String
forall parsedFlags. DarcsCommand parsedFlags -> String
commandName Maybe (DarcsCommand pf1)
msuper) DarcsCommand pf2
cmd AbsolutePath
old_wd [String]
user_defs [String]
repo_defs [DarcsFlag]
cmdline_flags
      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 forall a.
PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe StdCmdAction)
stdCmdActions [DarcsFlag]
flags of
        Just Help -> Doc -> IO ()
viewDoc (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (DarcsCommand pf1) -> DarcsCommand pf2 -> Doc
forall pf1 pf2. Maybe (DarcsCommand pf1) -> DarcsCommand pf2 -> Doc
getCommandHelp Maybe (DarcsCommand pf1)
msuper DarcsCommand pf2
cmd
        Just ListOptions -> do
          Bool -> IO ()
setProgressMode Bool
False
          [String]
possible_args <- DarcsCommand pf2
-> (AbsolutePath, AbsolutePath)
-> [DarcsFlag]
-> [String]
-> IO [String]
forall parsedFlags.
DarcsCommand parsedFlags
-> (AbsolutePath, AbsolutePath)
-> [DarcsFlag]
-> [String]
-> IO [String]
commandCompleteArgs DarcsCommand pf2
cmd (AbsolutePath
new_wd, AbsolutePath
old_wd) [DarcsFlag]
flags [String]
orig_extra
          (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ [OptDescr DarcsFlag] -> [String]
optionList [OptDescr DarcsFlag]
options [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
possible_args
        Just Disable ->
          String -> IO ()
forall a. String -> IO a
die (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Command "String -> String -> String
forall a. [a] -> [a] -> [a]
++DarcsCommand pf2 -> String
forall parsedFlags. DarcsCommand parsedFlags -> String
commandName DarcsCommand pf2
cmdString -> String -> String
forall a. [a] -> [a] -> [a]
++" disabled with --disable option!"
        Nothing -> case Either String ()
prereq_errors of
          Left complaint :: String
complaint -> String -> IO ()
forall a. String -> IO a
die (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
            "Unable to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
quote ("darcs " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe (DarcsCommand pf1) -> String
forall pf. Maybe (DarcsCommand pf) -> String
superName Maybe (DarcsCommand pf1)
msuper String -> String -> String
forall a. [a] -> [a] -> [a]
++ DarcsCommand pf2 -> String
forall parsedFlags. DarcsCommand parsedFlags -> String
commandName DarcsCommand pf2
cmd) String -> String -> String
forall a. [a] -> [a] -> [a]
++
            " here.\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
complaint
          Right () -> case [String]
getopt_errs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
flag_errors of
            [] -> do
              [String]
extra <- DarcsCommand pf2
-> [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
forall parsedFlags.
DarcsCommand parsedFlags
-> [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults DarcsCommand pf2
cmd [DarcsFlag]
flags AbsolutePath
old_wd [String]
orig_extra
              case [String]
-> DarcsCommand pf2 -> Maybe (DarcsCommand pf1) -> Maybe String
forall pf1 pf2.
[String]
-> DarcsCommand pf1 -> Maybe (DarcsCommand pf2) -> Maybe String
extraArgumentsError [String]
extra DarcsCommand pf2
cmd Maybe (DarcsCommand pf1)
msuper of
                Nothing     -> DarcsCommand pf2
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
forall pf.
DarcsCommand pf
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
runWithHooks DarcsCommand pf2
cmd (AbsolutePath
new_wd, AbsolutePath
old_wd) [DarcsFlag]
flags [String]
extra
                Just msg :: String
msg    -> String -> IO ()
forall a. String -> IO a
die String
msg
            es :: [String]
es -> String -> IO ()
forall a. String -> IO a
die (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n" [String]
es)

fixupMsgs :: (a, b, [String]) -> (a, b, [String])
fixupMsgs :: (a, b, [String]) -> (a, b, [String])
fixupMsgs (fs :: a
fs,as :: b
as,es :: [String]
es) = (a
fs,b
as,(String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (("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)

runWithHooks :: DarcsCommand pf
             -> (AbsolutePath, AbsolutePath)
             -> [DarcsFlag] -> [String] -> IO ()
runWithHooks :: DarcsCommand pf
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
runWithHooks cmd :: DarcsCommand pf
cmd (new_wd :: AbsolutePath
new_wd, old_wd :: AbsolutePath
old_wd) flags :: [DarcsFlag]
flags extra :: [String]
extra = do
   [MatchFlag] -> IO ()
checkMatchSyntax ([MatchFlag] -> IO ()) -> [MatchFlag] -> IO ()
forall a b. (a -> b) -> a -> b
$ 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 ())
  (Bool -> Bool -> Verbosity -> Bool -> NetworkOptions -> IO ())
-> (Bool -> Bool -> Verbosity -> Bool -> NetworkOptions -> IO ())
-> [DarcsFlag]
-> IO ()
forall (d :: * -> *) f a b. OptSpec d f a b -> b -> [f] -> a
oparse (DarcsOption
  (NetworkOptions -> IO ())
  (Bool -> Bool -> Verbosity -> Bool -> NetworkOptions -> IO ())
forall a. DarcsOption a (Bool -> Bool -> Verbosity -> Bool -> a)
anyVerbosity DarcsOption
  (NetworkOptions -> IO ())
  (Bool -> Bool -> Verbosity -> Bool -> NetworkOptions -> IO ())
-> OptSpec
     DarcsOptDescr DarcsFlag (IO ()) (NetworkOptions -> IO ())
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (IO ())
     (Bool -> Bool -> Verbosity -> Bool -> NetworkOptions -> 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 ()) (NetworkOptions -> IO ())
PrimDarcsOption NetworkOptions
network) Bool -> Bool -> Verbosity -> Bool -> NetworkOptions -> 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 forall a. PrimOptSpec DarcsOptDescr DarcsFlag a HooksConfig
hooks [DarcsFlag]
flags
   let verb :: Verbosity
verb = (forall a. PrimOptSpec DarcsOptDescr DarcsFlag a Verbosity)
-> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag a Verbosity
verbosity [DarcsFlag]
flags
   ExitCode
preHookExitCode <- HookConfig -> Verbosity -> AbsolutePath -> IO ExitCode
runPrehook (HooksConfig -> HookConfig
pre HooksConfig
hooksCfg) Verbosity
verb AbsolutePath
new_wd
   if ExitCode
preHookExitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
      then ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith ExitCode
preHookExitCode
      else do [DarcsFlag]
fixedFlags <- AbsolutePath -> [DarcsFlag] -> IO [DarcsFlag]
fixRemoteRepos AbsolutePath
old_wd [DarcsFlag]
flags
              AbsolutePath
phDir <- AbsolutePath
-> DarcsCommand pf -> [DarcsFlag] -> [String] -> IO AbsolutePath
forall pf.
AbsolutePath
-> DarcsCommand pf -> [DarcsFlag] -> [String] -> IO AbsolutePath
getPosthookDir AbsolutePath
new_wd DarcsCommand pf
cmd [DarcsFlag]
fixedFlags [String]
extra
              let parsedFlags :: pf
parsedFlags = DarcsCommand pf -> [DarcsFlag] -> pf
forall parsedFlags.
DarcsCommand parsedFlags -> [DarcsFlag] -> parsedFlags
commandParseOptions DarcsCommand pf
cmd [DarcsFlag]
fixedFlags
              DarcsCommand pf
-> (AbsolutePath, AbsolutePath) -> pf -> [String] -> IO ()
forall parsedFlags.
DarcsCommand parsedFlags
-> (AbsolutePath, AbsolutePath) -> parsedFlags -> [String] -> IO ()
commandCommand DarcsCommand pf
cmd (AbsolutePath
new_wd, AbsolutePath
old_wd) pf
parsedFlags [String]
extra
              ExitCode
postHookExitCode <- HookConfig -> Verbosity -> AbsolutePath -> IO ExitCode
runPosthook (HooksConfig -> HookConfig
post HooksConfig
hooksCfg) Verbosity
verb AbsolutePath
phDir
              ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith ExitCode
postHookExitCode

setGlobalVariables :: Bool -> Bool -> Verbosity -> Bool -> NetworkOptions -> IO ()
setGlobalVariables :: Bool -> Bool -> Verbosity -> Bool -> NetworkOptions -> IO ()
setGlobalVariables debug :: Bool
debug debugHttp :: Bool
debugHttp verb :: Verbosity
verb timings :: Bool
timings net :: NetworkOptions
net = 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 Bool
debugHttp IO ()
setDebugHTTP
  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 ()
when (NetworkOptions -> Bool
noHttpPipelining NetworkOptions
net) IO ()
disableHTTPPipelining
  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 pf -> [DarcsFlag] -> [String] -> IO AbsolutePath
getPosthookDir :: AbsolutePath
-> DarcsCommand pf -> [DarcsFlag] -> [String] -> IO AbsolutePath
getPosthookDir new_wd :: AbsolutePath
new_wd cmd :: DarcsCommand pf
cmd flags :: [DarcsFlag]
flags extra :: [String]
extra | DarcsCommand pf -> String
forall parsedFlags. DarcsCommand parsedFlags -> String
commandName DarcsCommand pf
cmd String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["get","clone"] = do
    case [String]
extra of
      [inrepodir :: String
inrepodir, outname :: String
outname] -> AbsolutePath
-> DarcsCommand pf -> [DarcsFlag] -> [String] -> IO AbsolutePath
forall pf.
AbsolutePath
-> DarcsCommand pf -> [DarcsFlag] -> [String] -> IO AbsolutePath
getPosthookDir AbsolutePath
new_wd DarcsCommand pf
cmd (String -> DarcsFlag
NewRepo String
outnameDarcsFlag -> [DarcsFlag] -> [DarcsFlag]
forall a. a -> [a] -> [a]
:[DarcsFlag]
flags) [String
inrepodir]
      [inrepodir :: String
inrepodir] ->
        case [DarcsFlag] -> Maybe String
cloneToSSH [DarcsFlag]
flags of
         Nothing -> do
          String
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
          String
reponame <- Bool -> [DarcsFlag] -> String -> IO String
makeRepoName Bool
False [DarcsFlag]
flags String
repodir
          AbsolutePath -> IO AbsolutePath
forall (m :: * -> *) a. Monad m => a -> m a
return (AbsolutePath -> IO AbsolutePath)
-> AbsolutePath -> IO AbsolutePath
forall a b. (a -> b) -> a -> b
$ AbsolutePath -> String -> AbsolutePath
makeAbsolute AbsolutePath
new_wd String
reponame
         _ -> AbsolutePath -> IO AbsolutePath
forall (m :: * -> *) a. Monad m => a -> m a
return AbsolutePath
new_wd
      _ -> String -> IO AbsolutePath
forall a. String -> IO a
die "You must provide 'clone' with either one or two arguments."
getPosthookDir new_wd :: AbsolutePath
new_wd _ _ _ = AbsolutePath -> IO AbsolutePath
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 pf1
                    -> Maybe (DarcsCommand pf2)
                    -> Maybe String
extraArgumentsError :: [String]
-> DarcsCommand pf1 -> Maybe (DarcsCommand pf2) -> Maybe String
extraArgumentsError extra :: [String]
extra cmd :: DarcsCommand pf1
cmd msuper :: Maybe (DarcsCommand pf2)
msuper
    | Int
extraArgsCmd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 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 (t :: * -> *) a. Foldable t => t a -> Int
length [String]
extra
            extraArgsCmd :: Int
extraArgsCmd = DarcsCommand pf1 -> Int
forall parsedFlags. DarcsCommand parsedFlags -> Int
commandExtraArgs DarcsCommand pf1
cmd
            badArg :: String
badArg     = "Bad argument: `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
extra String -> String -> String
forall a. [a] -> [a] -> [a]
++
                         "'\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe (DarcsCommand pf2) -> DarcsCommand pf1 -> String
forall pf1 pf2.
Maybe (DarcsCommand pf1) -> DarcsCommand pf2 -> String
getCommandMiniHelp Maybe (DarcsCommand pf2)
msuper DarcsCommand pf1
cmd
            missingArg :: String
missingArg = "Missing argument:  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall t. (Eq t, Num t) => t -> String
nthArg ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
extra Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) String -> String -> String
forall a. [a] -> [a] -> [a]
++
                         "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe (DarcsCommand pf2) -> DarcsCommand pf1 -> String
forall pf1 pf2.
Maybe (DarcsCommand pf1) -> DarcsCommand pf2 -> String
getCommandMiniHelp Maybe (DarcsCommand pf2)
msuper DarcsCommand pf1
cmd
            nthArg :: t -> String
nthArg n :: t
n       = t -> [String] -> String
forall t. (Eq t, Num t) => t -> [String] -> String
nthOf t
n (DarcsCommand pf1 -> [String]
forall parsedFlags. DarcsCommand parsedFlags -> [String]
commandExtraArgHelp DarcsCommand pf1
cmd)
            nthOf :: t -> [String] -> String
nthOf 1 (h :: String
h:_)  = String
h
            nthOf n :: t
n (_:hs :: [String]
hs) = t -> [String] -> String
nthOf (t
nt -> t -> t
forall a. Num a => a -> a -> a
-1) [String]
hs
            nthOf _ []     = "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 sos :: String
sos los :: [String]
los _ desc :: 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 d :: String
d o :: Char
o = '-' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
o Char -> String -> String
forall a. a -> [a] -> [a]
: ";" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d
    long :: String -> String -> String
long d :: String
d o :: String
o = "--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ ";" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d

runRawSupercommand :: DarcsCommand pf -> [String] -> IO ()
runRawSupercommand :: DarcsCommand pf -> [String] -> IO ()
runRawSupercommand super :: DarcsCommand pf
super [] =
    String -> IO ()
forall a. String -> IO a
die (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Command '"String -> String -> String
forall a. [a] -> [a] -> [a]
++ DarcsCommand pf -> String
forall parsedFlags. DarcsCommand parsedFlags -> String
commandName DarcsCommand pf
super String -> String -> String
forall a. [a] -> [a] -> [a]
++"' requires a subcommand!\n\n"
             String -> String -> String
forall a. [a] -> [a] -> [a]
++ DarcsCommand pf -> String
forall parsedFlags. DarcsCommand parsedFlags -> String
subusage DarcsCommand pf
super
runRawSupercommand super :: DarcsCommand pf
super args :: [String]
args = do
  AbsolutePath
cwd <- IO AbsolutePath
getCurrentDirectory
  case ([DarcsFlag], [String], [String])
-> ([DarcsFlag], [String], [String])
forall a b. (a, b, [String]) -> (a, b, [String])
fixupMsgs (([DarcsFlag], [String], [String])
 -> ([DarcsFlag], [String], [String]))
-> ([DarcsFlag], [String], [String])
-> ([DarcsFlag], [String], [String])
forall a b. (a -> b) -> a -> b
$ ArgOrder DarcsFlag
-> [OptDescr DarcsFlag]
-> [String]
-> ([DarcsFlag], [String], [String])
forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt ArgOrder DarcsFlag
forall a. ArgOrder a
RequireOrder ((DarcsOptDescr DarcsFlag -> OptDescr DarcsFlag)
-> [DarcsOptDescr DarcsFlag] -> [OptDescr DarcsFlag]
forall a b. (a -> b) -> [a] -> [b]
map (AbsolutePath -> DarcsOptDescr DarcsFlag -> OptDescr DarcsFlag
forall f. AbsolutePath -> DarcsOptDescr f -> OptDescr f
optDescr AbsolutePath
cwd) (OptSpec DarcsOptDescr DarcsFlag Any (Maybe StdCmdAction -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec DarcsOptDescr DarcsFlag Any (Maybe StdCmdAction -> Any)
forall a.
PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe StdCmdAction)
stdCmdActions)) [String]
args of
    -- note: we do not apply defaults here
    (flags :: [DarcsFlag]
flags,_,getopt_errs :: [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 forall a.
PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe StdCmdAction)
stdCmdActions [DarcsFlag]
flags of
      Just Help ->
        Doc -> IO ()
viewDoc (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (DarcsCommand Any) -> DarcsCommand pf -> Doc
forall pf1 pf2. Maybe (DarcsCommand pf1) -> DarcsCommand pf2 -> Doc
getCommandHelp Maybe (DarcsCommand Any)
forall a. Maybe a
Nothing DarcsCommand pf
super
      Just ListOptions -> do
        String -> IO ()
putStrLn "--help"
        (WrappedCommand -> IO ()) -> [WrappedCommand] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn (String -> IO ())
-> (WrappedCommand -> String) -> WrappedCommand -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedCommand -> String
wrappedCommandName) ([CommandControl] -> [WrappedCommand]
extractCommands ([CommandControl] -> [WrappedCommand])
-> [CommandControl] -> [WrappedCommand]
forall a b. (a -> b) -> a -> b
$ DarcsCommand pf -> [CommandControl]
forall pf. DarcsCommand pf -> [CommandControl]
getSubcommands DarcsCommand pf
super)
      Just Disable -> do
        String -> IO ()
forall a. String -> IO a
die (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Command " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DarcsCommand pf -> String
forall parsedFlags. DarcsCommand parsedFlags -> String
commandName DarcsCommand pf
super String -> String -> String
forall a. [a] -> [a] -> [a]
++
               " disabled with --disable option!"
      Nothing -> String -> IO ()
forall a. String -> IO a
die (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ case [String]
getopt_errs of
        [] -> "Invalid subcommand!\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ DarcsCommand pf -> String
forall parsedFlags. DarcsCommand parsedFlags -> String
subusage DarcsCommand pf
super
        _ -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n" [String]
getopt_errs