{-# LANGUAGE ExistentialQuantification #-}-- | This module contains the additional data types, instance definitions and functions to run parsers in an interleaved way.-- If all the interlevaed parsers recognise a single connected piece of the input text this incorporates the permutation parsers.-- For some examples see the module "Text.ParserCombinators.UU.Demo.MergeAndpermute"moduleText.ParserCombinators.UU.MergeAndPermutewhereimportText.ParserCombinators.UU.CoreimportControl.Applicativeinfixl4<||>,<<||>-- * The data type `Gram`-- | Since we want to get access to the individial parsers which recognise a consecutive piece of the input text we-- define a new data type, which lifts the underlying parsers to the grammatical level, so they can be transformed, manipulated, and run in a piecewise way.-- `Gram` is defined in such a way that we can always access the first parsers to be ran from such a structure.-- We require that all the `Alt`s do not recognise the empty string. These should be covered by the `Maybe` in the `Gram` constructor.dataGramfa=Gram[Altfa](Maybea)dataAltfa=forallb.Seq(fb)(Gramf(b->a))|forallb.Bind(fb)(b->Gramfa)instance(Showa)=>Show(Gramfa)whereshow(Gramlma)="Gram "++show(lengthl)++" "++showma-- | The function `mkGram` splits a simple parser into the possibly empty part and the non-empty part.-- The non-empty part recognises a consecutive part of the input.-- Here we use the function `getOneP` and `getZeroP` which are provided in the uu-parsinglib package,-- but they could easily be provided by other packages too.mkGram::Pta->Gram(Pt)amkGramp=casegetOnePpofJustp->Gram[p`Seq`Gram[](Justid)](getZeroPp)Nothing->Gram[](getZeroPp)-- * Class instances for Gram-- | We define instances for the data type `Gram` for `Functor`, `Applicative`, `Alternative` and `ExtAlternative`instanceFunctorf=>Functor(Gramf)wherefmapf(Gramaltse)=Gram(map(f<$>)alts)(f<$>e)instanceFunctorf=>Functor(Altf)wherefmapa2c(fb`Seq`fb2a)=fb`Seq`((a2c.)<$>fb2a)fmapa2c(fb`Bind`b2fa)=fb`Bind`(\b->fmapa2c(b2fab))-- | The left hand side operand is gradually transformed so we get access to its first componentinstanceFunctorf=>Applicative(Gramf)wherepurea=Gram[](Justa)Gramlle<*>~rg@(Gramrre)=Gram((map(`fwdby`rg)l)++maybe[](\e->map(e<$>)r)le)(le<*>re)where(fb`Seq`fb2c2a)`fwdby`fc=fb`Seq`(flip<$>fb2c2a<*>fc)(fb`Bind`b2fc2a)`fwdby`fc=fb`Bind`((<*>fc).b2fc2a)instanceFunctorf=>Alternative(Gramf)whereempty=Gram[]NothingGrampspe<|>Gramqsqe=Gram(ps++qs)(pe<|>qe)instanceFunctorf=>ExtAlternative(Gramf)wherep<<|>q=p<|>qp<?>s=error"No <?> defined for Grammars yet. If you need ask for it"must_be_non_emptymsg(Gram_(Just_))_=error("The combinator "++msg++" requires that it's argument cannot recognise the empty string\n")must_be_non_empty__q=qmust_be_non_emptiesmsg(Gram_(Just_))(Gram_(Just_))_=error("The combinator "++msg++" requires that not both arguments can recognise the empty string\n")must_be_non_emptiesmsg__q=q-- * `Gram` is a `Monad`instanceMonad(Gramf)wherereturna=Gram[](Justa)Grampspe>>=a2qs=letbindto::Altfb->(b->Gramfa)->Altfa(b`Seq`b2a)`bindto`a2c=b`Bind`(\b->b2a>>=((\b2a->a2c(b2ab))))(b`Bind`b2a)`bindto`a2c=b`Bind`(\b->b2ab>>=a2c)psa2qs=(map(`bindto`a2qs)ps)incasepeofNothing->Grampsa2qsNothingJusta->letGramqsqe=a2qsainGram(psa2qs++qs)qeinstanceFunctorf=>IsParser(Gramf)-- | The function `<||>` is the merging equivalent of `<*>`. Instead of running its two arguments consecutively, -- the input is split into parts which serve as input for the left operand and parts which are served to the right operand. (<||>)::Functorf=>Gramf(b->a)->Gramfb->Gramfapg@(Gramplpe)<||>qg@(Gramqlqe)=Gram([p`Seq`(flip<$>pp<||>qg)|p`Seq`pp<-pl]++[q`Seq`((.)<$>pg<||>qq)|q`Seq`qq<-ql]++[fc`Bind`(\c->c2fb2ac<||>qg)|fc`Bind`c2fb2a<-pl]++[fc`Bind`(\c->pg<||>c2fbc)|fc`Bind`c2fb<-ql])(pe<*>qe)-- | The function `<<||>` is a special version of `<||>`, whch only starts a new instance of its right operand when the left operand cannot proceed.-- This is used in the function pmMany, where we want to merge as many instances of its argument, but not more than that.pg@(Gramplpe)<<||>~qg@(Gramqlqe)=Gram([p`Seq`(flip<$>pp<||>qg)|p`Seq`pp<-pl])(pe<*>qe)-- | `mkPaserM` converts a `Gram`mar beack into a parser, which can subsequenly be run.mkParserM::(Monadf,Applicativef,ExtAlternativef)=>Gramfa->famkParserM(Gramlsle)=foldr(\ppp->doNotInterpretp<|>pp)(maybeemptypurele)(mapmkParserAltls)wheremkParserAlt(p`Seq`pp)=p<**>mkParserMppmkParserAlt(fc`Bind`c2fa)=fc>>=(mkParserM.c2fa)-- | `mkParserS` is like `mkParserM`, with the additional feature that we allow seprators between the components. Only useful in the permuting case.mkParserS::(Monadf,Applicativef,ExtAlternativef)=>fb->Gramfa->famkParserSsep(Gramlsle)=foldr(\ppp->doNotInterpretp<|>pp)(maybeemptypurele)(mapmkParserAltls)wheremkParserAlt(p`Seq`pp)=p<**>mkParserPsepppmkParserAlt(fc`Bind`c2fa)=fc>>=(mkParserSsep.c2fa)mkParserP::(Monadf,Applicativef,ExtAlternativef)=>fb->Gramfa->famkParserPsep(Gramlsle)=foldr(\ppp->doNotInterpretp<|>pp)(maybeemptypurele)(mapmkParserAltls)wheremkParserAlt(p`Seq`pp)=sep*>p<**>mkParserPsepppmkParserAlt(fc`Bind`c2fa)=fc>>=(mkParserPsep.c2fa)-- | Run a sufficient number of @p@'s in a merged fashion, but not more than necessary!!pmMany::Functorf=>Gramfa->Gramf[a]pmManyp=letpm=(:)<$>p<<||>pm<|>pure[]inpm