-- Copyright (C) 2002-2004 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.Patch.TouchesFiles(look_touch,choose_touching,select_touching,deselect_not_touching,select_not_touching,)whereimportData.List(sort)importDarcs.Patch.Choices(PatchChoices,Tag,TaggedPatch,patch_choices,tag,get_choices,force_firsts,force_lasts,tp_patch,)importDarcs.Patch(Patchy,apply_to_filepaths,list_touched_files)importDarcs.Ordered(FL(..),(:>)(..),mapFL_FL,(+>+))importDarcs.Sealed(Sealed,seal)select_touching::Patchyp=>[FilePath]->PatchChoicespC(xy)->PatchChoicespC(xy)select_touching[]pc=pcselect_touchingfilespc=force_firstsxspcwherect::Patchyp=>[FilePath]->FL(TaggedPatchp)C(xy)->[Tag]ct_NilFL=[]ctfs(tp:>:tps)=caselook_touchfs(tp_patchtp)of(True,fs')->tagtp:ctfs'tps(False,fs')->ctfs'tpsxs=caseget_choicespcof_:>mc:>lc->ct(mapfixfiles)(mc+>+lc)deselect_not_touching::Patchyp=>[FilePath]->PatchChoicespC(xy)->PatchChoicespC(xy)deselect_not_touching[]pc=pcdeselect_not_touchingfilespc=force_lastsxspcwherect::Patchyp=>[FilePath]->FL(TaggedPatchp)C(xy)->[Tag]ct_NilFL=[]ctfs(tp:>:tps)=caselook_touchfs(tp_patchtp)of(True,fs')->ctfs'tps(False,fs')->tagtp:ctfs'tpsxs=caseget_choicespcoffc:>mc:>_->ct(mapfixfiles)(fc+>+mc)select_not_touching::Patchyp=>[FilePath]->PatchChoicespC(xy)->PatchChoicespC(xy)select_not_touching[]pc=pcselect_not_touchingfilespc=force_firstsxspcwherect::Patchyp=>[FilePath]->FL(TaggedPatchp)C(xy)->[Tag]ct_NilFL=[]ctfs(tp:>:tps)=caselook_touchfs(tp_patchtp)of(True,fs')->ctfs'tps(False,fs')->tagtp:ctfs'tpsxs=caseget_choicespcoffc:>mc:>_->ct(mapfixfiles)(fc+>+mc)fix::FilePath->FilePathfixf|take1(reversef)=="/"=fix$reverse$drop1$reverseffix""="."fix"."="."fixf="./"++fchoose_touching::Patchyp=>[FilePath]->FLpC(xy)->Sealed(FLpC(x))choose_touching[]p=sealpchoose_touchingfilesp=caseget_choices$select_touchingfiles$patch_choicespoffc:>_:>_->seal$mapFL_FLtp_patchfclook_touch::Patchyp=>[FilePath]->pC(xy)->(Bool,[FilePath])look_touchfsp=(any(\tf->any(affectstf)fs)(list_touched_filesp)||fs'/=fs,fs')whereaffectstouchedf|touched==f=Trueaffectstf=casesplitAt(lengthf)tof(t','/':_)->t'==f_->casesplitAt(lengtht)fof(f','/':_)->f'==t_->Falsefs'=sort$apply_to_filepathspfs