-- Copyright (C) 2005 David Roundy---- This file is licensed under the GPL, version two or later.{-# OPTIONS_GHC -cpp #-}{-# LANGUAGE CPP #-}moduleDarcs.Repository.Format(RepoFormat(..),RepoProperty(..),identifyRepoFormat,createRepoFormat,writeRepoFormat,writeProblem,readProblem,readfromAndWritetoProblem,formatHas,formatHasTogether,)whereimportData.List(sort)importData.Maybe(isJust,catMaybes)importControl.Monad(msum)importDarcs.SignalHandler(catchNonSignal)importDarcs.External(fetchFilePS,Cachable(Cachable))importDarcs.Flags(DarcsFlag(UseFormat2,UseHashedInventory,UseOldFashionedInventory))importDarcs.Lock(writeBinFile)importDarcs.Utils(catchall,prettyException)importProgress(beginTedious,endTedious,finishedOneIO)importDarcs.Global(darcsdir)importByteStringUtils(linesPS)importqualifiedData.ByteString.Char8asBC(split,unpack,singleton,elemIndex,pack)importqualifiedData.ByteStringasB(ByteString,null,empty)importqualifiedByteStringUtilsasBU(intercalate)#include "impossible.h"dataRepoProperty=Darcs1_0|Darcs2|HashedInventory-- | @RepoFormat@ is the representation of the format of a-- repository. Each sublist corresponds to a line in the format-- file. Each line is decomposed into words.newtypeRepoFormat=RF[[B.ByteString]]deriving(Show)-- | The file where the format information should be.df::FilePathdf=darcsdir++"/format"-- | @identifyRepoFormat URL@ identifies the format of the repository-- at the given address. Return @Left reason@ if it fails, where-- @reason@ explains why we weren't able to identify the format.identifyRepoFormat::String->IO(EitherStringRepoFormat)identifyRepoFormatrepo=doletk="Identifying repository "++repobeginTediouskfinishedOneIOk"format"dff<-fetchFilePS(repo++"/"++df)Cachable`catchall`returnB.empty-- below is a workaround for servers that don't return a 404 on nonexistent filesrf<-ifB.nulldff||isJust(BC.elemIndex'<'dff)thendofinishedOneIOk"inventory"have_inventory<-doesRemoteFileExist(repo++"/"++darcsdir++"/inventory")casehave_inventoryofRight_->return$RightdefaultRepoFormatLefte->return$Left$"Not a repository: "++repo++" ("++e++")"elsereturn$Right$parseRepoFormatdffendTediouskreturnrfwheredrfex=fetchFilePSxCachable>>returnTruedoesRemoteFileExistx=(fmapRight)(drfex)`catchNonSignal`(\e->return(Left(prettyExceptione)))-- | @writeRepoFormat@ writes the repo format to the given file.writeRepoFormat::RepoFormat->FilePath->IO()writeRepoFormat(RFrf)loc=writeBinFileloc$unlines$map(BC.unpack.BU.intercalate(BC.singleton'|'))rfparseRepoFormat::B.ByteString->RepoFormatparseRepoFormatps=RF$map(BC.split'|')$filter(not.B.null)$linesPSps-- | The repo format we assume if we do not find a format file.defaultRepoFormat::RepoFormatdefaultRepoFormat=RF[[rp2psDarcs1_0]]createRepoFormat::[DarcsFlag]->RepoFormatcreateRepoFormatfs=RF([maprp2psflags2inv]++maybe2)whereflags2inv|UseFormat2`elem`fs=[HashedInventory]|UseHashedInventory`elem`fs=[HashedInventory]|UseOldFashionedInventory`elem`fs=[Darcs1_0]|otherwise=[HashedInventory]maybe2=ifUseFormat2`notElem`fs&&(UseOldFashionedInventory`elem`fs||UseHashedInventory`elem`fs)then[]else[[rp2psDarcs2]]-- | @writeProblem from@ tells if we can write to a repo in format @form@.-- it returns @Nothing@ if there's no problem writing to such a repository.writeProblem::RepoFormat->MaybeStringwriteProblemrf|isJust$readProblemrf=readProblemrfwriteProblem(RFks)=unlines`fmap`justsOrNothing(mapwpks)wherewpx|allisKnownx=Nothingwp[]=impossiblewpx=Just$unwords$"Can't write repository format: ":mapBC.unpack(filter(not.isKnown)x)-- | @writeProblem from@ tells if we can read and write to a repo in-- format @form@. it returns @Nothing@ if there's no problem reading-- and writing to such a repository.readfromAndWritetoProblem::RepoFormat->RepoFormat->MaybeStringreadfromAndWritetoProbleminrfoutrf|formatHasDarcs2inrf/=formatHasDarcs2outrf=Just"Cannot mix darcs-2 repositories with older formats"|otherwise=msum[readProbleminrf,writeProblemoutrf]-- | @readProblem from@ tells if we can write to a repo in format @form@.-- it returns @Nothing@ if there's no problem reading from such a repository.readProblem::RepoFormat->MaybeStringreadProblemrf|formatHasDarcs1_0rf&&formatHasDarcs2rf=Just"Invalid repositoryformat: format 2 is incompatible with format 1"readProblem(RFks)=unlines`fmap`justsOrNothing(maprpks)whererpx|anyisKnownx=Nothingrp[]=impossiblerpx=Just$unwords$"Can't understand repository format:":mapBC.unpackx-- | Does this version of darcs know how to handle this property?isKnown::B.ByteString->BoolisKnownp=p`elem`maprp2psknownProperties-- | This is the list of properties which this version of darcs knows-- how to handle.knownProperties::[RepoProperty]knownProperties=[Darcs1_0,Darcs2,HashedInventory]justsOrNothing::[Maybex]->Maybe[x]justsOrNothingmxs=casecatMaybesmxsof[]->Nothingxs->JustxsformatHas::RepoProperty->RepoFormat->BoolformatHasf(RFks)=rp2psf`elem`concatksformatHasTogether::[RepoProperty]->RepoFormat->BoolformatHasTogetherfs(RFks)=fht(sort$maprp2psfs)kswherefht_[]=Falsefhtx(y:ys)|x==sorty=True|otherwise=fhtxysrp2ps::RepoProperty->B.ByteStringrp2psDarcs1_0=BC.pack"darcs-1.0"rp2psDarcs2=BC.pack"darcs-2"rp2psHashedInventory=BC.pack"hashed"