{-# LANGUAGE
BangPatterns
, ScopedTypeVariables
, UnboxedTuples
, UnicodeSyntax
#-}-- |Yet another parser combinator. This is mostly a subset of-- "Text.ParserCombinators.Parsec" but there are some differences:---- * This parser works on 'Data.ByteString.Base.LazyByteString'-- instead of 'Prelude.String'.---- * Backtracking is the only possible behavior so there is no \"try\"-- action.---- * On success, the remaining string is returned as well as the-- parser result.---- * You can choose whether to treat reaching EOF (trying to eat one-- more letter at the end of string) a fatal error or to treat it a-- normal failure. If a fatal error occurs, the entire parsing-- process immediately fails without trying any backtracks. The-- default behavior is to treat EOF fatal.---- In general, you don't have to use this module directly.moduleNetwork.HTTP.Lucu.Parser(Parser,ParserResult(..),failP,parse,parseStr,anyChar,eof,allowEOF,satisfy,char,string,(<|>),choice,oneOf,digit,hexDigit,notFollowedBy,many,manyChar,many1,count,option,sepBy,sepBy1,sp,ht,crlf)whereimportControl.Monad.State.Stricthiding(state)importqualifiedData.ByteString.LazyasLazy(ByteString)importqualifiedData.ByteString.Lazy.Char8asBhiding(ByteString)importqualifiedData.FoldableasFoldimportData.IntimportqualifiedData.SequenceasSeqimportData.Sequence(Seq,(|>))-- |@'Parser' a@ is obviously a parser which parses and returns @a@.newtypeParsera=Parser{runParser::StateParserState(ParserResulta)}dataParserState=PST{pstInput::Lazy.ByteString,pstIsEOFFatal::!Bool}deriving(Eq,Show)dataParserResulta=Success!a|IllegalInput-- 受理出來ない入力があった|ReachedEOF-- 限界を越えて讀まうとしたderiving(Eq,Show)-- (>>=) :: Parser a -> (a -> Parser b) -> Parser binstanceMonadParserwherep>>=f=Parser$!dosaved<-get-- 失敗した時の爲に状態を保存result<-runParserpcaseresultofSuccessa->runParser(fa)IllegalInput->doputsaved-- 状態を復歸returnIllegalInputReachedEOF->doputsaved-- 状態を復歸returnReachedEOFreturn!x=Parser$!return$!Successxfail_=Parser$!return$!IllegalInputinstanceFunctorParserwherefmapfp=p>>=return.f-- |@'failP'@ is just a synonym for @'Prelude.fail'-- 'Prelude.undefined'@.failP::ParserafailP=failundefined-- |@'parse' p bstr@ parses @bstr@ with @p@ and returns @(# result,-- remaining #)@.parse::Parsera->Lazy.ByteString->(#ParserResulta,Lazy.ByteString#)parse!pinput-- input は lazy である必要有り。=let(!result,state')=runState(runParserp)(PSTinputTrue)in(#result,pstInputstate'#)-- pstInput state' も lazy である必要有り。-- |@'parseStr' p str@ packs @str@ and parses it.parseStr::Parsera->String->(#ParserResulta,Lazy.ByteString#)parseStr!pinput-- input は lazy である必要有り。=parsep(B.packinput)anyChar::ParserCharanyChar=Parser$!dostate@(PSTinput_)<-getifB.nullinputthenreturnReachedEOFelsedoput$!state{pstInput=B.tailinput}return(Success$!B.headinput)eof::Parser()eof=Parser$!doPSTinput_<-getifB.nullinputthenreturn$!Success()elsereturnIllegalInput-- |@'allowEOF' p@ makes @p@ treat reaching EOF a normal failure.allowEOF::Parsera->ParseraallowEOF!f=Parser$!dosaved@(PST_isEOFFatal)<-getput$!saved{pstIsEOFFatal=False}result<-runParserfstate<-getput$!state{pstIsEOFFatal=isEOFFatal}returnresultsatisfy::(Char->Bool)->ParserCharsatisfy!f=doc<-anyChariffcthenreturncelsefailPchar::Char->ParserCharchar!c=satisfy(==c)string::String->ParserStringstring!str=letbs=B.packstrlen=B.lengthbsinParser$!dost<-getlet(bs',rest)=B.splitAtlen$pstInputstst'=st{pstInput=rest}ifB.lengthbs'<lenthenreturnReachedEOFelseifbs==bs'thendoputst'return$SuccessstrelsereturnIllegalInputinfixr0<|>-- |This is the backtracking alternation. There is no non-backtracking-- equivalent.(<|>)::Parsera->Parsera->Parsera(!f)<|>(!g)=Parser$!dosaved<-get-- 状態を保存result<-runParserfcaseresultofSuccessa->return$!SuccessaIllegalInput->doputsaved-- 状態を復歸runParsergReachedEOF->ifpstIsEOFFatalsavedthendoputsavedreturnReachedEOFelsedoputsavedrunParsergchoice::[Parsera]->Parserachoice=foldl(<|>)failPoneOf::[Char]->ParserCharoneOf=foldl(<|>)failP.mapcharnotFollowedBy::Parsera->Parser()notFollowedBy!p=Parser$!dosaved<-get-- 状態を保存result<-runParserpcaseresultofSuccess_->doputsaved-- 状態を復歸returnIllegalInputIllegalInput->doputsaved-- 状態を復歸return$!Success()ReachedEOF->doputsaved-- 状態を復歸return$!Success()digit::ParserChardigit=doc<-anyCharifc>='0'&&c<='9'thenreturncelsefailPhexDigit::ParserCharhexDigit=doc<-anyCharif(c>='0'&&c<='9')||(c>='a'&&c<='f')||(c>='A'&&c<='F')thenreturncelsefailPmany::foralla.Parsera->Parser[a]many!p=Parser$!dostate<-getlet(#result,state'#)=many'stateSeq.emptyputstate'returnresultwheremany'::ParserState->Seqa->(#ParserResult[a],ParserState#)many'!st!soFar=caserunState(runParserp)stof(Successa,st')->many'st'(soFar|>a)(IllegalInput,_)->(#Success(Fold.toListsoFar),st#)(ReachedEOF,_)->ifpstIsEOFFatalstthen(#ReachedEOF,st#)else(#Success(Fold.toListsoFar),st#)manyChar::ParserChar->ParserLazy.ByteStringmanyChar!p=Parser$!dostate<-getcasescan'state0ofSuccesslen->dolet(bs,rest)=B.splitAtlen(pstInputstate)state'=state{pstInput=rest}putstate'return$SuccessbsReachedEOF->ifpstIsEOFFatalstatethenreturnReachedEOFelseerror"internal error"_->error"internal error"wherescan'::ParserState->Int64->ParserResultInt64scan'!st!soFar=caserunState(runParserp)stof(Success_,st')->scan'st'(soFar+1)(IllegalInput,_)->SuccesssoFar(ReachedEOF,_)->ifpstIsEOFFatalstthenReachedEOFelseSuccesssoFarmany1::Parsera->Parser[a]many1!p=dox<-pxs<-manypreturn(x:xs)count::Int->Parsera->Parser[a]count!n!p=Parser$!count'npSeq.empty-- This implementation is rather ugly but we need to make it-- tail-recursive to avoid stack overflow.count'::Int->Parsera->Seqa->StateParserState(ParserResult[a])count'0_!soFar=return$!Success$!Fold.toListsoFarcount'!n!p!soFar=dosaved<-getresult<-runParserpcaseresultofSuccessa->count'(n-1)p(soFar|>a)IllegalInput->doputsavedreturnIllegalInputReachedEOF->doputsavedreturnReachedEOF-- def may be a _|_option::a->Parsera->Parseraoptiondef!p=p<|>returndefsepBy::Parsera->Parsersep->Parser[a]sepBy!p!sep=sepBy1psep<|>return[]sepBy1::Parsera->Parsersep->Parser[a]sepBy1!p!sep=dox<-pxs<-many$!sep>>preturn(x:xs)sp::ParserCharsp=char' 'ht::ParserCharht=char'\t'crlf::ParserStringcrlf=string"\x0d\x0a"