-- | Parser utilities.moduleDDC.Base.Parser(moduleText.Parsec,Parser,ParserState(..),runTokenParser,pTokMaybe,pTokAs,pTok)whereimportDDC.Base.LexerimportDDC.Base.PrettyimportData.Functor.IdentityimportText.ParsecimportText.ParsecasPimportText.Parsec.ErrorasP-- | A generic parser,-- parameterised over token and return types.typeParserka=Eqk=>P.ParsecT[Tokenk](ParserStatek)Identitya-- | A parser state that keeps track of the name of the source file.dataParserStatek=ParseState{stateTokenShow::k->String,stateFileName::String}-- | Run a generic parser.runTokenParser::Eqk=>(k->String)-- ^ Show a token.->String-- ^ File name for error messages.->Parserka-- ^ Parser to run.->[Tokenk]-- ^ Tokens to parse.->EitherP.ParseErrorarunTokenParsertokenShowfileNameparser=P.runParserparserParseState{stateTokenShow=tokenShow,stateFileName=fileName}fileName--------------------------------------------------------------------------------- | Accept the given token.pTok::Eqk=>k->Parserk()pTokk=pTokMaybe$\k'->ifk==k'thenJust()elseNothing-- | Accept a token and return the given value.pTokAs::Eqk=>k->t->ParserktpTokAskt=pTokk>>returnt-- | Accept a token if the function returns `Just`. pTokMaybe::(k->Maybea)->ParserkapTokMaybef=dostate<-P.getStateP.token(stateTokenShowstate.tokenTok)(takeParsecSourcePos)(f.tokenTok)-------------------------------------------------------------------------------instancePrettyP.ParseErrorwherepprerr=vcat$[text"Parse error in"<+>text(show(P.errorPoserr))]++(mapppr$packMessages$P.errorMessageserr)instancePrettyP.Messagewherepprmsg=casemsgofSysUnExpectstr->text"Unexpected"<+>textstr<>text"."UnExpectstr->text"Unexpected"<+>textstr<>text"."Expectstr->text"Expected"<+>textstr<>text"."Messagestr->textstr-- | When we get a parse error, parsec adds multiple 'Unexpected' messages,-- but we only want to display the first one.packMessages::[P.Message]->[P.Message]packMessagesmm=casemmof[]->[]m1@(P.UnExpect_):(P.UnExpect_):rest->packMessages(m1:rest)m1@(P.SysUnExpect_):(P.SysUnExpect_):rest->packMessages(m1:rest)m1@(P.SysUnExpect_):(P.UnExpect_):rest->packMessages(m1:rest)m1@(P.UnExpect_):(P.SysUnExpect_):rest->packMessages(m1:rest)m1:rest->m1:packMessagesrest