-- 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(getCheckpoint,getCheckpointByDefault,identifyCheckpoint,writeCheckpointPatch,)whereimportSystem.Directory(createDirectoryIfMissing)importData.Maybe(listToMaybe)importDarcs.Hopefully(PatchInfoAnd,info)importqualifiedData.ByteStringasB(null,empty,ByteString)importDarcs.Lock(writeDocBinFile)importDarcs.Patch(RepoPatch,Named,patch2patchinfo,readPatch,gzWritePatch)importDarcs.Witnesses.Ordered(mapRL)importDarcs.Repository.Internal(Repository(..),readRepo)importDarcs.Repository.DarcsRepo(readCheckpoints)importDarcs.Patch.Info(PatchInfo,makeFilename,readPatchInfo,showPatchInfo)importDarcs.Patch.Set(PatchSet(..),Tagged(..))importDarcs.External(gzFetchFilePS,fetchFilePS,Cachable(..))importDarcs.Flags(DarcsFlag(Partial,Complete))importDarcs.Utils(catchall)importDarcs.Global(darcsdir)importPrinter(Doc,($$),empty)importDarcs.Witnesses.Sealed(Sealed,Sealed2(Sealed2),seal2)importControl.Monad(liftM)readPatchIds::B.ByteString->[PatchInfo]readPatchIdsinv|B.nullinv=[]readPatchIdsinv=casereadPatchInfoinvofJust(pinfo,r)->pinfo:readPatchIdsrNothing->[]getCheckpoint::RepoPatchp=>RepositorypC(rut)->IO(Maybe(Sealed(NamedpC(x))))getCheckpointrepository@(Repo_opts__)=ifPartial`elem`optsthengetCheckInternalrepositoryelsereturnNothinggetCheckpointByDefault::RepoPatchp=>RepositorypC(rut)->IO(Maybe(Sealed(NamedpC(x))))getCheckpointByDefaultrepository@(Repo_opts__)=ifComplete`elem`optsthenreturnNothingelsegetCheckInternalrepositoryidentifyCheckpoint::RepoPatchp=>RepositorypC(rut)->IO(MaybePatchInfo)identifyCheckpointrepository@(Repor___)=dopis<-(mapsp2i.extractTags)`liftM`readReporepositorypistr<-fetchFilePS(r++"/"++darcsdir++"/checkpoints/inventory")Uncachable`catchall`returnB.emptyreturn$listToMaybe$filter(`elem`pis)$reverse$readPatchIdspistrwhereextractTags::PatchSetpC(startend)->[Sealed2(PatchInfoAndp)]extractTags(PatchSet_ts)=mapRL(\(Taggedt__)->seal2t)tssp2i::Sealed2(PatchInfoAndp)->PatchInfosp2i(Sealed2p)=infopgetCheckInternal::RepoPatchp=>RepositorypC(rut)->IO(Maybe(Sealed(NamedpC(x))))getCheckInternalrepository@(Repor___)=domc<-identifyCheckpointrepositorycasemcofNothing->returnNothingJustpinfo->dops<-gzFetchFilePS(r++"/"++darcsdir++"/checkpoints/"++makeFilenamepinfo)Cachablereturn$casereadPatchpsofJust(p,_)->JustpNothing->NothingformatInv::[PatchInfo]->DocformatInv[]=emptyformatInv(pinfo:ps)=showPatchInfopinfo$$formatInvpswriteCheckpointPatch::RepoPatchp=>NamedpC(xy)->IO()writeCheckpointPatchp=docreateDirectoryIfMissingFalse(darcsdir++"/checkpoints")gzWritePatch(darcsdir++"/checkpoints/"++makeFilename(patch2patchinfop))pcpi<-readCheckpoints"."writeDocBinFile(darcsdir++"/checkpoints/inventory")$formatInv$reverse$patch2patchinfop:cpi