{- Copyright 2010 Dominique Devriese
This file is part of the grammar-combinators library.
The grammar-combinators library is free software: you can
redistribute it and/or modify it under the terms of the GNU
Lesser General Public License as published by the Free
Software Foundation, either version 3 of the License, or (at
your option) any later version.
Foobar is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General
Public License along with Foobar. If not, see
<http://www.gnu.org/licenses/>.
-}{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE KindSignatures #-}{-# LANGUAGE MultiParamTypeClasses #-}{-# LANGUAGE RankNTypes #-}{-# LANGUAGE ScopedTypeVariables #-}moduleText.GrammarCombinators.Utils.ToGraph(ruleToGraph,graphToGraphviz,fullGrammarToGraph,reachableGrammarToGraph,showGraph)whereimportText.GrammarCombinators.BaseimportText.GrammarCombinators.Utils.IsReachableimportData.Graph.Inductive.GraphimportControl.Monad.StateimportControl.Monad.WriterimportData.Graph.Inductive.PatriciaTreeimportData.GraphViznewNode::(MonadState(Int,Int)m)=>mIntnewNode=do(d,n)<-getput(d,n+1)returnntell1::(MonadWriter[w]m)=>w->m()tell1w=tell[w]newtypeGraphConstructor(phi::*->*)(r::*->*)tv=MkGC{constructContexts::AdjString->Bool->WriterT[ContextStringString](State(Int,Int))(AdjString)}leafNode::String->Bool->GraphConstructorphirtvleafNodelabeleps=MkGC$\parentEdgeprinteps->ifnoteps||printepsthendoln<-newNodetell1(parentEdge,ln,label,[])return[("",ln)]elsereturnparentEdgeconstructContextsSub::GraphConstructorphirtv->AdjString->Bool->WriterT[ContextStringString](State(Int,Int))(AdjString)constructContextsSubrpeprinteps=do(d,n)<-getifd>0thenput(d-1,n)>>constructContextsrpeprintepselsedon'<-newNodetell1(pe,n',"(...)",[])return[]instanceProductionRule(GraphConstructorphirt)wherera>>>rb=MkGC$\parentEdgeprinteps->do(d,_)<-getpe<-constructContextsSubraparentEdgeFalseifnullpethenreturn[]elsedomodify$\(_,n)->(d,n)-- do not ignore right branches if left ones are infinite...constructContextsSubrbpeprintepsra|||rb=MkGC$\parentEdge_->do(d,_)<-getpea<-constructContextsSubraparentEdgeTruemodify$\(_,n)->(d,n)peb<-constructContextsSubrbparentEdgeTruereturn$pea++pebendOfInput=leafNode"endOfInput"Falsedie=leafNode"die"FalseinstanceEpsProductionRule(GraphConstructorphirt)whereepsilon_=leafNode"epsilon"TrueinstanceLiftableProductionRule(GraphConstructorphirt)whereepsilonL__=leafNode"epsilon"Trueinstance(Tokent)=>TokenProductionRule(GraphConstructorphirt)twheretokentt=leafNode(showtt)FalseanyToken=leafNode"anyToken"Falseinstance(Domainphi)=>RecProductionRule(GraphConstructorphirt)phirwhererefidx=leafNode("<"++showIdxidx++">")Falseinstance(Domainphi)=>LoopProductionRule(GraphConstructorphirt)phirwheremanyRefidx=leafNode("<"++showIdxidx++">*")FalseruleToGraph::forallphitrrrgrix.(Tokent,Domainphi,DynGraphgr)=>Int->GExtendedContextFreeGrammarphitrrr->phiix->grStringStringruleToGraphdepthgramidx=buildGr$snd$ruleToContextsdepthgramidx0ruleToContexts::forallphitrrrix.(Tokent,Domainphi)=>Int->GExtendedContextFreeGrammarphitrrr->phiix->Int->(Int,[ContextStringString])ruleToContextsdepthgramidxsn=letprocessNTDef::phiix->WriterT[ContextStringString](State(Int,Int))(AdjString)processNTDefidx'=dontNode<-newNodetell1([],ntNode,showIdxidx',[])letstAdj=[("",ntNode)]constructContexts(gramidx')stAdjTrue(contexts,(_,nsn))=fliprunState(depth,sn)$execWriterT$processNTDefidxin(nsn,reversecontexts)graphvizParams::GraphvizParamsStringString()StringgraphvizParams=Params{isDirected=True,globalAttributes=[],clusterBy=N,clusterID=constNothing,fmtCluster=const[],fmtNode=\(_,n)->[Label$StrLabeln],fmtEdge=\(_,_,_)->[]}graphToGraphviz::GrStringString->DotGraphNodegraphToGraphvizgr=setID(Str"Grammar")$graphToDotgraphvizParams(gr::GrStringString)grammarToContexts::forallphitrrr.(Tokent,Domainphi)=>(forallb.(forallix.phiix->b->b)->b->b)->Int->GExtendedContextFreeGrammarphitrrr->[ContextStringString]grammarToContextsfold'depthgram=letprocessRuleidx(nsn,cs)=(nsn',cs++cs')where(nsn',cs')=ruleToContextsdepthgramidxnsninsnd$fold'processRule(0,[])grammarToGraph::forallphitrrrgr.(Tokent,Domainphi,DynGraphgr)=>(forallb.(forallix.phiix->b->b)->b->b)->Int->GExtendedContextFreeGrammarphitrrr->grStringStringgrammarToGraphfold'depthgram=buildGr$grammarToContextsfold'depthgramfullGrammarToGraph::forallphitrrrgr.(Tokent,Domainphi,DynGraphgr)=>Int->GExtendedContextFreeGrammarphitrrr->grStringStringfullGrammarToGraph=grammarToGraphfoldFamreachableGrammarToGraph::forallphitrrrgrix.(Tokent,Domainphi,DynGraphgr)=>Int->GExtendedContextFreeGrammarphitrrr->phiix->grStringStringreachableGrammarToGraphdepthgramidx=grammarToGraph(foldReachablegramidx)depthgramshowGraph::(DotReprdgn)=>dgn->IO()showGraphgr=runGraphvizCanvas'grXlib>>return()