{-# OPTIONS_GHC -cpp #-}{-# LANGUAGE CPP #-}moduleDarcs.Commands.Put(put)whereimportSystem.Exit(ExitCode(ExitSuccess,ExitFailure),exitWith)importControl.Monad(when)importData.Maybe(catMaybes)importSystem.Directory(createDirectory)importStorage.Hashed.Tree(emptyTree)importDarcs.Commands(DarcsCommand(..),nodefaults,putVerbose,putInfo)importDarcs.Arguments(DarcsFlag(UseFormat2,UseHashedInventory,UseOldFashionedInventory),applyas,matchOneContext,fixUrl,networkOptions,flagToString,getInventoryChoices,setScriptsExecutableOption,workingRepoDir,setDefault)importDarcs.Repository(withRepoReadLock,($-),patchSetToPatches,readRepo,amInRepository)importDarcs.Repository.Format(identifyRepoFormat,RepoProperty(Darcs2,HashedInventory),formatHas)importDarcs.Patch.Bundle(makeBundle2)importDarcs.Patch.Set(PatchSet)#ifdef GADT_WITNESSESimportDarcs.Patch.Set(Origin)#endifimportDarcs.Witnesses.Ordered(FL(..),RL(..),nullFL,EqCheck(..),unsafeCoerceP)importDarcs.Match(havePatchsetMatch,getOnePatchset)importDarcs.Repository.Prefs(getPreflist,setDefaultrepo)importDarcs.URL(isUrl,isFile)importDarcs.Utils(withCurrentDirectory)importProgress(debugMessage)importDarcs.RepoPath(ioAbsoluteOrRemote,toPath)importDarcs.External(execSSH)importDarcs.RemoteApply(remoteApply)importDarcs.Commands.Init(initialize)importDarcs.Email(makeEmail)importDarcs.Witnesses.Sealed(Sealed(..),seal)importPrinter(text)#include "impossible.h"#include "gadts.h"putDescription::StringputDescription="Makes a copy of the repository"putHelp::StringputHelp="The `darcs put' command creates a copy of the current repository. It\n"++"is currently very inefficient, so when creating local copies you\n"++"should use `darcs get . x' instead of `darcs put x'.\n"++"\n"++"Currently this command just uses `darcs init' to create the target\n"++"repository, then `darcs push --all' to copy patches to it. Options\n"++"passed to `darcs put' are passed to the init and/or push commands as\n"++"appropriate. See those commands for an explanation of each option.\n"put::DarcsCommandput=DarcsCommand{commandName="put",commandHelp=putHelp,commandDescription=putDescription,commandExtraArgs=1,commandExtraArgHelp=["<NEW REPOSITORY>"],commandCommand=putCmd,commandPrereq=amInRepository,commandGetArgPossibilities=getPreflist"repos",commandArgdefaults=nodefaults,commandAdvancedOptions=[applyas]++networkOptions,commandBasicOptions=[matchOneContext,setScriptsExecutableOption,getInventoryChoices,setDefaultTrue,workingRepoDir]}putCmd::[DarcsFlag]->[String]->IO()putCmd_[""]=fail"Empty repository argument given to put."putCmdopts[unfixedrepodir]=dorepodir<-fixUrloptsunfixedrepodir-- Test to make sure we aren't trying to push to the current repot_cur_absolute_repo_dir<-ioAbsoluteOrRemote"."t_req_absolute_repo_dir<-ioAbsoluteOrRemoterepodirletcur_absolute_repo_dir=toPatht_cur_absolute_repo_dirreq_absolute_repo_dir=toPatht_req_absolute_repo_dirwhen(cur_absolute_repo_dir==req_absolute_repo_dir)$fail"Can't put to current repository!"when(isUrlreq_absolute_repo_dir)$error"Can't put to a URL!"debugMessage"Creating repository"putVerboseopts$text"Creating repository"rf_or_e<-identifyRepoFormat"."rf<-caserf_or_eofLefte->faileRightx->returnxletinitopts=ifformatHasDarcs2rfthenUseFormat2:filter(/=UseOldFashionedInventory)optselseifformatHasHashedInventoryrf&&not(UseOldFashionedInventory`elem`opts)thenUseHashedInventory:filter(/=UseFormat2)optselseUseOldFashionedInventory:filter(/=UseFormat2)optsifisFilereq_absolute_repo_dirthendocreateDirectoryreq_absolute_repo_dirwithCurrentDirectoryreq_absolute_repo_dir$(commandCommandinitialize)initopts[]elsedo-- isSsh req_absolute_repo_dirremoteInitreq_absolute_repo_dirinitoptswithCurrentDirectorycur_absolute_repo_dir$withRepoReadLockopts$-\repository->(dosetDefaultreporeq_absolute_repo_diroptsletdoRead=ifhavePatchsetMatchoptsthengetOnePatchsetrepositoryopts-- todo: make sure getOnePatchset has the right typeelsereadReporepository>>=(return.seal)Sealed(patchset::PatchSetpC(Originx1))<-doReadSealed(patchset2::PatchSetpC(Originx2))<-doReadIsEq<-return(unsafeCoercePIsEq)::IO(EqCheckC(x1x2))letpatches=patchSetToPatchespatchsetpatches2=patchSetToPatchespatchset2when(nullFLpatches)$doputInfoopts$text"No patches were selected to put. Nothing to be done."exitWithExitSuccessbundle<-makeBundle2NothingNilRLpatchespatches2letmessage=ifisFilereq_absolute_repo_dirthenbundleelsemakeEmailreq_absolute_repo_dir[]NothingbundleNothingputVerboseopts$text"Applying patches in new repository..."rval<-remoteApplyoptsreq_absolute_repo_dirmessagecaservalofExitFailureec->doputStrLn$"Apply failed!"exitWith(ExitFailureec)ExitSuccess->putInfoopts$text"Put successful.")::IO()putCmd__=impossibleremoteInit::FilePath->[DarcsFlag]->IO()remoteInitrepoopts=doletargs=catMaybes$map(flagToString$commandBasicOptionsinitialize)optscommand="darcs initialize --repodir='"++path++"' "++unwordsargsexitCode<-execSSHaddrcommandwhen(exitCode/=ExitSuccess)$fail"Couldn't initialize remote repository."where(addr,':':path)=break(==':')repo