-- 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.moduleDarcs.Commands(CommandControl(CommandData,HiddenCommand,GroupName),DarcsCommand(DarcsCommand,commandProgramName,commandName,commandHelp,commandDescription,commandBasicOptions,commandAdvancedOptions,commandCommand,commandPrereq,commandExtraArgHelp,commandExtraArgs,commandArgdefaults,commandGetArgPossibilities,SuperCommand,commandSubCommands),commandAlias,commandStub,commandOptions,commandAlloptions,disambiguateCommands,CommandArgs(..),getCommandHelp,getCommandMiniHelp,getSubcommands,usage,usageHelper,subusage,chompNewline,extractCommands,superName,nodefaults,putInfo,putVerbose,putWarning,abortRun)whereimportSystem.Console.GetOpt(OptDescr,usageInfo)importControl.Monad(when,unless)importData.List(sort,isPrefixOf)importDarcs.Arguments(DarcsFlag(Quiet,Verbose,DryRun),DarcsOption,disable,help,anyVerbosity,noCache,posthookCmd,posthookPrompt,prehookCmd,prehookPrompt,optionFromDarcsOption)importDarcs.RepoPath(AbsolutePath,rootDirectory)importPrinter(Doc,putDocLn,hPutDocLn,text,(<+>),errorDoc)importSystem.IO(stderr)extractCommands,extractHiddenCommands::[CommandControl]->[DarcsCommand]extractCommandscs=concatMap(\x->casexof{CommandDatacmd_d->[cmd_d];_->[]})csextractHiddenCommandscs=concatMap(\x->casexof{HiddenCommandcmd_d->[cmd_d];_->[]})csdataCommandControl=CommandDataDarcsCommand|HiddenCommandDarcsCommand|GroupNameStringdataDarcsCommand=DarcsCommand{commandProgramName,commandName,commandHelp,commandDescription::String,commandExtraArgs::Int,commandExtraArgHelp::[String],commandCommand::[DarcsFlag]->[String]->IO(),commandPrereq::[DarcsFlag]->IO(EitherString()),commandGetArgPossibilities::IO[String],commandArgdefaults::[DarcsFlag]->AbsolutePath->[String]->IO[String],commandBasicOptions::[DarcsOption],commandAdvancedOptions::[DarcsOption]}|SuperCommand{commandProgramName,commandName,commandHelp,commandDescription::String,commandPrereq::[DarcsFlag]->IO(EitherString()),commandSubCommands::[CommandControl]}commandAlloptions::DarcsCommand->([DarcsOption],[DarcsOption])commandAlloptionsDarcsCommand{commandBasicOptions=opts1,commandAdvancedOptions=opts2}=(opts1++[disable,help],anyVerbosity++opts2++[noCache,posthookCmd,posthookPrompt,prehookCmd,prehookPrompt])-- Supercommands cannot be disabled.commandAlloptionsSuperCommand{}=([help],[])-- Obtain options suitable as input to-- System.Console.Getopt, including the --disable option (which is-- not listed explicitly in the DarcsCommand definitions).commandOptions::AbsolutePath->DarcsCommand->([OptDescrDarcsFlag],[OptDescrDarcsFlag])commandOptionscwdc=(convertbasic,convertadvanced)where(basic,advanced)=commandAlloptionscconvert=concatMap(optionFromDarcsOptioncwd)nodefaults::[DarcsFlag]->AbsolutePath->[String]->IO[String]nodefaults__xs=returnxsgetSubcommands::DarcsCommand->[CommandControl]getSubcommandsc@(SuperCommand{})=commandSubCommandscgetSubcommands_=[]commandAlias::String->MaybeDarcsCommand->DarcsCommand->DarcsCommandcommandAliasnmsuperc=c{commandName=n,commandDescription="Alias for `"++commandProgramNamec++" "++cmdName++"'.",commandHelp="The `"++commandProgramNamec++" "++n++"' command is an alias for "++"`"++commandProgramNamec++" "++cmdName++"'.\n"++commandHelpc}wherecmdName=unwords.mapcommandName.maybeid(:)msuper$[c]commandStub::String->String->String->DarcsCommand->DarcsCommandcommandStubnhdc=c{commandName=n,commandHelp=h,commandDescription=d,commandCommand=\__->putStrh}usage::[CommandControl]->Stringusagecs="Usage: darcs COMMAND ...\n\nCommands:\n"++usageHelpercs++"\n"++"Use 'darcs COMMAND --help' for help on a single command.\n"++"Use 'darcs --version' to see the darcs version number.\n"++"Use 'darcs --exact-version' to get the exact version of this darcs instance.\n"++"Use 'darcs help patterns' for help on patch matching.\n"++"Use 'darcs help environment' for help on environment variables.\n"++"\n"++"Check bug reports at http://bugs.darcs.net/\n"subusage::DarcsCommand->Stringsubusagesuper=(usageInfo("Usage: "++commandProgramNamesuper++" "++commandNamesuper++" SUBCOMMAND ... "++"\n\n"++commandDescriptionsuper++"\n\nSubcommands:\n"++usageHelper(getSubcommandssuper)++"\nOptions:")(optionFromDarcsOptionrootDirectoryhelp))++"\n"++commandHelpsuperusageHelper::[CommandControl]->StringusageHelper[]=""usageHelper(HiddenCommand_:cs)=usageHelpercsusageHelper((CommandDatac):cs)=" "++padSpaces(commandNamec)15++chompNewline(commandDescriptionc)++"\n"++usageHelpercsusageHelper((GroupNamen):cs)="\n"++n++"\n"++usageHelpercschompNewline::String->StringchompNewline""=""chompNewlines=iflasts=='\n'theninitselsespadSpaces::String->Int->StringpadSpacessn=s++replicate(n-lengths)' 'superName::MaybeDarcsCommand->StringsuperNameNothing=""superName(Justx)=commandNamex++" "getCommandMiniHelp::MaybeDarcsCommand->DarcsCommand->StringgetCommandMiniHelpmsupercmd=getCommandHelpCoremsupercmd++"\n\nSee "++commandProgramNamecmd++" help "++(maybe""(\c->commandNamec++" ")msuper)++commandNamecmd++" for details."getCommandHelp::MaybeDarcsCommand->DarcsCommand->StringgetCommandHelpmsupercmd=unlines(reversebasicR)++(ifnulladvancedthen""else"\nAdvanced options:\n"++unlines(reverseadvancedR))++"\n"++commandHelpcmdwhere-- we could just call usageInfo twice, but then the advanced-- options might not line up with the basic ones (no short flags)(advancedR,basicR)=splitAt(lengthadvanced)$reverse$linescombinedUsagecombinedUsage=usageInfo(getCommandHelpCoremsupercmd++subcommands++"\n\nOptions:")(basic++advanced)(basic,advanced)=commandOptionsrootDirectorycmdsubcommands=casemsuperofNothing->casegetSubcommandscmdof[]->[]s->"\n\nSubcommands:\n"++(usageHelpers)-- we don't want to list subcommands if we're already specifying themJust_->""getCommandHelpCore::MaybeDarcsCommand->DarcsCommand->StringgetCommandHelpCoremsupercmd="Usage: "++commandProgramNamecmd++" "++superNamemsuper++commandNamecmd++" [OPTION]... "++unwordsargs_help++"\n"++commandDescriptioncmdwhereargs_help=casecmdof(DarcsCommand{})->commandExtraArgHelpcmd_->[]dataCommandArgs=CommandOnlyDarcsCommand|SuperCommandOnlyDarcsCommand|SuperCommandSubDarcsCommandDarcsCommand-- Parses a darcs command line with potentially abbreviated commandsdisambiguateCommands::[CommandControl]->String->[String]->EitherString(CommandArgs,[String])disambiguateCommandsallcscmdargs=doc<-extractcmdallcscase(getSubcommandsc,args)of([],_)->return(CommandOnlyc,args)(_,[])->return(SuperCommandOnlyc,args)(subcs,(a:as))->caseextractasubcsofLeft_->return(SuperCommandOnlyc,args)Rightsc->return(SuperCommandSubcsc,as)extract::String->[CommandControl]->EitherStringDarcsCommandextractcmdcs=case[c|c<-extractCommandscs,cmd`isPrefixOf`commandNamec]++[h|h<-extractHiddenCommandscs,cmd==commandNameh]of[]->Left$"No such command '"++cmd++"'\n"[c]->Rightccs'->Left$"Ambiguous command...\n\n"++"The command '"++cmd++"' could mean one of:\n"++unwords(sort$mapcommandNamecs')amVerbose::[DarcsFlag]->BoolamVerbose=elemVerboseamQuiet::[DarcsFlag]->BoolamQuiet=elemQuietputVerbose::[DarcsFlag]->Doc->IO()putVerboseopts=when(amVerboseopts).putDocLnputInfo::[DarcsFlag]->Doc->IO()putInfoopts=unless(amQuietopts).putDocLnputWarning::[DarcsFlag]->Doc->IO()putWarningopts=unless(amQuietopts).hPutDocLnstderrabortRun::[DarcsFlag]->Doc->IO()abortRunoptsmsg=ifDryRun`elem`optsthenputInfoopts$text"NOTE:"<+>msgelseerrorDocmsg