-- Copyright (C) 2006 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.{-# LANGUAGE CPP, UndecidableInstances #-}-- XXX Undecidable only in GHC < 7#include "gadts.h"moduleDarcs.Patch.PatchInfoAnd(Hopefully,PatchInfoAnd,WPatchInfo,unWPatchInfo,compareWPatchInfo,piap,n2pia,patchInfoAndPatch,fmapPIAP,fmapFL_PIAP,conscientiously,hopefully,info,winfo,hopefullyM,createHashed,extractHash,actually,unavailable,patchDesc)whereimportSystem.IO.Unsafe(unsafeInterleaveIO)importDarcs.SignalHandler(catchNonSignal)importPrinter(Doc,renderString,errorDoc,text,($$),vcat)importDarcs.Patch.Info(PatchInfo,humanFriendly,justName)importDarcs.Patch(RepoPatch,Named,patch2patchinfo)importDarcs.Patch.Conflict(Conflict,CommuteNoConflicts)importDarcs.Patch.Effect(Effect(..))importDarcs.Patch.FileHunk(IsHunk(..))importDarcs.Patch.Format(PatchListFormat)importDarcs.Patch.Merge(Merge(..))importDarcs.Patch.Named(fmapNamed,fmapFL_Named)importDarcs.Patch.Prim(PrimPatchBase(..))importDarcs.Patch.Patchy(Patchy,ReadPatch(..),Apply(..),Invert(..),ShowPatch(..),Commute(..),PatchInspect(..))importDarcs.Patch.Repair(Repair(..),RepairToFL)importDarcs.Patch.Show(ShowPatchBasic(..))importDarcs.Witnesses.Eq(MyEq(..),EqCheck(..))importDarcs.Witnesses.Unsafe(unsafeCoerceP)importDarcs.Witnesses.Ordered((:>)(..),(:\/:)(..),(:/\:)(..),FL,mapFL)importDarcs.Witnesses.Sealed(Sealed(Sealed),seal,mapSeal)importDarcs.Utils(prettyException)importStorage.Hashed.Tree(Tree)importControl.Applicative((<$>))-- | @'Hopefully' p C@ @(x y)@ is @'Either' String (p C@ @(x y))@ in a-- form adapted to darcs patches. The @C@ @(x y)@ represents the type-- witness for the patch that should be there. The @Hopefully@ type-- just tells whether we expect the patch to be hashed or not, and-- 'SimpleHopefully' does the real work of emulating-- 'Either'. @Hopefully sh@ represents an expected unhashed patch, and-- @Hashed hash sh@ represents an expected hashed patch with its hash.dataHopefullyaC(xy)=Hopefully(SimpleHopefullyaC(xy))|HashedString(SimpleHopefullyaC(xy))-- | @SimpleHopefully@ is a variant of @Either String@ adapted for-- type witnesses. @Actually@ is the equivalent of @Right@, while-- @Unavailable@ is @Left@.dataSimpleHopefullyaC(xy)=Actually(aC(xy))|UnavailableString-- | @'PatchInfoAnd' p C(a b)@ represents a hope we have to get a-- patch through its info. We're not sure we have the patch, but we-- know its info.dataPatchInfoAndpC(ab)=PIAP!PatchInfo(Hopefully(Namedp)C(ab))instancePrimPatchBasep=>PrimPatchBase(PatchInfoAndp)wheretypePrimOf(PatchInfoAndp)=PrimOfp-- | @'WPatchInfo' C(a b)@ represents the info of a patch, marked with-- the patch's witnesses.newtypeWPatchInfoC(ab)=WPatchInfo{unWPatchInfo::PatchInfo}-- This is actually unsafe if we ever commute patches and then compare them-- using this function. TODO: consider adding an extra existential to WPatchInfo-- (as with TaggedPatch in Darcs.Patch.Choices)compareWPatchInfo::WPatchInfoC(ab)->WPatchInfoC(cd)->EqCheckC((a,b)(c,d))compareWPatchInfo(WPatchInfox)(WPatchInfoy)=ifx==ythenunsafeCoercePIsEqelseNotEqinstanceMyEqWPatchInfowhereWPatchInfox`unsafeCompare`WPatchInfoy=x==yfmapH::(aC(xy)->bC(wz))->HopefullyaC(xy)->HopefullybC(wz)fmapHf(Hopefullysh)=Hopefully(ffsh)whereff(Actuallya)=Actually(fa)ff(Unavailablee)=UnavailableefmapHf(Hashedhsh)=Hashedh(ffsh)whereff(Actuallya)=Actually(fa)ff(Unavailablee)=Unavailableeinfo::PatchInfoAndpC(ab)->PatchInfoinfo(PIAPi_)=ipatchDesc::forallpC(xy).PatchInfoAndpC(xy)->StringpatchDescp=justName$infopwinfo::PatchInfoAndpC(ab)->WPatchInfoC(ab)winfo(PIAPi_)=WPatchInfoi-- | @'piap' i p@ creates a PatchInfoAnd containing p with info i.piap::PatchInfo->NamedpC(ab)->PatchInfoAndpC(ab)piapip=PIAPi(Hopefully$Actuallyp)-- | @n2pia@ creates a PatchInfoAnd representing a @Named@ patch.n2pia::NamedpC(xy)->PatchInfoAndpC(xy)n2piax=patch2patchinfox`piap`xpatchInfoAndPatch::PatchInfo->Hopefully(Namedp)C(ab)->PatchInfoAndpC(ab)patchInfoAndPatch=PIAPfmapPIAP::(FORALL(ab)pC(ab)->qC(ab))->PatchInfoAndpC(xy)->PatchInfoAndqC(xy)fmapPIAPf(PIAPihp)=PIAPi(fmapH(fmapNamedf)hp)fmapFL_PIAP::(FLpC(xy)->FLqC(xy))->PatchInfoAndpC(xy)->PatchInfoAndqC(xy)fmapFL_PIAPf(PIAPihp)=PIAPi(fmapH(fmapFL_Namedf)hp)-- | @'hopefully' hp@ tries to get a patch from a 'PatchInfoAnd'-- value. If it fails, it outputs an error \"failed to read patch:-- \<description of the patch>\". We get the description of the patch-- from the info part of 'hp'hopefully::PatchInfoAndpC(ab)->NamedpC(ab)hopefully=conscientiously$\e->text"failed to read patch:"$$e-- | @'conscientiously' er hp@ tries to extract a patch from a 'PatchInfoAnd'.-- If it fails, it applies the error handling function @er@ to a description-- of the patch info component of @hp@.conscientiously::(Doc->Doc)->PatchInfoAndpC(ab)->NamedpC(ab)conscientiouslyer(PIAPpinfhp)=casehopefully2eitherhpofRightp->pLefte->errorDoc$er(humanFriendlypinf$$texte)-- | @hopefullyM@ is a version of @hopefully@ which calls @fail@ in a-- monad instead of erroring.hopefullyM::Monadm=>PatchInfoAndpC(ab)->m(NamedpC(ab))hopefullyM(PIAPpinfhp)=casehopefully2eitherhpofRightp->returnpLefte->fail$renderString(humanFriendlypinf$$texte)-- Any recommendations for a nice adverb to name the below?hopefully2either::HopefullyaC(xy)->EitherString(aC(xy))hopefully2either(Hopefully(Actuallyp))=Rightphopefully2either(Hashed_(Actuallyp))=Rightphopefully2either(Hopefully(Unavailablee))=Leftehopefully2either(Hashed_(Unavailablee))=Lefteactually::aC(xy)->HopefullyaC(xy)actually=Hopefully.ActuallycreateHashed::String->(String->IO(Sealed(aC(x))))->IO(Sealed(HopefullyaC(x)))createHashedhf=domapSeal(Hashedh)`fmap`unsafeInterleaveIO(f'`catchNonSignal`handler)wheref'=doSealedx<-fhreturn(Sealed(Actuallyx))handlere=return$seal$Unavailable$prettyExceptioneextractHash::PatchInfoAndpC(ab)->Either(NamedpC(ab))StringextractHash(PIAP_(Hasheds_))=RightsextractHashhp=Left$conscientiously(\e->text"unable to read patch:"$$e)hpunavailable::String->HopefullyaC(xy)unavailable=Hopefully.Unavailableinstance(Commutep,MyEqp)=>MyEq(PatchInfoAndp)whereunsafeCompare(PIAPi_)(PIAPi2_)=i==i2--instance Invert (p C(x y)) => Invert (PatchInfoAnd (p C(x y))) whereinstance(Commutep,Invertp)=>Invert(PatchInfoAndp)whereinvert(PIAPip)=PIAPi(invert`fmapH`p)instancePatchListFormat(PatchInfoAndp)instance(PatchListFormatp,ShowPatchBasicp)=>ShowPatchBasic(PatchInfoAndp)whereshowPatch(PIAPnp)=casehopefully2eitherpofRightx->showPatchxLeft_->humanFriendlyninstance(Applyp,Conflictp,CommuteNoConflictsp,IsHunkp,PatchListFormatp,PrimPatchBasep,ShowPatchp,ApplyStatep~Tree)=>ShowPatch(PatchInfoAndp)whereshowContextPatch(PIAPnp)=casehopefully2eitherpofRightx->showContextPatchxLeft_->return$humanFriendlyndescription(PIAPn_)=humanFriendlynsummary(PIAPnp)=casehopefully2eitherpofRightx->summaryxLeft_->humanFriendlynsummaryFL=vcat.mapFLsummaryshowNicely(PIAPnp)=casehopefully2eitherpofRightx->showNicelyxLeft_->humanFriendlyninstanceCommutep=>Commute(PatchInfoAndp)wherecommute(x:>y)=doy':>x'<-commute(hopefullyx:>hopefullyy)return$(infoy`piap`y'):>(infox`piap`x')instanceMergep=>Merge(PatchInfoAndp)wheremerge(x:\/:y)=casemerge(hopefullyx:\/:hopefullyy)ofy':/\:x'->(infoy`piap`y'):/\:(infox`piap`x')instancePatchInspectp=>PatchInspect(PatchInfoAndp)wherelistTouchedFiles=listTouchedFiles.hopefullyhunkMatches__=error"hunkmatches not implemented for PatchInfoAnd"instanceApplyp=>Apply(PatchInfoAndp)wheretypeApplyState(PatchInfoAndp)=ApplyStatepapplyp=apply$hopefullypinstanceRepairToFLp=>Repair(PatchInfoAndp)whereapplyAndTryToFixp=domp'<-applyAndTryToFix$hopefullypcasemp'ofNothing->returnNothingJust(e,p')->return$Just(e,n2piap')instance(ReadPatchp,PatchListFormatp)=>ReadPatch(PatchInfoAndp)wherereadPatch'=mapSealn2pia<$>readPatch'instanceEffectp=>Effect(PatchInfoAndp)whereeffect=effect.hopefullyeffectRL=effectRL.hopefullyinstanceIsHunk(PatchInfoAndp)whereisHunk_=Nothinginstance(RepoPatchp,ApplyStatep~Tree)=>Patchy(PatchInfoAndp)