%Copyright(C)2003-2005DavidRoundy%%Thisprogramisfreesoftware;youcanredistributeitand/ormodify%itunderthetermsoftheGNUGeneralPublicLicenseaspublishedby%theFreeSoftwareFoundation;eitherversion2,or(atyouroption)%anylaterversion.%%Thisprogramisdistributedinthehopethatitwillbeuseful,%butWITHOUTANYWARRANTY;withouteventheimpliedwarrantyof%MERCHANTABILITYorFITNESSFORAPARTICULARPURPOSE.Seethe%GNUGeneralPublicLicenseformoredetails.%%YoushouldhavereceivedacopyoftheGNUGeneralPublicLicense%alongwiththisprogram;seethefileCOPYING.Ifnot,writeto%theFreeSoftwareFoundation,Inc.,51FranklinStreet,FifthFloor,%Boston,MA02110-1301,USA.\subsection{darcsoptimize}\begin{code}{-# OPTIONS_GHC -cpp #-}{-# LANGUAGE CPP #-}moduleDarcs.Commands.Optimize(optimize)whereimportControl.Monad(when,unless)importData.Maybe(isJust)importText.Regex(mkRegex,matchRegex)importSystem.Directory(getDirectoryContents,doesDirectoryExist)importDarcs.Hopefully(hopefully,info)importDarcs.Commands(DarcsCommand(..),nodefaults)importDarcs.Arguments(DarcsFlag(Compress,UnCompress,NoCompress,Reorder,TagName,CheckPoint,Relink,RelinkPristine),tagname,checkpoint,reorder_patches,uncompress_nocompress,relink,relink_pristine,sibling,flagsToSiblings,working_repo_dir,umask_option,)importDarcs.Repository.Prefs(get_preflist)importDarcs.Repository(Repository,PatchSet,withRepoLock,($-),withGutsOf,read_repo,optimizeInventory,slurp_recorded,tentativelyReplacePatches,cleanRepository,amInRepository,finalizeRepositoryChanges)importDarcs.Repository.Checkpoint(write_checkpoint)importDarcs.Ordered(RL(..),unsafeUnRL,(+<+),mapFL_FL,reverseRL,mapRL,concatRL)importDarcs.Patch.Info(PatchInfo,just_name,human_friendly)importDarcs.Patch(RepoPatch)importByteStringUtils(gzReadFilePS)importDarcs.Patch.Depends(deep_optimize_patchset,slightly_optimize_patchset,get_patches_beyond_tag,get_patches_in_tag,)importDarcs.Lock(maybeRelink,gzWriteAtomicFilePS,writeAtomicFilePS)importDarcs.RepoPath(toFilePath)importDarcs.Utils(withCurrentDirectory)importProgress(debugMessage)importPrinter(putDocLn,text,($$))importDarcs.SlurpDirectory(slurp,list_slurpy_files)importDarcs.Repository.Pristine(identifyPristine,pristineDirectory)importDarcs.Sealed(FlippedSeal(..),unsafeUnseal)importDarcs.Global(darcsdir)#include "impossible.h"optimize_description::Stringoptimize_description="Optimize the repository."\end{code}\options{optimize}\haskell{optimize_help}\begin{code}optimize_help::Stringoptimize_help="Optimize can help to improve the performance of your repository in a number of cases.\n"optimize::DarcsCommandoptimize=DarcsCommand{command_name="optimize",command_help=optimize_help,command_description=optimize_description,command_extra_args=0,command_extra_arg_help=[],command_command=optimize_cmd,command_prereq=amInRepository,command_get_arg_possibilities=return[],command_argdefaults=nodefaults,command_advanced_options=[uncompress_nocompress,umask_option],command_basic_options=[checkpoint,tagname,working_repo_dir,reorder_patches,sibling,relink,relink_pristine]}optimize_cmd::[DarcsFlag]->[String]->IO()optimize_cmdorigopts_=withRepoLockopts$-\repository->docleanRepositoryrepositorydo_reorderoptsrepositorydo_optimize_inventoryrepositorywhen(CheckPoint`elem`opts)$do_checkpointoptsrepositorywhen(Compress`elem`opts||UnCompress`elem`opts)$optimize_compressionoptswhen(Relink`elem`opts||(RelinkPristine`elem`opts))$do_relinkoptsrepositoryputStrLn"Done optimizing!"whereopts=ifUnCompress`elem`origoptsthenNoCompress:origoptselseorigoptsis_tag::PatchInfo->Boolis_tagpinfo=take4(just_namepinfo)=="TAG "\end{code}Optimizealwayswritesoutafreshcopyoftheinventorythatminimizestheamountofinventorythatneedbedownloadedwhenpeoplepullfromtherepository.Specifically,itbreaksuptheinventoryonthemostrecenttag.Thisspeedsupmostcommandswhenrunremotely,bothbecauseasmallerfileneedstobetransfered(onlythemostrecentinventory).Italsogivesaguaranteethatallthepatchespriortoagiventagareincludedinthattag,solesscommutationandhistorytraversalisneeded.Thislatterissuecanbecomeveryimportantinlargerepositories.\begin{code}do_optimize_inventory::RepoPatchp=>Repositoryp->IO()do_optimize_inventoryrepository=dodebugMessage"Writing out a nice copy of the inventory."optimizeInventoryrepositorydebugMessage"Done writing out a nice copy of the inventory."\end{code}\begin{options}--checkpoint, --tag\end{options}Ifyouusethe\verb!--checkpoint!option,optimizecreatesacheckpointpatchforatag.Youcanspecifythetagwiththe\verb!--tag!option,orjustletdarcschoosethemostrecenttag.Notethatoptimize\verb!--checkpoint!willfailwhenusedona``partial''repository.Also,thetagthatistobecheckpointedmustnotbeprecededbyanypatchesthatarenotincludedinthattag.Ifthatisthecase,nocheckpointingisdone.Thecreatedcheckpointisusedbythe\verb!--partial!flagto\verb!get!and\verb!check!.Thisallowsforuserstoretrieveaworkingrepositorywithlimitedhistorywithasavingsofdiskspaceandbandwidth.\begin{code}do_checkpoint::RepoPatchp=>[DarcsFlag]->Repositoryp->IO()do_checkpointoptsrepository=dompi<-get_tagoptsrepositorycasempiofNothing->return()Justpinfo->doputDocLn$text"Checkpointing tag:"$$human_friendlypinfowrite_checkpointrepositorypinfoget_tag::RepoPatchp=>[DarcsFlag]->Repositoryp->IO(MaybePatchInfo)get_tag[]r=dops<-read_reporcasefilteris_tag$lasts$mapRL(mapRLinfo)psof[]->doputStrLn"There is no tag to checkpoint!"returnNothing(pinfo:_)->return$Justpinfoget_tag(TagNamet:_)r=dops<-read_reporcasefilter(match_tagt)$lasts$mapRL(mapRLinfo)psof(pinfo:_)->return$Justpinfo_->casefilter(match_tagt)$lasts$mapRL(mapRLinfo)$deep_optimize_patchsetpsof(pinfo:_)->return$Justpinfo_->doputStr"Cannot checkpoint any tag "putStr$"matching '"++t++"'\n"returnNothingget_tag(_:fs)r=get_tagfsrlasts::[[a]]->[a]lasts[]=[]lasts(x@(_:_):ls)=lastx:lastslslasts([]:ls)=lastslsmymatch::String->PatchInfo->Boolmymatchr=match_name$matchRegex(mkRegexr)match_name::(String->Maybea)->PatchInfo->Boolmatch_namechpinfo=isJust$ch(just_namepinfo)match_tag::String->PatchInfo->Boolmatch_tag('^':n)=mymatch$"^TAG "++nmatch_tagn=mymatch$"^TAG .*"++n\end{code}\begin{options}--compress, --dont-compress, --uncompress\end{options}Somecompressionoptionsareavailable,andareindependentofthe\verb!--checkpoint!option.Bydefaultthepatchesintherepositoryarecompressed.Theseuselessdiskspace,whichtranslatesintolessbandwidthiftherepositoryisaccessedremotely.Notethatinthedarcs-1.0(alsoknownas``oldfashionedinventory'')repositoryformat,patcheswillalwayshavethe``.gz''extensionwhethertheyarecompressedornot.Youmaywanttouncompressthepatcheswhenyou'vegotenoughdiskspacebutarerunningoutofphysicalmemory.Ifyougivethe\verb!--compress!option,optimizewillcompressallthepatchesintherepository.Similarly,ifyougivethe\verb!--uncompress!,optimizewilldecompressallthepatchesintherepository.\verb!--dont-compress!means``don'tcompress,butdon'tuncompresseither''.Itwouldbeusefulifoneofthecompressionoptionswasprovidedasadefaultandyouwantedtooverrideit.\begin{code}optimize_compression::[DarcsFlag]->IO()optimize_compressionopts=doputStrLn"Optimizing (un)compression of patches..."do_compress(darcsdir++"/patches")putStrLn"Optimizing (un)compression of inventories..."do_compress(darcsdir++"/inventories")wheredo_compressf=doisd<-doesDirectoryExistfifisdthenwithCurrentDirectoryf$dofs<-filternotdot`fmap`getDirectoryContents"."mapM_do_compressfselseifCompress`elem`optsthengzReadFilePSf>>=gzWriteAtomicFilePSfelsegzReadFilePSf>>=writeAtomicFilePSfnotdot('.':_)=Falsenotdot_=True\end{code}\begin{options}--relink\end{options}The\verb|--relink|and\verb|--relink-pristine|optionscauseDarcstorelinkfilesfromasibling.SeeSection\ref{disk-usage}.\begin{code}do_relink::RepoPatchp=>[DarcsFlag]->Repositoryp->IO()do_relinkoptsrepository=dosome_siblings<-return(flagsToSiblingsopts)defrepolist<-get_preflist"defaultrepo"siblings<-return(maptoFilePathsome_siblings++defrepolist)if(siblings==[])thenputStrLn"No siblings -- no relinking done."elsedowhen(Relink`elem`opts)$dodebugMessage"Relinking patches..."patches<-(fmaplist_slurpy_files)(slurp$darcsdir++"/patches")maybeRelinkFilessiblingspatches(darcsdir++"/patches")when(RelinkPristine`elem`opts)$dopristine<-identifyPristinecase(pristineDirectorypristine)of(Justd)->dodebugMessage"Relinking pristine tree..."c<-slurp_recordedrepositorymaybeRelinkFilessiblings(list_slurpy_filesc)dNothing->return()debugMessage"Done relinking."return()return()maybeRelinkFiles::[String]->[String]->String->IO()maybeRelinkFilessrcdstdir=mapM_(maybeRelinkFilesrc)(map((dir++"/")++)dst)maybeRelinkFile::[String]->String->IO()maybeRelinkFile[]_=return()maybeRelinkFile(h:t)f=dodone<-maybeRelink(h++"/"++f)funlessdone$maybeRelinkFiletfreturn()\end{code}\begin{options}--reorder-patches\end{options}The\verb|--reorder-patches|optioncausesDarcstocreateanoptimalorderingofitsinternalpatchinventory.Thismayhelptoproduceshorter`context'listswhensendingpatches,andmayimproveperformanceforsomeotheroperationsaswell.Youshouldnotrun\verb!--reorder-patches!onarepositoryfromwhichsomeonemaybesimultaneouslypullingorgetting,asthiscouldleadtorepositorycorruption.\begin{code}do_reorder::RepoPatchp=>[DarcsFlag]->Repositoryp->IO()do_reorderopts_|not(Reorder`elem`opts)=return()do_reorderoptsrepository=dodebugMessage"Reordering the inventory."psnew<-choose_order`fmap`read_reporepositoryletps=mapFL_FLhopefully$reverseRL$head$unsafeUnRLpsnewwithGutsOfrepository$dotentativelyReplacePatchesrepositoryoptspsfinalizeRepositoryChangesrepositorydebugMessage"Done reordering the inventory."choose_order::RepoPatchp=>PatchSetp->PatchSetpchoose_orderps|isJustlast_tag=caseslightly_optimize_patchset$unsafeUnseal$get_patches_in_tagltpsof((t:<:NilRL):<:pps)->caseget_patches_beyond_tagltpsofFlippedSeal(p:<:NilRL)->(p+<+(t:<:NilRL)):<:pps_->impossible_->impossiblewherelast_tag=casefilteris_tag$mapRLinfo$concatRLpsof(t:_)->Justt_->Nothinglt=fromJustlast_tagchoose_orderps=ps\end{code}