{-# OPTIONS_GHC -fno-warn-orphans #-}{-# LANGUAGE CPP #-}-- 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,UseIndex(..),ScanKnown(..))whereimportPreludehiding(filter,catch)importControl.Monad(when)importControl.Applicative((<$>))importControl.Exception(catch,IOException)importData.Maybe(isJust)importData.List(union)importText.Regex(matchRegex)importSystem.Directory(removeFile,doesFileExist,doesDirectoryExist,renameFile)importSystem.FilePath((</>))importqualifiedData.ByteStringasBSimportqualifiedData.ByteString.Char8asBSCimportDarcs.Patch(RepoPatch,PrimOf,sortCoalesceFL,fromPrim,effect)importDarcs.Patch.Apply(ApplyState,applyToTree,effectOnFilePaths)importDarcs.Witnesses.Ordered(FL(..),(+>+),mapFL_FL)importDarcs.Witnesses.Eq(EqCheck(IsEq,NotEq))importDarcs.Witnesses.Unsafe(unsafeCoerceP)importDarcs.Witnesses.Sealed(Sealed(Sealed),seal,unFreeLeft,mapSeal)importDarcs.Diff(treeDiff)importDarcs.Flags(UseIndex(..),ScanKnown(..))importDarcs.Global(darcsdir)importDarcs.Utils(filterPaths)importDarcs.Repository.InternalTypes(Repository(..))importDarcs.Repository.Format(formatHas,RepoProperty(NoWorkingDir))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}-- TODO: We wrap the pending patch inside RepoPatch here, to avoid the-- requirement to propagate an (ApplyState (PrimOf p) ~ ApplyState p)-- constraint everywhere. When we have GHC 7.2 as a minimum requirement, we can-- lift this constraint into RepoPatch superclass context and remove this hack.readPendingLL::(RepoPatchp,ApplyStatep~Tree)=>RepositorypC(rut)->IO(Sealed((FLp)C(t)))readPendingLLrepo=mapSeal(mapFL_FLfromPrim)`fmap`LowLevel.readPendingrepo-- | 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.restrictSubpaths::forallpmC(rut).(RepoPatchp,ApplyStatep~Tree)=>RepositorypC(rut)->[SubPath]->IO(TreeFilterm)restrictSubpathsreposubpaths=doSealedpending<-readPendingLLrepoletpaths=map(fn2fp.sp2fn)subpathspaths'=paths`union`(effectOnFilePathspendingpaths)anchored=mapfloatPathpaths'restrictPaths::FilterTreetreem=>treem->treemrestrictPaths=filter(filterPathsanchored)return(TreeFilterrestrictPaths)-- |Is the given path in (or equal to) the _darcs metadata directory?inDarcsDir::AnchoredPath->BoolinDarcsDir(AnchoredPath(Namex:_))|x==BSC.packdarcsdir=TrueinDarcsDir_=False-- | 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'p|inDarcsDirp=Falseboring'p=not$any(\rx->isJust$matchRegexrxp')boringwherep'=anchorPath""prestrictTree::FilterTreetm=>tm->tmrestrictTree=filter$\p_->casefindguidepofNothing->boring'p_->Truereturn(TreeFilterrestrictTree)-- | Construct a Tree filter that removes any darcs metadata files the-- Tree might have contained.restrictDarcsdir::forallm.TreeFiltermrestrictDarcsdir=TreeFilter$filter$\p_->not(inDarcsDirp)-- | For a repository and an optional list of paths (when Nothing, 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 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::forallpC(rut).(RepoPatchp,ApplyStatep~Tree)=>(UseIndex,ScanKnown)->RepositorypC(rut)->Maybe[SubPath]->IO(FL(PrimOfp)C(tu))unrecordedChanges_r@(Repo__rf_)_|(formatHasNoWorkingDirrf)=doIsEq<-return$workDirLessRepoWitnessrreturnNilFLunrecordedChanges(useidx,scan)repombpaths=do(all_current,Sealed(pending::FLpC(tx)))<-readPendingreporelevant<-maybe(return$TreeFilterid)(restrictSubpathsrepo)mbpathsletgetIndex=I.updateIndex=<<(applyTreeFilterrelevant<$>readIndexrepo)current=applyTreeFilterrelevantall_currentindex<-getIndexworking<-applyTreeFilterrestrictDarcsdir<$>casescanofScanKnown->caseuseidxofUseIndex->getIndexIgnoreIndex->doguide<-expandcurrentapplyTreeFilterrelevant<$>restrictguide<$>readPlainTree"."ScanAll->dononboring<-restrictBoringindexplain<-applyTreeFilterrelevant<$>applyTreeFilternonboring<$>readPlainTree"."return$caseuseidxofUseIndex->plain`overlay`indexIgnoreIndex->plainScanBoring->doplain<-applyTreeFilterrelevant<$>readPlainTree"."return$caseuseidxofUseIndex->plain`overlay`indexIgnoreIndex->plainft<-filetypeFunctionSealed(diff::FL(PrimOfp)C(xy))<-(unFreeLeft`fmap`treeDiffftcurrentworking)::IO(Sealed(FL(PrimOfp)C(x)))IsEq<-return(unsafeCoercePIsEq)::IO(EqCheckC(yu))return$sortCoalesceFL(effectpending+>+diff)-- | Witnesses the fact that in the absence of a working directory, we-- pretend that the working dir updates magically to the tentative state.workDirLessRepoWitness::RepositorypC(rut)->(EqCheckC(ut))workDirLessRepoWitness(Repo__rf_)|formatHasNoWorkingDirrf=unsafeCoercePIsEq|otherwise=NotEq-- | 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,ApplyStatep~Tree)=>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 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,ApplyStatep~Tree)=>RepositorypC(rut)->Maybe[SubPath]->IO(TreeIO)readUnrecordedrepombpaths=dorelevant<-maybe(return$TreeFilterid)(restrictSubpathsrepo)mbpathsreadIndexrepo>>=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,ApplyStatep~Tree)=>RepositorypC(rut)->IO(TreeIO)readRecordedAndPendingrepo=fst`fmap`readPendingreporeadPending::(RepoPatchp,ApplyStatep~Tree)=>RepositorypC(rut)->IO(TreeIO,Sealed(FLpC(t)))readPendingrepo=doSealedpending<-readPendingLLrepopristine<-readRecordedrepocatch((\t->(t,sealpending))`fmap`applyToTreependingpristine)$\(err::IOException)->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,ApplyStatep~Tree)=>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