{-# OPTIONS_GHC -cpp #-}{-# LANGUAGE CPP #-}-- Copyright (C) 2003-2004 Jan Scheffczyk and 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.#include "gadts.h"moduleDarcs.Population(Population,patchChanges,applyToPop,getPopFrom,setPopState,DirMark(..),getRepoPop,getRepoPopVersion,modifiedToXml,lookupPop,lookupCreationPop,)whereimportqualifiedData.ByteString.Char8asBC(unpack,singleton,pack)importData.Maybe(catMaybes)importDarcs.Utils(withCurrentDirectory)importDarcs.Hopefully(PatchInfoAnd,hopefully,info)importDarcs.Patch.FileName(fn2fp,fp2fn,fn2ps,normPath)importDarcs.Patch(RepoPatch,applyToPop,patchcontents,patchChanges,Effect,effect)importDarcs.Witnesses.Ordered(FL(..),RL(..),reverseRL,concatRL,mapRL)importDarcs.Patch.Info(PatchInfo,idpatchinfo,toXml)importDarcs.Patch.Set(PatchSet(..),newset2FL,newset2RL)#ifdef GADT_WITNESSESimportDarcs.Patch.Set(Origin)#endifimportDarcs.Witnesses.Sealed(Sealed(..),seal,unseal)importDarcs.Repository(withRepositoryDirectory,($-),readRepo)importDarcs.Repository.Pristine(identifyPristine,getPristinePop)importDarcs.PopulationData(Population(..),PopTree(..),Info(..),DirMark(..),setPopState,getPopFrom)importPrinter(empty,text,($$),(<>),Doc)importControl.Monad(liftM)#include "impossible.h"-- | population of an empty repositoryinitPop::PopulationinitPop=Popidpatchinfo(PopDiri[])wherei=Info{nameI=BC.singleton'.',modifiedByI=idpatchinfo,modifiedHowI=DullDir,createdByI=Nothing,creationNameI=Just(BC.singleton'.')}-- | apply a patchset to a populationapplyPatchSetPop::RepoPatchp=>PatchSetpC(Originx)->Population->PopulationapplyPatchSetPoppspop=applyPatchesPop(newset2FLps)pop-- | apply Patches to a populationapplyPatchesPop::Effectp=>FL(PatchInfoAndp)C(xy)->Population->PopulationapplyPatchesPopNilFL=idapplyPatchesPop(hp:>:hps)=applyPatchesPophps.applyToPop(infohp)(effect$patchcontents$hopefullyhp)-- | get the pristine population from a repogetRepoPop::FilePath->IOPopulationgetRepoPoprepobasedir=withRepositoryDirectory[]repobasedir$-\repository->dopinfo<-(head.mapRLinfo.newset2RL)`liftM`readReporepository-- pinfo is the latest patchinfomp<-withCurrentDirectoryrepobasedir$identifyPristine>>=getPristinePoppinfocasempof(Justpop)->returnpop(Nothing)->getRepoPopVersionrepobasedirpinfogetRepoPopVersion::FilePath->PatchInfo->IOPopulationgetRepoPopVersionrepobasedirpinfo=withRepositoryDirectory[]repobasedir$-\repository->dopips<-newset2RL`liftM`readReporepositoryreturn$(unsealapplyPatchSetPop)(mkPatchSet$dropWhileRL((/=pinfo).info)pips)initPopwheremkPatchSet(Sealedxs)=seal$PatchSetxsNilRLdropWhileRL::(FORALL(xy)aC(xy)->Bool)->RLaC(rv)->Sealed(RLaC(r))dropWhileRL_NilRL=sealNilRLdropWhileRLpxs@(x:<:xs')|px=dropWhileRLpxs'|otherwise=sealxs-- Routines for pulling data conveniently out of a PopulationlookupPop::FilePath->Population->MaybePopulationlookupPopfp=lookupPop'(BC.unpack$fn2ps$fp2fnf)plookupPop'::String->Population->MaybePopulationlookupPop'fp@(Pop_(PopFilei))|BC.unpack(nameIi)==f=Justp|otherwise=NothinglookupPop'dp@(Poppinfo(PopDiric))|BC.unpack(nameIi)=="."=casecatMaybes$map(lookupPop'(dropDSd).(Poppinfo))cof[apop]->Justapop[]->Nothing_->impossible|BC.unpack(nameIi)==takeWhile(/='/')d=casedropWhile(=='/')$dropWhile(/='/')dof""->Justpd'->casecatMaybes$map(lookupPop'd'.(Poppinfo))cof[apop]->Justapop[]->Nothing_->impossible|otherwise=NothingwheredropDS('.':'/':f)=dropDSfdropDSf=flookupCreationPop::PatchInfo->FilePath->Population->MaybePopulationlookupCreationPoppinfofp=lookupCreationPop'pinfo(BC.unpack$fn2ps$fp2fnf)plookupCreationPop'::PatchInfo->String->Population->MaybePopulationlookupCreationPop'ba(Poppinfopp)=(Poppinfo)`fmap`lcpppwherelcpp@(PopFilei)|fixname`fmap`creationNameIi==f&&createdByIi==who=Justp|otherwise=Nothinglcpp@(PopDiric)|fixname`fmap`creationNameIi==f&&createdByIi==who=Justp|otherwise=casecatMaybes$maplcpcof[apop]->Justapop_->Nothingfixname=BC.pack.fn2fp.normPath.fp2fn.BC.unpackf=Just$BC.pack$fn2fp$normPath$fp2fnawho=JustbmodifiedToXml::Info->DocmodifiedToXmli|modifiedHowIi==DullDir=empty|modifiedHowIi==DullFile=emptymodifiedToXmli=text"<modified>"$$text"<modified_how>"<>text(show(modifiedHowIi))<>text"</modified_how>"$$toXml(modifiedByIi)$$text"</modified>"