{-# LANGUAGE CPP #-}{-# OPTIONS_GHC -cpp -fglasgow-exts -fno-warn-orphans #-}-- Copyright (C) 2009 Petr Rockai---- Permission is hereby granted, free of charge, to any person-- obtaining a copy of this software and associated documentation-- files (the "Software"), to deal in the Software without-- restriction, including without limitation the rights to use, copy,-- modify, merge, publish, distribute, sublicense, and/or sell copies-- of the Software, and to permit persons to whom the Software is-- furnished to do so, subject to the following conditions:---- The above copyright notice and this permission notice shall be-- included in all copies or substantial portions of the Software.---- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND-- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS-- BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN-- ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN-- CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE-- SOFTWARE.moduleDarcs.Repository.State(restrictSubpaths,restrictBoring,TreeFilter(..)-- * Diffs.,unrecordedChanges,readPending-- * Trees.,readRecorded,readUnrecorded,readRecordedAndPending,readWorking-- * Index.,readIndex,invalidateIndex)whereimportPreludehiding(filter)importControl.Monad(when)importControl.Applicative((<$>))importData.Maybe(isJust)importData.List(union)importText.Regex(matchRegex)importSystem.Directory(removeFile,doesFileExist,doesDirectoryExist,renameFile)importSystem.FilePath((</>))importqualifiedData.ByteStringasBSimportqualifiedData.ByteString.Char8asBSCimportDarcs.Patch(RepoPatch,Prim,invert,applyToTree,applyToFilepaths,sortCoalesceFL)importDarcs.Patch.TouchesFiles(chooseTouching)importDarcs.Witnesses.Ordered(FL(..),(+>+))importDarcs.Witnesses.Ordered(unsafeCoerceP,EqCheck(IsEq))importDarcs.Witnesses.Sealed(Sealed(Sealed),seal,unFreeLeft)importDarcs.Diff(treeDiff)importDarcs.Flags(DarcsFlag(LookForAdds),willIgnoreTimes)importDarcs.Global(darcsdir)importDarcs.Utils(filterPaths)importDarcs.Repository.InternalTypes(Repository)importqualifiedDarcs.Repository.LowLevelasLowLevelimportDarcs.Repository.Prefs(filetypeFunction,boringRegexps)importDarcs.Patch.FileName(fn2fp)importDarcs.RepoPath(SubPath,sp2fn)importStorage.Hashed.AnchoredPath(AnchoredPath(..),anchorPath,floatPath,Name(..))importStorage.Hashed.Tree(Tree,restrict,FilterTree,expand,filter,emptyTree,overlay,find)importStorage.Hashed.Plain(readPlainTree)importStorage.Hashed.Darcs(darcsTreeHash,readDarcsHashed,decodeDarcsHash,decodeDarcsSize)importStorage.Hashed.Hash(Hash(NoHash))importqualifiedStorage.Hashed.IndexasIimportqualifiedStorage.Hashed.TreeasTree#include "gadts.h"newtypeTreeFilterm=TreeFilter{applyTreeFilter::foralltr.FilterTreetrm=>trm->trm}-- | From a repository and a list of SubPath's, construct a filter that can be-- used on a Tree (recorded or unrecorded state) of this repository. This-- constructed filter will take pending into account, so the subpaths will be-- translated correctly relative to pending move patches. As an exception for-- convenience, if the subpath list is empty, the filter constructed is an-- identity.restrictSubpaths::(RepoPatchp)=>RepositorypC(rut)->[SubPath]->IO(TreeFilterm)restrictSubpathsreposubpaths=doSealedpending<-LowLevel.readPendingrepoletpaths=map(fn2fp.sp2fn)subpathspaths'=paths`union`applyToFilepathspendingpathsanchored=mapfloatPathpaths'restrictPaths::FilterTreetm=>tm->tmrestrictPaths=ifnullsubpathsthenidelsefilter(filterPathsanchored)return(TreeFilterrestrictPaths)-- | Construct a Tree filter that removes any boring files the Tree might have-- contained. Additionally, you should (in most cases) pass an (expanded) Tree-- that corresponds to the recorded content of the repository. This is-- important in the cases when the repository contains files that would be-- boring otherwise. (If you pass emptyTree instead, such files will simply be-- discarded by the filter, which is usually not what you want.)---- This function is most useful when you have a plain Tree corresponding to the-- full working copy of the repository, including untracked-- files. Cf. whatsnew, record --look-for-adds. NB. Assumes that our CWD is-- the repository root.restrictBoring::forallm.Treem->IO(TreeFilterm)restrictBoringguide=doboring<-boringRegexpsletboring'(AnchoredPath(Namex:_))|x==BSC.packdarcsdir=Falseboring'p=not$any(\rx->isJust$matchRegexrxp')boringwherep'=anchorPath""prestrictTree::FilterTreetm=>tm->tmrestrictTree=filter$\p_->casefindguidepofNothing->boring'p_->Truereturn(TreeFilterrestrictTree)-- | For a repository and a list of paths (when empty, take everything) compute-- a (forward) list of prims (i.e. a patch) going from the recorded state of-- the repository (pristine) to the unrecorded state of the repository (the-- working copy + pending). When a non-empty list of paths is given, at least-- the files that live under any of these paths in either recorded or-- unrecorded will be included in the resulting patch. NB. More patches may be-- included in this list, eg. the full contents of the pending patch. This is-- usually not a problem, since selectChanges will properly filter the results-- anyway.---- This also depends on the options given: with LookForAdds, we will include-- any non-boring files (i.e. also those that do not exist in the "recorded"-- state) in the working in the "unrecorded" state, and therefore they will-- show up in the patches as addfiles.---- The IgnoreTimes option disables index usage completely -- for each file, we-- read both the unrecorded and the recorded copy and run a diff on them. This-- is very inefficient, although in extremely rare cases, the index could go-- out of sync (file is modified, index is updated and file is modified again-- within a single second).unrecordedChanges::FORALL(prut)(RepoPatchp)=>[DarcsFlag]->RepositorypC(rut)->[SubPath]->IO(FLPrimC(tu))unrecordedChangesoptsrepopaths=do(all_current,Sealed(pending::FLPrimC(tx)))<-readPendingreporelevant<-restrictSubpathsrepopathsletgetIndex=I.updateIndex=<<(applyTreeFilterrelevant<$>readIndexrepo)current=applyTreeFilterrelevantall_currentworking<-case(LookForAdds`elem`opts,willIgnoreTimesopts)of(False,False)->getIndex(False,True)->doguide<-expandcurrentapplyTreeFilterrelevant<$>restrictguide<$>readPlainTree"."(True,ignoretimes)->doindex<-getIndexnonboring<-restrictBoringindexplain<-applyTreeFilterrelevant<$>applyTreeFilternonboring<$>readPlainTree"."return$ifignoretimesthenplainelseplain`overlay`indexft<-filetypeFunctionSealed(diff::FLPrimC(xy))<-(unFreeLeft`fmap`treeDiffftcurrentworking)::IO(Sealed(FLPrimC(x)))IsEq<-return(unsafeCoercePIsEq)::IO(EqCheckC(yu))return$sortCoalesceFL(pending+>+diff)-- | Obtains a Tree corresponding to the "recorded" state of the repository:-- this is the same as the pristine cache, which is the same as the result of-- applying all the repository's patches to an empty directory.---- Handles the plain and hashed pristine cases. Currently does not handle the-- no-pristine case, as that requires replaying patches. Cf. 'readDarcsHashed'-- and 'readPlainTree' in hashed-storage that are used to do the actual 'Tree'-- construction.readRecorded::(RepoPatchp)=>RepositorypC(rut)->IO(TreeIO)readRecorded_repo=doleth_inventory=darcsdir</>"hashed_inventory"hashed<-doesFileExisth_inventoryifhashedthendoinv<-BS.readFileh_inventoryletlinesInv=BSC.split'\n'invcaselinesInvof[]->returnemptyTree(pris_line:_)->dolethash=decodeDarcsHash$BS.drop9pris_linesize=decodeDarcsSize$BS.drop9pris_linewhen(hash==NoHash)$fail$"Bad pristine root: "++showpris_linereadDarcsHashed(darcsdir</>"pristine.hashed")(size,hash)elsedohave_pristine<-doesDirectoryExist$darcsdir</>"pristine"have_current<-doesDirectoryExist$darcsdir</>"current"case(have_pristine,have_current)of(True,_)->readPlainTree$darcsdir</>"pristine"(False,True)->readPlainTree$darcsdir</>"current"(_,_)->fail"No pristine tree is available!"-- | Obtains a Tree corresponding to the "unrecorded" state of the repository:-- the working tree plus the "pending" patch. The optional list of paths (it is-- ignored if empty) allows to restrict the query to a subtree.---- Limiting the query may be more efficient, since hashes on the uninteresting-- parts of the index do not need to go through an up-to-date check (which-- involves a relatively expensive lstat(2) per file.readUnrecorded::(RepoPatchp)=>RepositorypC(rut)->[SubPath]->IO(TreeIO)readUnrecordedrepopaths=dorelevant<-restrictSubpathsrepopathsreadIndexrepo>>=I.updateIndex.applyTreeFilterrelevant-- | Obtains a Tree corresponding to the working copy of the-- repository. NB. Almost always, using readUnrecorded is the right-- choice. This function is only useful in not-completely-constructed-- repositories.readWorking::IO(TreeIO)readWorking=expand=<<(nodarcs`fmap`readPlainTree".")wherenodarcs=Tree.filter(\(AnchoredPath(Namex:_))_->x/=BSC.pack"_darcs")readRecordedAndPending::(RepoPatchp)=>RepositorypC(rut)->IO(TreeIO)readRecordedAndPendingrepo=dopristine<-readRecordedrepoSealedpending<-snd`fmap`readPendingrepoapplyToTreependingpristinereadPending::(RepoPatchp)=>RepositorypC(rut)->IO(TreeIO,Sealed(FLPrimC(t)))readPendingrepo=doSealedpending<-LowLevel.readPendingrepopristine<-readRecordedrepocatch((\t->(t,sealpending))`fmap`applyToTreependingpristine)$\err->doputStrLn$"Yikes, pending has conflicts! "++showerrputStrLn$"Stashing the buggy pending as _darcs/patches/pending_buggy"renameFile"_darcs/patches/pending""_darcs/patches/pending_buggy"return(pristine,sealNilFL)-- | Mark the existing index as invalid. This has to be called whenever the-- listing of pristine changes and will cause darcs to update the index next-- time it tries to read it. (NB. This is about files added and removed from-- pristine: changes to file content in either pristine or working are handled-- transparently by the index reading code.)invalidateIndex::t->IO()invalidateIndex_=doBS.writeFile"_darcs/index_invalid"BS.emptyreadIndex::(RepoPatchp)=>RepositorypC(rut)->IOI.IndexreadIndexrepo=doinvalid<-doesFileExist"_darcs/index_invalid"exist<-doesFileExist"_darcs/index"format_valid<-ifexistthenI.indexFormatValid"_darcs/index"elsereturnTruewhen(exist&&notformat_valid)$#if mingw32_HOST_OSrenameFile"_darcs/index""_darcs/index.old"#elseremoveFile"_darcs/index"#endifif(notexist||invalid||notformat_valid)thendopris<-readRecordedAndPendingrepoidx<-I.updateIndexFrom"_darcs/index"darcsTreeHashpriswheninvalid$removeFile"_darcs/index_invalid"returnidxelseI.readIndex"_darcs/index"darcsTreeHash