{-# LANGUAGE OverloadedStrings #-}{- |
Module : GHC.Vis.Graph
Copyright : (c) Dennis Felsing
License : 3-Clause BSD-style
Maintainer : dennis@felsin9.de
-}moduleGHC.Vis.Graph(xDotParse)whereimportSystem.IO.UnsafeimportData.Text.IOimportqualifiedData.Text.LazyasBimportData.Graph.Inductivehiding(nodes,edges)importData.GraphVizhiding(Ellipse,Polygon,parse)importqualifiedData.GraphViz.Types.GeneralisedasGimportData.GraphViz.Attributes.CompleteimportGHC.HeapViewhiding(name)importGHC.Vis.InternalimportGHC.Vis.TypesimportGraphics.XDot.Typeshiding(name,h)importGraphics.XDot.ParserfontName::B.Text--fontName = "Times Roman"fontName="DejaVu Sans"graphFontSize::DoublegraphFontSize=24nodeFontSize::DoublenodeFontSize=24edgeFontSize::DoubleedgeFontSize=24-- | Take the objects to be visualized and run them through @dot@ and extract-- the drawing operations that have to be exectued to show the graph of the-- heap map.xDotParse::[(Box,String)]->IO([(MaybeNode,Operation)],[Box],Rectangle)xDotParseas=do(dotGraph,boxes)<-dgasreturn(getOperationsdotGraph,boxes,getSizedotGraph)dg::[(Box,String)]->IO(G.DotGraphNode,[Box])dgas=dohm<-walkHeapas--hm <- walkHeapDepth asxDotText<-graphvizWithHandleDot(defaultVis$toViewableGraph$buildGraphhm)XDothGetContentsreturn(parseDotGraph$B.fromChunks[xDotText],getBoxeshm)-- | Convert a heap map, our internal data structure, to a graph that can be-- converted to a dot graph.buildGraph::HeapMap->GrClosureStringbuildGraphhm=insEdgesedges$insNodesnodesemptywherenodes=zip[0..]$map(\(_,(_,c))->c)rhmedges=foldrtoLEdge[]$foldrmbEdges[]nodes-- Reversing it fixes the ordering of nodes in the graph. Should run-- through allPtrs and sort by order inside of all allPtrs lists.---- When building the graph directly out of [Box] instead of going-- through the HeapMap, then the order of nodes might not be right for-- non-trivial graphs.---- In some cases it's impossible to get the order right. Maybe there is-- a way in graphviz to specify outgoing edge orientation after all?rhm=reversehmtoLEdge(0,Justt)xs=caserhm!!tof(_,(Justname,_))->(0,t,name):xs(_,(Nothing,_))->(0,t,""):xstoLEdge(f,Justt)xs=(f,t,""):xstoLEdge_xs=xsmbEdges(p,BCOClosure___bPtr___)xs=map(\b->(p,Justb))(bcoChildren[bPtr]hm)++xs-- Using allPtrs and then filtering the closures not available in the-- heap map out emulates pointersToFollow without being in IOmbEdges(p,c)xs=map(\b->(p,boxPosb))(allPtrsc)++xsboxPos::Box->MaybeIntboxPosb=lookupb$zip(mapfstrhm)[0..]bcoChildren::[Box]->HeapMap->[Int]bcoChildren[]_=[]bcoChildren(b:bs)h=caseboxPosbofNothing->letptf=unsafePerformIO$getBoxedClosureDatab>>=pointersToFollow2inbcoChildren(ptf++bs)h-- Could go into infinite loopJustpos->pos:bcoChildrenbshgetBoxes::HeapMap->[Box]getBoxeshm=map(\(b,(_,_))->b)$reversehm-- Probably have to do some kind of fold over the graph to remove for example-- unwanted pointerstoViewableGraph::GrClosureString->GrStringStringtoViewableGraphcg=emapid$nmapshowClosurecgdefaultVis::(Graphgr)=>grStringString->DotGraphNodedefaultVis=graphToDotnonClusteredParams-- Somehow (X11Color Transparency) is white, use (RGBA 0 0 0 0) instead{globalAttributes=[GraphAttrs[BgColor[RGBA0000],FontNamefontName,FontSizegraphFontSize]],fmtNode=\(_,l)->[toLabell,FontNamefontName,FontSizenodeFontSize],fmtEdge=\(_,_,l)->[toLabell,FontNamefontName,FontSizeedgeFontSize]}