-- Copyright (C) 2002-2005 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 #-}{-# LANGUAGE CPP #-}#include "gadts.h"moduleDarcs.Repository.Checkpoint(get_checkpoint,get_checkpoint_by_default,identify_checkpoint,write_checkpoint,write_recorded_checkpoint,write_checkpoint_patch,)whereimportSystem.Directory(setCurrentDirectory,createDirectoryIfMissing)importWorkaround(getCurrentDirectory)importSystem.IO.Unsafe(unsafeInterleaveIO)importData.Maybe(listToMaybe,catMaybes)importDarcs.Hopefully(PatchInfoAnd,hopefully,info)importqualifiedData.ByteStringasB(null,empty,ByteString)importDarcs.Lock(withTempDir,writeDocBinFile)importDarcs.SlurpDirectory(Slurpy,empty_slurpy,mmap_slurp,)importDarcs.Patch(RepoPatch,Patch,Named,Prim,invertRL,patch2patchinfo,apply_to_slurpy,patchcontents,effect,fromPrims,is_setpref,infopatch,readPatch,gzWritePatch)importDarcs.Ordered(RL(..),FL(..),EqCheck(IsEq,NotEq),(+>+),filterFL,unsafeCoerceP,mapRL,mapFL_FL,mapRL_RL,reverseRL,concatRL,concatFL)importDarcs.Repository.Internal(Repository(..),read_repo,slurp_recorded,withRecorded)importDarcs.Repository.ApplyPatches(apply_patches)importDarcs.Patch.Info(PatchInfo,make_filename,readPatchInfo,showPatchInfo)importDarcs.Diff(unsafeDiff)importDarcs.External(gzFetchFilePS,fetchFilePS,Cachable(..))importDarcs.Flags(DarcsFlag(LookForAdds,Partial,Complete))importDarcs.Patch.Depends(get_patches_beyond_tag,get_patches_in_tag)importDarcs.Repository.Prefs(filetype_function)importDarcs.Utils(catchall)importDarcs.RepoPath(ioAbsoluteOrRemote,toPath)importDarcs.Global(darcsdir)importPrinter(Doc,($$),empty)#include "impossible.h"importDarcs.Sealed(Sealed(Sealed),FlippedSeal(..),Sealed2(Sealed2),seal,seal2)importControl.Monad(liftM)read_patch_ids::B.ByteString->[PatchInfo]read_patch_idsinv|B.nullinv=[]read_patch_idsinv=casereadPatchInfoinvofJust(pinfo,r)->pinfo:read_patch_idsrNothing->[]read_checkpoints::String->IO[(PatchInfo,MaybeSlurpy)]read_checkpointsd=dorealdir<-toPath`fmap`ioAbsoluteOrRemotedpistr<-fetchFilePS(realdir++"/"++darcsdir++"/checkpoints/inventory")Uncachable`catchall`returnB.emptypis<-return$reverse$read_patch_idspistrslurpies<-sequence$map(fetch_checkpointrealdir)pisreturn$zippisslurpieswherefetch_checkpointrpinfo=unsafeInterleaveIO$dopstr<-gzFetchFilePS(r++"/"++darcsdir++"/checkpoints/"++make_filenamepinfo)Cachablecasefst`fmap`(readPatchpstr::Maybe(Sealed(NamedPatchC(x)),B.ByteString))ofNothing->returnNothingJust(Sealedp)->return$apply_to_slurpypempty_slurpyget_checkpoint::RepoPatchp=>RepositorypC(rut)->IO(Maybe(Sealed(NamedpC(x))))get_checkpointrepository@(Repo_opts__)=ifPartial`elem`optsthenget_check_internalrepositoryelsereturnNothingget_checkpoint_by_default::RepoPatchp=>RepositorypC(rut)->IO(Maybe(Sealed(NamedpC(x))))get_checkpoint_by_defaultrepository@(Repo_opts__)=ifComplete`elem`optsthenreturnNothingelseget_check_internalrepositoryidentify_checkpoint::RepoPatchp=>RepositorypC(rut)->IO(MaybePatchInfo)identify_checkpointrepository@(Repor___)=dopis<-(mapsp2i.catMaybes.mapRLlastRL)`liftM`read_reporepositorypistr<-fetchFilePS(r++"/"++darcsdir++"/checkpoints/inventory")Uncachable`catchall`returnB.emptyreturn$listToMaybe$filter(`elem`pis)$reverse$read_patch_idspistrwherelastRL::RLaC(xy)->Maybe(Sealed2a)lastRLas=doSealedps<-headFL(reverseRLas)return$seal2psheadFL::FLaC(xy)->Maybe(Sealed(aC(x)))headFL(x:>:_)=Just$sealxheadFLNilFL=Nothingsp2i::Sealed2(PatchInfoAndp)->PatchInfosp2i(Sealed2p)=infopget_check_internal::RepoPatchp=>RepositorypC(rut)->IO(Maybe(Sealed(NamedpC(x))))get_check_internalrepository@(Repor___)=domc<-identify_checkpointrepositorycasemcofNothing->returnNothingJustpinfo->dops<-gzFetchFilePS(r++"/"++darcsdir++"/checkpoints/"++make_filenamepinfo)Cachablereturn$casereadPatchpsofJust(p,_)->JustpNothing->Nothingformat_inv::[PatchInfo]->Docformat_inv[]=emptyformat_inv(pinfo:ps)=showPatchInfopinfo$$format_invpswrite_recorded_checkpoint::RepoPatchp=>RepositorypC(rut)->PatchInfo->IO()write_recorded_checkpointr@(Repo____)pinfo=doSealedps<-(seal.mapFL_FLhopefully.reverseRL.concatRL)`liftM`read_reporftf<-filetype_functions<-slurp_recordedrwrite_checkpoint_patch$infopatchpinfo(fromPrims$changeppsps+>+unsafeDiff[LookForAdds]ftfempty_slurpys::PatchC(()y))wherechangeps=filterFLis_setprefFL.effect.patchcontentschangepps=concatFL.mapFL_FLchangepsis_setprefFL::PrimC(xy)->EqCheckC(xy)is_setprefFLp|is_setprefp=NotEq|otherwise=unsafeCoercePIsEqwrite_checkpoint::RepoPatchp=>RepositorypC(rut)->PatchInfo->IO()write_checkpointrepo@(Repo____)pinfo=dorepodir<-getCurrentDirectorySealedpit<-get_patches_in_tagpinfo`liftM`read_reporepoletps=(reverseRL.mapRL_RLhopefully.concatRL)pitftf<-filetype_functionwith_tagrepopinfo$dos<-mmap_slurp"."setCurrentDirectoryrepodirwrite_checkpoint_patch$infopatchpinfo$(fromPrims$changeppsps+>+unsafeDiff[LookForAdds]ftfempty_slurpys::PatchC(()y))wherechangeps=filterFLis_setprefFL.effect.patchcontentschangepps=concatFL.mapFL_FLchangepswrite_checkpoint_patch::RepoPatchp=>NamedpC(xy)->IO()write_checkpoint_patchp=docreateDirectoryIfMissingFalse(darcsdir++"/checkpoints")gzWritePatch(darcsdir++"/checkpoints/"++make_filename(patch2patchinfop))pcpi<-(mapfst)`fmap`read_checkpoints"."writeDocBinFile(darcsdir++"/checkpoints/inventory")$format_inv$reverse$patch2patchinfop:cpiwith_tag::RepoPatchp=>RepositorypC(rut)->PatchInfo->(IO())->IO()with_tagrpinfojob=dops<-read_reporcaseget_patches_beyond_tagpinfopsofFlippedSeal(extras:<:NilRL)->withRecordedr(withTempDir"checkpoint")$\_->doapply_patches[]$invertRLextrasjob_->bug"with_tag"