moduleText.Highlighter.LexerwhereimportControl.Monad.ErrorimportControl.Monad.StateimportPreludehiding(lex)importText.Regex.PCRE.Lighthiding(compile)importText.Regex.PCRE.Light.Char8(compile)importqualifiedData.ByteStringasBSimportText.Highlighter.TypesdataLexerState=LexerState{lsLexer::Lexer,lsInput::BS.ByteString,lsState::[TokenMatcher],lsLexed::[Token]}derivingShowtypeLexerM=ErrorTLexerError(StateLexerState)dataLexerError=NoMatchForBS.ByteString|OtherLexerErrorStringderivingShowinstanceErrorLexerErrorwherenoMsg=OtherLexerError"unknown"strMsg=OtherLexerErrorrunLexer::Lexer->BS.ByteString->EitherLexerError[Token]runLexerls=evalState(runErrorTlex)(LexerStatels[lStartl][])lex::LexerM[Token]lex=dodone<-gets(BS.null.lsInput)ifdonethengetslsLexedelsedoms<-getStatets<-tryAllmsmodify$\ls->ls{lsLexed=lsLexedls++ts}lexwheregetState=gets(head.lsState)tryAll::[Match]->LexerM[Token]tryAll[]=doi<-getslsInputthrowError(NoMatchFori)tryAll(AnyOfms:ms')=tryAll(ms++ms')tryAll(m:ms)=doatbol<-isBOLfs<-gets(lFlags.lsLexer)letopts|atbol=[exec_anchored]|otherwise=[exec_anchored,exec_notbol]i<-getslsInputcasematch(compile(mRegexpm)fs)ioptsofJust[]->donextState(mNextStatem)[]return[]Just(s:ss)->domodify$\ls->ls{lsInput=BS.drop(BS.lengths)i}nextState(mNextStatem)(s:ss)toTokens(s:ss)(mTypem)Nothing->tryAllms`catchError`trySkippingwheretrySkippinge=docaseeofNoMatchFor_->tryAllFirst(m:ms)_->throwErroretryAllFirst::[Match]->LexerM[Token]tryAllFirst[]=doi<-getslsInputthrowError(NoMatchFori)tryAllFirst(AnyOfms:ms')=tryAllFirst(ms++ms')tryAllFirst(m:ms)=doatbol<-isBOLfs<-gets(lFlags.lsLexer)letopts|atbol=[]|otherwise=[exec_notbol]i<-getslsInputcasematch(compile(mRegexpm)fs)ioptsofJust(s:ss)->dolet(skipped,next)=skipFailedismodify$\ls->ls{lsInput=next}ts<-toTokens(s:ss)(mTypem)return(TokenErrorskipped:ts)_->tryAllFirstmsisBOL::LexerMBoolisBOL=dold<-getslsLexedcaseldof[]->returnTruets->letnonempty=dropWhile(BS.null.tText)(reversets)incasenonemptyof[]->returnTrue(t:_)->return(BS.last(tTextt)==10)toTokens::[BS.ByteString]->TokenType->LexerM[Token]toTokens(s:_)(Usingl)=doeitherthrowErrorreturn(runLexerls)toTokens(_:ss)(ByGroupsts)=liftMconcat$zipWithM(\st->toTokens[s]t)sststoTokens(s:_)t=return[Tokents]toTokens[]_=return[]-- Given the starting point, return the text preceding and after-- the failing regexp matchskipFailed::BS.ByteString->BS.ByteString->(BS.ByteString,BS.ByteString)skipFailedir|r`BS.isPrefixOf`i=(BS.empty,BS.drop(BS.lengthr)i)|otherwise=let(pre,next)=skipFailed(BS.taili)rin(BS.cons(BS.headi)pre,next)nextState::NextState->[BS.ByteString]->LexerM()nextStateContinue_=return()nextStatePop_=modify$\ls->ls{lsState=tail(lsStatels)}nextState(PopNumn)_=modify$\ls->ls{lsState=dropn(lsStatels)}nextStatePush_=modify$\ls->ls{lsState=head(lsStatels):lsStatels}nextState(GoTon)_=modify$\ls->ls{lsState=n:lsStatels}nextState(CapturesTof)cs=modify$\ls->ls{lsState=f(mapfromBScs):lsStatels}wherefromBS=map(toEnum.fromEnum).BS.unpacknextState(DoAllnss)cs=mapM_(flipnextStatecs)nssnextState(Combinednss)_=modify$\ls->ls{lsState=concatnss:lsStatels}