-- | Generic traversals of 'AST' termsmoduleLanguage.Syntactic.Traversal(gmapQ,gmapT,everywhereUp,everywhereDown,Args(..),listArgs,mapArgs,mapArgsA,mapArgsM,appArgs,listFold,match,query,simpleMatch,fold,simpleFold,matchTrans,WrapFull(..))whereimportControl.ApplicativeimportLanguage.Syntactic.Syntax-- | Map a function over all immediate sub-terms (corresponds to the function-- with the same name in Scrap Your Boilerplate)gmapT::foralldom.(foralla.ASTFdoma->ASTFdoma)->(foralla.ASTFdoma->ASTFdoma)gmapTfa=goawherego::foralla.ASTdoma->ASTdomago(s:$a)=gos:$fagos=s-- | Map a function over all immediate sub-terms, collecting the results in a-- list (corresponds to the function with the same name in Scrap Your-- Boilerplate)gmapQ::foralldomb.(foralla.ASTFdoma->b)->(foralla.ASTFdoma->[b])gmapQfa=goawherego::foralla.ASTdoma->[b]go(s:$a)=fa:gosgo_=[]-- | Apply a transformation bottom-up over an expression (corresponds to-- @everywhere@ in Scrap Your Boilerplate)everywhereUp::(foralla.ASTFdoma->ASTFdoma)->(foralla.ASTFdoma->ASTFdoma)everywhereUpf=f.gmapT(everywhereUpf)-- | Apply a transformation top-down over an expression (corresponds to-- @everywhere'@ in Scrap Your Boilerplate)everywhereDown::(foralla.ASTFdoma->ASTFdoma)->(foralla.ASTFdoma->ASTFdoma)everywhereDownf=gmapT(everywhereDownf).f-- | List of symbol argumentsdataArgscsigwhereNil::Argsc(Fulla)(:*)::c(Fulla)->Argscsig->Argsc(a:->sig)infixr:*-- | Map a function over an 'Args' list and collect the results in an ordinary-- listlistArgs::(foralla.c(Fulla)->b)->Argscsig->[b]listArgsfNil=[]listArgsf(a:*as)=fa:listArgsfas-- | Map a function over an 'Args' listmapArgs::(foralla.c1(Fulla)->c2(Fulla))->(forallsig.Argsc1sig->Argsc2sig)mapArgsfNil=NilmapArgsf(a:*as)=fa:*mapArgsfas-- | Map an applicative function over an 'Args' listmapArgsA::Applicativef=>(foralla.c1(Fulla)->f(c2(Fulla)))->(forallsig.Argsc1sig->f(Argsc2sig))mapArgsAfNil=pureNilmapArgsAf(a:*as)=(:*)<$>fa<*>mapArgsAfas-- | Map a monadic function over an 'Args' listmapArgsM::Monadm=>(foralla.c1(Fulla)->m(c2(Fulla)))->(forallsig.Argsc1sig->m(Argsc2sig))mapArgsMf=unwrapMonad.mapArgsA(WrapMonad.f)-- | Apply a (partially applied) symbol to a list of argument termsappArgs::ASTdomsig->Args(ASTdom)sig->ASTFdom(DenResultsig)appArgsaNil=aappArgss(a:*as)=appArgs(s:$a)as-- | \"Pattern match\" on an 'AST' using a function that gets direct access to-- the top-most symbol and its sub-treesmatch::foralldomac.(forallsig.(a~DenResultsig)=>domsig->Args(ASTdom)sig->c(Fulla))->ASTFdoma->c(Fulla)matchfa=goaNilwherego::(a~DenResultsig)=>ASTdomsig->Args(ASTdom)sig->c(Fulla)go(Syma)as=faasgo(s:$a)as=gos(a:*as)query::foralldomac.(forallsig.(a~DenResultsig)=>domsig->Args(ASTdom)sig->c(Fulla))->ASTFdoma->c(Fulla)query=match{-# DEPRECATED query "Please use `match` instead." #-}-- | A version of 'match' with a simpler result typesimpleMatch::foralldomab.(forallsig.(a~DenResultsig)=>domsig->Args(ASTdom)sig->b)->ASTFdoma->bsimpleMatchf=getConst.match(\s->Const.fs)-- | Fold an 'AST' using an 'Args' list to hold the results of sub-termsfold::foralldomc.(forallsig.domsig->Argscsig->c(Full(DenResultsig)))->(foralla.ASTFdoma->c(Fulla))foldf=match(\s->fs.mapArgs(foldf))-- | Simplified version of 'fold' for situations where all intermediate results-- have the same typesimpleFold::foralldomb.(forallsig.domsig->Args(Constb)sig->b)->(foralla.ASTFdoma->b)simpleFoldf=getConst.fold(\s->Const.fs)-- | Fold an 'AST' using a list to hold the results of sub-termslistFold::foralldomb.(forallsig.domsig->[b]->b)->(foralla.ASTFdoma->b)listFoldf=simpleFold(\s->fs.listArgsgetConst)newtypeWrapASTcdomsig=WrapAST{unWrapAST::c(ASTdomsig)}-- Only used in the definition of 'matchTrans'-- | A version of 'match' where the result is a transformed syntax tree,-- wrapped in a type constructor @c@matchTrans::foralldomdom'ca.(forallsig.(a~DenResultsig)=>domsig->Args(ASTdom)sig->c(ASTFdom'a))->ASTFdoma->c(ASTFdom'a)matchTransf=unWrapAST.match(\s->WrapAST.fs)-- | Can be used to make an arbitrary type constructor indexed by @(`Full` a)@.-- This is useful as the type constructor parameter of 'Args'. That is, use---- > Args (WrapFull c) ...---- instead of---- > Args c ...---- if @c@ is not indexed by @(`Full` a)@.dataWrapFullcawhereWrapFull::{unwrapFull::ca}->WrapFullc(Fulla)