% Copyright (C) 2003-2004 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.
\darcsCommand{changes}
\begin{code}

{-# OPTIONS_GHC -cpp -fglasgow-exts #-}{-# LANGUAGE CPP, PatternGuards #-}#include "gadts.h"moduleDarcs.Commands.Changes(changes,log)whereimportPreludehiding(log)importUnsafe.Coerce(unsafeCoerce)importData.List(intersect,sort)importData.Maybe(fromMaybe)importControl.Monad(when,unless)importDarcs.Hopefully(hopefullyM,info)importDarcs.Patch.Depends(slightlyOptimizePatchset)importDarcs.Commands(DarcsCommand(..),nodefaults,commandAlias)importDarcs.Arguments(DarcsFlag(Context,HumanReadable,MachineReadable,Interactive,Count,NumberPatches,XMLOutput,Summary,Verbose,Debug),fixSubPaths,changesFormat,possiblyRemoteRepoDir,getRepourl,workingRepoDir,onlyToFiles,summary,changesReverse,matchSeveralOrRange,matchMaxcount,maxCount,allInteractive,showFriendly,networkOptions)importDarcs.Flags(doReverse,showChangesOnlyToFiles)importDarcs.RepoPath(toFilePath,rootDirectory)importDarcs.Patch.FileName(fp2fn,fn2fp,normPath)importDarcs.Repository(Repository,PatchInfoAnd,withRepositoryDirectory,($-),findRepository,readRepo,unrecordedChanges)importDarcs.Patch.Set(PatchSet(..),Tagged(..),newset2RL)importDarcs.Patch.Info(toXml,showPatchInfo)importDarcs.Patch.Depends(findCommonWithThem)importDarcs.Patch.TouchesFiles(lookTouch)importDarcs.Patch(RepoPatch,invert,xmlSummary,description,applyToFilepaths,listTouchedFiles,effect,identity)importDarcs.Witnesses.Ordered(RL(..),EqCheck(..),filterFLFL,filterRL,reverseFL,(:>>)(..),(+<+))importDarcs.Match(firstMatch,secondMatch,matchAPatchread,haveNonrangeMatch,matchFirstPatchset,matchSecondPatchset,)importDarcs.Commands.Annotate(createdAsXml)importPrinter(Doc,putDocLnWith,simplePrinters,(<+>),renderString,prefix,text,vcat,vsep,($$),empty,errorDoc,insertBeforeLastline)importDarcs.ColorPrinter(fancyPrinters)importProgress(setProgressMode,debugMessage)importDarcs.SelectChanges(viewChanges)importDarcs.Witnesses.Sealed(Sealed2(..),unseal2,Sealed(..))changesDescription::StringchangesDescription="List patches in the repository."changesHelp::StringchangesHelp="The `darcs changes' command lists the patches that constitute the\n"++"current repository or, with --repo, a remote repository. Without\n"++"options or arguments, ALL patches will be listed.\n"++"\n"++changesHelp'++"\n"++changesHelp''changes::DarcsCommandchanges=DarcsCommand{commandName="changes",commandHelp=changesHelp,commandDescription=changesDescription,commandExtraArgs=-1,commandExtraArgHelp=["[FILE or DIRECTORY]..."],commandGetArgPossibilities=return[],commandCommand=changesCmd,commandPrereq=findRepository,commandArgdefaults=nodefaults,commandAdvancedOptions=networkOptions,commandBasicOptions=[matchSeveralOrRange,matchMaxcount,onlyToFiles,changesFormat,summary,changesReverse,possiblyRemoteRepoDir,workingRepoDir,allInteractive]}changesCmd::[DarcsFlag]->[String]->IO()changesCmd[Context_][]=return()changesCmdoptsargs|ContextrootDirectory`elem`opts=letrepodir=fromMaybe"."(getRepourlopts)inwithRepositoryDirectoryoptsrepodir$-\repository->dowhen(args/=[])$fail"changes --context cannot accept other arguments"changesContextrepositoryoptschangesCmdoptsargs=letrepodir=fromMaybe"."(getRepourlopts)inwithRepositoryDirectoryoptsrepodir$-\repository->dounless(Debug`elem`opts)$setProgressModeFalsefiles<-sort`fmap`fixSubPathsoptsargsSealedunrec<-ifnullfilesthenreturn(Sealedidentity)elseSealed`fmap`unrecordedChangesoptsrepositoryfiles`catch`\_->return(Sealedidentity)-- this is triggered when repository is remoteletfilez=map(fn2fp.normPath.fp2fn)$applyToFilepaths(invertunrec)$maptoFilePathfilesfiltered_changesp=maybe_reverse$getChangesInfooptsfilezpdebugMessage"About to read the repository..."patches<-readReporepositorydebugMessage"Done reading the repository."ifInteractive`elem`optsthendolet(fp_and_fs,_,_)=filtered_changespatchesfp=mapfstfp_and_fsviewChangesoptsfpelsedowhen(not(nullfiles)&&not(XMLOutput`elem`opts))$putStrLn$"Changes to "++unwordsfilez++":\n"debugMessage"About to print the changes..."letprinters=ifXMLOutput`elem`optsthensimplePrinterselsefancyPrintersps<-readReporepository-- read repo again to prevent holding onto-- values forced by filtered_changesputDocLnWithprinters$changelogoptsps$filtered_changespatcheswheremaybe_reverse(xs,b,c)=ifdoReverseoptsthen(reversexs,b,c)else(xs,b,c)-- FIXME: this prose is unreadable. --twb, 2009-08changesHelp'::StringchangesHelp'="When given one or more files or directories as arguments, only\n"++"patches which affect those files or directories are listed. This\n"++"includes changes that happened to files before they were moved or\n"++"renamed.\n"++"\n"++"When given a --from-tag, --from-patch or --from-match, only changes\n"++"since that tag or patch are listed. Similarly, the --to-tag,\n"++"--to-patch and --to-match options restrict the list to older patches.\n"++"\n"++"The --last and --max-count options both limit the number of patches\n"++"listed. The former applies BEFORE other filters, whereas the latter\n"++"applies AFTER other filters. For example `darcs changes foo.c\n"++"--max-count 3' will print the last three patches that affect foo.c,\n"++"whereas `darcs changes --last 3 foo.c' will, of the last three\n"++"patches, print only those that affect foo.c.\n"getChangesInfo::RepoPatchp=>[DarcsFlag]->[FilePath]->PatchSetpC(xy)->([(Sealed2(PatchInfoAndp),[FilePath])],[FilePath],Doc)getChangesInfooptsplain_fsps=case(sp1s,sp2s)of(Sealedp1s,Sealedp2s)->casefindCommonWithThemp2sp1sof_:>>us->filterPatchesByNames(maxCountopts)fs$filterRLpf$reverseFLuswherefs=map(\x->"./"++x)$plain_fssp1s=iffirstMatchoptsthenmatchFirstPatchsetoptspselseSealed$PatchSetNilRLNilRLsp2s=ifsecondMatchoptsthenmatchSecondPatchsetoptspselseSealed$pspf=ifhaveNonrangeMatchoptsthenmatchAPatchreadoptselse\_->True-- | Take a list of filenames and patches and produce a list of-- patches that actually touch the given files with list of touched-- file names, a new file list that represents the same set of files-- as in input, before the returned patches would have been applied,-- and possibly an error. Additionaly, the function takes a "depth-- limit" -- maxcount, that could be Nothing (return everything) or-- "Just n" -- returns at most n patches touching the file (starting-- from the beginning of the patch list).filterPatchesByNames::RepoPatchp=>MaybeInt-- ^ maxcount->[FilePath]-- ^ filenames->[Sealed2(PatchInfoAndp)]-- ^ patchlist->([(Sealed2(PatchInfoAndp),[FilePath])],[FilePath],Doc)filterPatchesByNames(Just0)__=([],[],empty)filterPatchesByNames__[]=([],[],empty)filterPatchesByNamesmaxcount[](hp:ps)=(hp,[])-:-filterPatchesByNames(subtract1`fmap`maxcount)[]psfilterPatchesByNamesmaxcountfs((Sealed2hp):ps)|Justp<-hopefullyMhp=caselookTouchfs(invertp)of(True,[])->([(Sealed2hp,fs)],fs,empty)(True,fs')->(Sealed2hp,fs)-:-filterPatchesByNames(subtract1`fmap`maxcount)fs'ps(False,fs')->filterPatchesByNamesmaxcountfs'psfilterPatchesByNames__((Sealed2hp):_)=([],[],text"Can't find changes prior to:"$$descriptionhp)-- | Note, lazy pattern matching is required to make functions like-- filterPatchesByNames lazy in case you are only not interested in-- the first element. E.g.:---- let (fs, _, _) = filterPatchesByNames ...(-:-)::a->([a],b,c)->([a],b,c)x-:-~(xs,y,z)=(x:xs,y,z)changelog::RepoPatchp=>[DarcsFlag]->PatchSetpC(startx)->([(Sealed2(PatchInfoAndp),[FilePath])],[FilePath],Doc)->Docchangelogoptspatchset(pis_and_fs,orig_fs,errstring)|Count`elem`opts=text$show$lengthpis_and_fs|MachineReadable`elem`opts=ifrenderStringerrstring==""thenvsep$map(unseal2(showPatchInfo.info))piselseerrorDocerrstring|XMLOutput`elem`opts=text"<changelog>"$$vcatxml_file_names$$vcatactual_xml_changes$$text"</changelog>"|Summary`elem`opts||Verbose`elem`opts=vsep(map(number_patchchange_with_summary)pis_and_fs)$$errstring|otherwise=vsep(map(number_patchdescription')pis_and_fs)$$errstringwherechange_with_summary(Sealed2hp,fs)|Justp<-hopefullyMhp=ifshowChangesOnlyToFilesoptsthendescriptionhp$$text""$$indent(showFriendlyopts(filterFLFLxx$effectp))elseshowFriendlyoptsp|otherwise=descriptionhp$$indent(text"[this patch is unavailable]")wherexxx=caselistTouchedFilesxofys|null$ys`intersect`fs->unsafeCoerceIsEq-- in that case, the change does not affect the patches we are-- looking at, so we ignore the difference between the two states.-- It's all read-only anyway._->NotEqxml_with_summary(Sealed2hp)|Justp<-hopefullyMhp=insertBeforeLastline(toXml$infohp)(indent$xmlSummaryp)xml_with_summary(Sealed2hp)=toXml(infohp)indent=prefix" "actual_xml_changes=ifSummary`elem`optsthenmapxml_with_summarypiselsemap(toXml.(unseal2info))pisxml_file_names=map(createdAsXmlfirst_change)orig_fsfirst_change=ifdoReverseoptsthenunseal2info$headpiselseunseal2info$lastpisnumber_patchfx=ifNumberPatches`elem`optsthencaseget_number(fstx)ofJustn->text(shown++":")<+>fxNothing->fxelsefxget_number::Sealed2(PatchInfoAndp)->MaybeIntget_number(Sealed2y)=gn1(newset2RLpatchset)whereiy=infoygn::Int->RL(PatchInfoAndp)C(startx)->MaybeIntgnn(b:<:bs)|seqn(infob)==iy=Justn|otherwise=gn(n+1)bsgn_NilRL=Nothingpis=mapfstpis_and_fsdescription'=unseal2description.fst-- FIXME: this prose is unreadable. --twb, 2009-08changesHelp''::StringchangesHelp''="Three output formats exist. The default is --human-readable. You can\n"++"also select --context, which is the internal format (as seen in patch\n"++"bundles) that can be re-read by Darcs (e.g. `darcs get --context').\n"++"\n"++"Finally, there is --xml-output, which emits valid XML... unless a the\n"++"patch metadata (author, name or description) contains a non-ASCII\n"++"character and was recorded in a non-UTF8 locale.\n"++"\n"++-- FIXME: can't we just disallow the following usage?"Note that while the --context flag may be used in conjunction with\n"++"--xml-output or --human-readable, in neither case will darcs get be\n"++"able to read the output. On the other hand, sufficient information\n"++"WILL be output for a knowledgeable human to recreate the current state\n"++"of the repository.\n"changesContext::RepoPatchp=>RepositorypC(rut)->[DarcsFlag]->IO()changesContextrepositoryopts=dor<-readReporepositoryputStrLn"\nContext:\n"caserofPatchSet(_:<:_)_->caseslightlyOptimizePatchsetrofPatchSetps(Taggedt__:<:_)->putDocLnWithsimplePrinters$changelogopts'(PatchSetNilRLNilRL)$getChangesInfoopts'[](PatchSet(ps+<+t:<:NilRL)-- FIXME ugly!!!NilRL)PatchSetpsNilRL->putDocLnWithsimplePrinters$changelogopts'(PatchSetNilRLNilRL)$getChangesInfoopts'[](PatchSetpsNilRL)_->return()whereopts'=ifHumanReadable`elem`opts||XMLOutput`elem`optsthenoptselseMachineReadable:optslog::DarcsCommandlog=commandAlias"log"Nothingchanges