-- Copyright (C) 2002-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.{-# OPTIONS_GHC -cpp -fno-warn-orphans #-}{-# LANGUAGE CPP #-}moduleDarcs.Patch.Viewing(xmlSummary,plainSummary)whereimportPreludehiding(pi,readFile)importControl.Monad.State.Strict(gets)importControl.Monad.Trans(liftIO)importStorage.Hashed.Monad(TreeIO,fileExists,readFile,tree,virtualTreeIO)importStorage.Hashed.AnchoredPath(floatPath)importByteStringUtils(linesPS)importqualifiedData.ByteStringasBS(null,concat)importqualifiedData.ByteString.LazyasBL(toChunks)importDarcs.Patch.FileName(FileName,fn2fp)importPrinter(Doc,empty,vcat,text,blueText,Color(Cyan,Magenta),lineColor,minus,plus,($$),(<+>),(<>),prefix,renderString,userchunkPS,)importDarcs.Patch.Core(Patch(..),Named(..),patchcontents)importDarcs.Patch.Prim(Prim(..),primIsHunk,isHunk,formatFileName,showPrim,FileNameFormat(..),Conflict(..),Effect,IsConflictedPrim(IsC),ConflictState(..),DirPatchType(..),FilePatchType(..))importDarcs.Patch.Patchy(Patchy,Apply,ShowPatch(..),identity)importDarcs.Patch.Show(showPatch_,showNamedPrefix)importDarcs.Patch.Info(showPatchInfo,human_friendly)importDarcs.Patch.Apply(applyToTree)#include "impossible.h"#include "gadts.h"importDarcs.Witnesses.Ordered(RL(..),FL(..),mapFL,mapFL_FL,reverseRL)instanceShowPatchPrimwhereshowPatch=showPrimOldFormatshowContextPatchp@(FP_(Hunk___))=showContextHunk(PPp)showContextPatch(Splitps)=dox<-showContextSeries(mapFL_FLPPps)return$blueText"("$$x<>blueText")"showContextPatchp=return$showPatchpsummary=vcat.mapsummChunkToLine.genSummary.(:[]).IsCOkaything_="change"plainSummary::(Conflicte,Effecte)=>eC(xy)->DocplainSummary=vcat.mapsummChunkToLine.genSummary.conflictedEffectinstanceShowPatchPatchwhereshowPatch=showPatch_showContextPatch(PPx)|primIsHunkx=showContextHunk(PPx)showContextPatch(ComPNilFL)=return$blueText"{"$$blueText"}"showContextPatch(ComPps)=dox<-showContextSeriespsreturn$blueText"{"$$x$$blueText"}"showContextPatchp=return$showPatchpsummary=plainSummarything_="change"showContextSeries::(Applyp,ShowPatchp,Effectp)=>FLpC(xy)->TreeIODocshowContextSeriespatches=scsidentitypatcheswherescs::(Applyp,ShowPatchp,Effectp)=>PrimC(wx)->FLpC(xy)->TreeIODocscspold(p:>:ps)=dos'<-getstree>>=liftIO.applyToTreepcaseisHunkpofNothing->doa<-showContextPatchpb<-liftIO$virtualTreeIO(scsidentityps)s'return$a$$fstbJusthp->casepsofNilFL->coolContextHunkpoldhpidentity(p2:>:_)->caseisHunkp2ofNothing->doa<-coolContextHunkpoldhpidentityb<-liftIO$virtualTreeIO(scshpps)s'return$a$$fstbJusthp2->doa<-coolContextHunkpoldhphp2b<-liftIO$virtualTreeIO(scshpps)s'return$a$$fstbscs_NilFL=returnemptyshowContextHunk::(Applyp,ShowPatchp,Effectp)=>pC(xy)->TreeIODocshowContextHunkp=caseisHunkpofJusth->coolContextHunkidentityhidentityNothing->return$showPatchpcoolContextHunk::PrimC(ab)->PrimC(bc)->PrimC(cd)->TreeIODoccoolContextHunkprevp@(FPf(Hunklon))next=doletpath=floatPath$fn2fpfhave<-fileExistspathcontent<-ifhavethenJust`fmap`readFilepathelsereturnNothingcase(linesPS.BS.concat.BL.toChunks)`fmap`contentof-- sighNothing->return$showPatchp-- This is a weird error...Justls->letnumpre=caseprevof(FPf'(Hunklprev_nprev))|f'==f&&l-(lprev+lengthnprev+3)<3&&lprev<l->max0$l-(lprev+lengthnprev+3)_->ifl>=4then3elsel-1pre=takenumpre$drop(l-numpre-1)lsnumpost=casenextof(FPf'(Hunklnext__))|f'==f&&lnext<l+lengthn+4&&lnext>l->lnext-(l+lengthn)_->3cleanedls=casereverselsof(x:xs)|BS.nullx->reversexs_->lspost=takenumpost$drop(max0$l+lengtho-1)cleanedlsinreturn$blueText"hunk"<+>formatFileNameOldFormatf<+>text(showl)$$prefix" "(vcat$mapuserchunkPSpre)$$lineColorMagenta(prefix"-"(vcat$mapuserchunkPSo))$$lineColorCyan(prefix"+"(vcat$mapuserchunkPSn))$$prefix" "(vcat$mapuserchunkPSpost)coolContextHunk___=impossiblexmlSummary::(Effectp,Patchyp,Conflictp)=>NamedpC(xy)->DocxmlSummaryp=text"<summary>"$$(vcat.mapsummChunkToXML.genSummary.conflictedEffect.patchcontents$p)$$text"</summary>"-- Yuck duplicated code below...escapeXML::String->DocescapeXML=text.strReplace'\''"&apos;".strReplace'"'"&quot;".strReplace'>'"&gt;".strReplace'<'"&lt;".strReplace'&'"&amp;"strReplace::Char->String->String->StringstrReplace__[]=[]strReplacexy(z:zs)|x==z=y++(strReplacexyzs)|otherwise=z:(strReplacexyzs)-- end yuck duplicated code.-- | High-level representation of a piece of patch summarydataSummChunk=SummChunkSummDetailConflictStatederiving(Ord,Eq)dataSummDetail=SummAddDirFileName|SummRmDirFileName|SummFileSummOpFileNameIntIntInt|SummMvFileNameFileName|SummNonederiving(Ord,Eq)dataSummOp=SummAdd|SummRm|SummModderiving(Ord,Eq)genSummary::[IsConflictedPrim]->[SummChunk]genSummaryp=combine$concatMaps2pwheres2::IsConflictedPrim->[SummChunk]s2(IsCcx)=map(\d->SummChunkdc)$sxs::PrimC(xy)->[SummDetail]s(FPf(Hunk_on))=[SummFileSummModf(lengtho)(lengthn)0]s(FPf(Binary__))=[SummFileSummModf000]s(FPfAddFile)=[SummFileSummAddf000]s(FPfRmFile)=[SummFileSummRmf000]s(FPf(TokReplace___))=[SummFileSummModf001]s(DPdAddDir)=[SummAddDird]s(DPdRmDir)=[SummRmDird]s(Splitxs)=concat$mapFLsxss(Movef1f2)=[SummMvf1f2]s(ChangePref___)=[SummNone]sIdentity=[SummNone]combine(x1@(SummChunkd1c1):x2@(SummChunkd2c2):ss)=casecombineDetaild1d2ofNothing->x1:combine(x2:ss)Justd3->combine$SummChunkd3(combineConflitStatesc1c2):sscombine(x:ss)=x:combinesscombine[]=[]--combineDetail(SummFileo1f1r1a1x1)(SummFileo2f2r2a2x2)|f1==f2=doo3<-combineOpo1o2return$SummFileo3f1(r1+r2)(a1+a2)(x1+x2)combineDetail__=Nothing--combineConflitStatesConflicted_=ConflictedcombineConflitStates_Conflicted=ConflictedcombineConflitStatesDuplicated_=DuplicatedcombineConflitStates_Duplicated=DuplicatedcombineConflitStatesOkayOkay=Okay-- Don't combine AddFile and RmFile: (maybe an old revision of) darcs-- allows a single patch to add and remove the same file, see issue 185combineOpSummAddSummRm=NothingcombineOpSummRmSummAdd=NothingcombineOpSummAdd_=JustSummAddcombineOp_SummAdd=JustSummAddcombineOpSummRm_=JustSummRmcombineOp_SummRm=JustSummRmcombineOpSummModSummMod=JustSummModsummChunkToXML::SummChunk->DocsummChunkToXML(SummChunkdetailc)=casedetailofSummRmDirf->xconfc"remove_directory"(xfnf)SummAddDirf->xconfc"add_directory"(xfnf)SummFileSummRmf___->xconfc"remove_file"(xfnf)SummFileSummAddf___->xconfc"add_file"(xfnf)SummFileSummModfrax->xconfc"modify_file"$xfnf<>xrmr<>xada<>xrpxSummMvf1f2->text"<move from=\""<>xfnf1<>text"\" to=\""<>xfnf2<>text"\"/>"SummNone->emptywherexconfOkaytx=text('<':t++">")$$x$$text("</"++t++">")xconfConflictedtx=text('<':t++" conflict='true'>")$$x$$text("</"++t++">")xconfDuplicatedtx=text('<':t++" duplicate='true'>")$$x$$text("</"++t++">")xfn=escapeXML.dropDotSlash.fn2fp--xad0=emptyxada=text"<added_lines num='"<>text(showa)<>text"'/>"xrm0=emptyxrma=text"<removed_lines num='"<>text(showa)<>text"'/>"xrp0=emptyxrpa=text"<replaced_tokens num='"<>text(showa)<>text"'/>"summChunkToLine::SummChunk->DocsummChunkToLine(SummChunkdetailc)=casedetailofSummRmDirf->lconfc"R"$text(fn2fpf)<>text"/"SummAddDirf->lconfc"A"$text(fn2fpf)<>text"/"SummFileSummRmf___->lconfc"R"$text(fn2fpf)SummFileSummAddf___->lconfc"A"$text(fn2fpf)SummFileSummModfrax->lconfc"M"$text(fn2fpf)<+>rmr<+>ada<+>rpxSummMvf1f2->text" "<>text(fn2fpf1)<>text" -> "<>text(fn2fpf2)SummNone->casecofOkay->empty_->lconfc""emptywherelconfOkaytx=textt<+>xlconfConflictedtx=text(t++"!")<+>xlconfDuplicatedtx=textt<+>x<+>text"duplicate"--ad0=emptyada=plus<>text(showa)rm0=emptyrma=minus<>text(showa)rp0=emptyrpa=text"r"<>text(showa)dropDotSlash::FilePath->FilePathdropDotSlash('.':'/':str)=dropDotSlashstrdropDotSlashstr=strinstance(Conflictp,ShowPatchp)=>ShowPatch(Namedp)whereshowPatch(NamedPn[]p)=showPatchInfon<>showPatchpshowPatch(NamedPndp)=showNamedPrefixnd<+>showPatchpshowContextPatch(NamedPn[]p)=showContextPatchp>>=return.(showPatchInfon<>)showContextPatch(NamedPndp)=showContextPatchp>>=return.(showNamedPrefixnd<+>)description(NamedPn__)=human_friendlynsummaryp=descriptionp$$text""$$prefix" "(plainSummaryp)-- this isn't summary because summary does the-- wrong thing with (Named (FL p)) so that it can-- get the summary of a sequence of named patches-- right.showNicelyp@(NamedP__pt)=descriptionp$$prefix" "(showNicelypt)instance(Conflictp,ShowPatchp)=>Show(NamedpC(xy))whereshow=renderString.showPatchinstance(Conflictp,Applyp,Effectp,ShowPatchp)=>ShowPatch(FLp)whereshowPatchxs=vcat(mapFLshowPatchxs)showContextPatch=showContextSeriesdescription=vcat.mapFLdescriptionsummary=vcat.mapFLsummarythingx=thing(helperxx)++"s"wherehelperx::FLaC(xy)->aC(xy)helperx_=undefinedthings=thinginstance(Conflictp,Applyp,ShowPatchp)=>ShowPatch(RLp)whereshowPatch=showPatch.reverseRLshowContextPatch=showContextPatch.reverseRLdescription=description.reverseRLsummary=summary.reverseRLthing=thing.reverseRLthings=things.reverseRLinstance(Conflictp,Patchyp)=>Patchy(FLp)instance(Conflictp,Patchyp)=>Patchy(RLp)