{-# LANGUAGE BangPatterns #-}{-# LANGUAGE DeriveDataTypeable #-}{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE RankNTypes #-}-- |-- Copyright: 2011 Michael Snoyman, 2010 John Millikin-- License: MIT---- Consume attoparsec parsers via conduit.---- This code was taken from attoparsec-enumerator and adapted for conduits.moduleData.Conduit.Attoparsec(-- * SinksinkParser-- * Conduit,conduitParser,conduitParserEither-- * Types,ParseError(..),Position(..),PositionRange(..)-- * Classes,AttoparsecInput)whereimportControl.Exception(Exception)importControl.Monad(forever,unless)importControl.Monad.Trans.Class(lift)importqualifiedData.ByteStringasBimportqualifiedData.ByteString.Char8asB8importData.Maybe(fromMaybe)importqualifiedData.TextasTimportData.Typeable(Typeable)importPreludehiding(lines)importqualifiedData.Attoparsec.ByteStringimportqualifiedData.Attoparsec.TextimportqualifiedData.Attoparsec.TypesasAimportData.ConduitimportqualifiedData.Conduit.ListasC-- | The context and message from a 'A.Fail' value.dataParseError=ParseError{errorContexts::[String],errorMessage::String,errorPosition::Position}|DivergentParserderiving(Show,Typeable)instanceExceptionParseErrordataPosition=Position{posLine::{-# UNPACK #-}!Int,posCol::{-# UNPACK #-}!Int}deriving(Eq,Ord)instanceShowPositionwhereshow(Positionlc)=showl++':':showcdataPositionRange=PositionRange{posRangeStart::{-# UNPACK #-}!Position,posRangeEnd::{-# UNPACK #-}!Position}deriving(Eq,Ord)instanceShowPositionRangewhereshow(PositionRangese)=shows++'-':showe-- | A class of types which may be consumed by an Attoparsec parser.classAttoparsecInputawhereparseA::A.Parserab->a->A.IResultabfeedA::A.IResultab->a->A.IResultabempty::aisNull::a->BoolnotEmpty::[a]->[a]getLinesCols::a->(Int,Int)take'::Int->a->alength'::a->IntinstanceAttoparsecInputB.ByteStringwhereparseA=Data.Attoparsec.ByteString.parsefeedA=Data.Attoparsec.ByteString.feedempty=B.emptyisNull=B.nullnotEmpty=filter(not.B.null)getLinesColsb=(lines,cols)wherelines=B.count10bcols=caseB8.linesbof[]->0ls->B.length$lastlstake'=B.takelength'=B.lengthinstanceAttoparsecInputT.TextwhereparseA=Data.Attoparsec.Text.parsefeedA=Data.Attoparsec.Text.feedempty=T.emptyisNull=T.nullnotEmpty=filter(not.T.null)getLinesColst=(lines,cols)wherelines=T.count(T.pack"\n")tcols=caseT.linestof[]->0ls->T.length$lastlstake'=T.takelength'=T.length-- | Convert an Attoparsec 'A.Parser' into a 'Sink'. The parser will-- be streamed bytes until it returns 'A.Done' or 'A.Fail'.---- If parsing fails, a 'ParseError' will be thrown with 'monadThrow'.---- Since 0.5.0sinkParser::(AttoparsecInputa,MonadThrowm)=>A.Parserab->ConsumerambsinkParser=fmapsnd.sinkParserPosErr(Position11)-- | Consume a stream of parsed tokens, returning both the token and-- the position it appears at. This function will raise a 'ParseError'-- on bad input.---- Since 0.5.0conduitParser::(AttoparsecInputa,MonadThrowm)=>A.Parserab->Conduitam(PositionRange,b)conduitParserparser=conduit$Position10whereconduit!pos=await>>=maybe(return())gowheregox=doleftoverx(!pos',!res)<-sinkParserPosErrposparseryield(PositionRangepospos',res)conduitpos'-- | Same as 'conduitParser', but we return an 'Either' type instead-- of raising an exception.conduitParserEither::(Monadm,AttoparsecInputa)=>A.Parserab->Conduitam(EitherParseError(PositionRange,b))conduitParserEitherparser=conduit$Position10whereconduit!pos=await>>=maybe(return())gowheregox=doleftoverxres<-sinkParserPosposparsercaseresofLefte->yield$LefteRight(!pos',!res)->doyield$!Right(PositionRangepospos',res)conduitpos'sinkParserPosErr::(AttoparsecInputa,MonadThrowm)=>Position->A.Parserab->Consumeram(Position,b)sinkParserPosErrpos0p=sinkParserPospos0p>>=fwheref(Lefte)=monadThrowef(Righta)=returnasinkParserPos::(AttoparsecInputa,Monadm)=>Position->A.Parserab->Consumeram(EitherParseError(Position,b))sinkParserPospos0p=sinkemptypos0(parseAp)wheresinkprevposparser=await>>=maybeclosepushwherepushc|isNullc=sinkprevposparser|otherwise=goFalsec$parsercclose=goTrueprev(feedA(parserempty)empty)goendc(A.Donelox)=doletpos'|end=pos|otherwise=addLinesColsprevposy=take'(length'c-length'lo)cpos''=addLinesColsypos'unless(isNulllo)$leftoverlopos''`seq`return$!Right(pos'',x)goendc(A.Failrestcontextsmsg)=letx=take'(length'c-length'rest)cpos'|end=pos|otherwise=addLinesColsprevpospos''=addLinesColsxpos'inpos''`seq`return$!Left(ParseErrorcontextsmsgpos'')goendc(A.Partialparser')|end=return$!LeftDivergentParser|otherwise=pos'`seq`sinkcpos'parser'wherepos'=addLinesColsprevposaddLinesCols::AttoparsecInputa=>a->Position->PositionaddLinesColsx(Positionlinescols)=lines'`seq`cols'`seq`Positionlines'cols'where(dlines,dcols)=getLinesColsxlines'=lines+dlinescols'=(ifdlines>0then1elsecols)+dcols