-- Copyright (C) 2002-2003 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.{-# LANGUAGE CPP #-}moduleDarcs.Patch.Read(ReadPatch(..),readPatch,readPatchPartial,bracketedFL,peekfor,readFileName)whereimportPreludehiding(pi)importByteStringUtils(dropSpace)importqualifiedData.ByteStringasB(ByteString,null)importDarcs.Patch.Bracketed(Bracketed(..),unBracketedFL)importDarcs.Patch.FileName(FileName,fp2fn,ps2fn,decodeWhite)importDarcs.Patch.Format(PatchListFormat(..),ListFormat(..),FileNameFormat(..))importDarcs.Patch.ReadMonads(ParserM,parseStrictly,choice,lexChar,lexString,checkConsumes)importDarcs.Witnesses.Ordered(FL(..),RL,reverseFL)importDarcs.Witnesses.Sealed(Sealed(..),mapSeal)importControl.Applicative((<$>),(<|>))importControl.Monad(mzero)importqualifiedData.ByteString.Char8asBC(ByteString,unpack)#include "gadts.h"classReadPatchpwherereadPatch'::ParserMm=>m(Sealed(pC(x)))readPatchPartial::ReadPatchp=>B.ByteString->Maybe(Sealed(pC(x)),B.ByteString)readPatchPartialps=caseparseStrictlyreadPatch'psofJust(p,ps')->Just(p,ps')_->NothingreadPatch::ReadPatchp=>B.ByteString->Maybe(Sealed(pC(x)))readPatchps=casereadPatchPartialpsofJust(p,ps')|B.null(dropSpaceps')->Justp_->NothinginstanceReadPatchp=>ReadPatch(Bracketedp)wherereadPatch'=mapSealBraced<$>bracketedFLreadPatch''{''}'<|>mapSealParens<$>bracketedFLreadPatch''('')'<|>mapSealSingleton<$>readPatch'instance(ReadPatchp,PatchListFormatp)=>ReadPatch(FLp)wherereadPatch'|ListFormatV1<-patchListFormat::ListFormatp=mapSealunBracketedFL<$>readPatch'-- in the V2 format case, we only need to support () on reading, not {}-- for simplicity we just go through the same code path.|ListFormatV2<-patchListFormat::ListFormatp=mapSealunBracketedFL<$>readPatch'|otherwise=read_patcheswhereread_patches::ParserMm=>m(Sealed(FLpC(x)))read_patches=do--tracePeek "starting FL read"-- checkConsumes is needed to make sure that something is read,-- to avoid stack overflow when parsing FL (FL p)mp<-(Just<$>checkConsumesreadPatch')<|>returnNothingcasempofJust(Sealedp)->do--tracePeek "found one patch"Sealedps<-read_patchesreturn$Sealed(p:>:ps)Nothing->return$SealedNilFL-- tracePeek x = do y <- peekInput-- traceDoc (greenText x $$ greenText (show $ sal_to_string y)) return ()instance(ReadPatchp,PatchListFormatp)=>ReadPatch(RLp)wherereadPatch'=mapSealreverseFL<$>readPatch'{-# INLINE bracketedFL #-}bracketedFL::forallpmC(x).(ParserMm)=>(FORALL(y)m(Sealed(pC(y))))->Char->Char->m(Sealed(FLpC(x)))bracketedFLparserprepost=peekforcprebflmzerowherebfl::FORALL(z)m(Sealed(FLpC(z)))bfl=peekforcpost(return$SealedNilFL)(doSealedp<-parserSealedps<-bflreturn$Sealed(p:>:ps)){-# INLINE peekforc #-}peekforc::ParserMm=>Char->ma->ma->mapeekforccifstrifnot=choice[lexCharc>>ifstr,ifnot]peekfor::ParserMm=>BC.ByteString->ma->ma->mapeekforpsifstrifnot=choice[dolexStringpsifstr,ifnot]{-# INLINE peekfor #-}readFileName::FileNameFormat->B.ByteString->FileNamereadFileNameOldFormat=ps2fnreadFileNameNewFormat=fp2fn.decodeWhite.BC.unpack