-- |-- Module: Text.Dot-- Copyright: Andy Gill-- License: BSD3---- Maintainer: Andy Gill <andygill@ku.edu>-- Stability: unstable-- Portability: portable---- This module provides a simple interface for building .dot graph files, for input into the dot and graphviz tools. -- It includes a monadic interface for building graphs.moduleText.Dot(-- * DotDot-- abstract-- * Nodes,node,NodeId-- abstract,userNodeId,userNode-- * Edges,edge,edge',(.->.)-- * Showing a graph,showDot-- * Other combinators,scope,attribute,share,same,cluster-- * Simple netlist generation,netlistGraph)whereimportData.CharimportqualifiedData.MapasMimportqualifiedData.SetasSdataDotGraph=DotGraph[GraphElement]dataNodeId=NodeIdString|UserNodeIdIntinstanceShowNodeIdwhereshow(NodeIdstr)=strshow(UserNodeIdi)|i<0="u_"++show(negatei)|otherwise="u"++showidataGraphElement=GraphAttributeStringString|GraphNodeNodeId[(String,String)]|GraphEdgeNodeIdNodeId[(String,String)]|GraphEdge'NodeId(MaybeString)NodeId(MaybeString)[(String,String)]|Scope[GraphElement]|SubGraphNodeId[GraphElement]dataDota=Dot{unDot::Int->([GraphElement],Int,a)}instanceMonadDotwherereturna=Dot$\uq->([],uq,a)m>>=k=Dot$\uq->caseunDotmuqof(g1,uq',r)->caseunDot(kr)uq'of(g2,uq2,r2)->(g1++g2,uq2,r2)-- | 'node' takes a list of attributes, generates a new node, and gives a 'NodeId'.node::[(String,String)]->DotNodeIdnodeattrs=Dot$\uq->letnid=NodeId$"n"++showuqin([GraphNodenidattrs],succuq,nid)-- | 'userNodeId' allows a user to use their own (Int-based) node id's, without needing to remap them.userNodeId::Int->NodeIduserNodeIdi=UserNodeIdi-- | 'userNode' takes a NodeId, and adds some attributes to that node. userNode::NodeId->[(String,String)]->Dot()userNodenIdattrs=Dot$\uq->([GraphNodenIdattrs],uq,())-- | 'edge' generates an edge between two 'NodeId's, with attributes.edge::NodeId->NodeId->[(String,String)]->Dot()edgefromtoattrs=Dot(\uq->([GraphEdgefromtoattrs],uq,()))-- | 'edge' generates an edge between two 'NodeId's, with optional node sub-labels, and attributes.edge'::NodeId->MaybeString->NodeId->MaybeString->[(String,String)]->Dot()edge'fromoptFtooptTattrs=Dot(\uq->([GraphEdge'fromoptFtooptTattrs],uq,()))-- | '.->.' generates an edge between two 'NodeId's.(.->.)fromto=edgefromto[]-- | 'scope' groups a subgraph together; in dot these are the subgraphs inside "{" and "}".scope::Dota->Dotascope(Dotfn)=Dot(\uq->casefnuqof(elems,uq',a)->([Scopeelems],uq',a))-- | 'share' is when a set of nodes share specific attributes. Usually used for layout tweaking.share::[(String,String)]->[NodeId]->Dot()shareattrsnodeids=Dot$\uq->([Scope([GraphAttributenameval|(name,val)<-attrs]++[GraphNodenodeid[]|nodeid<-nodeids])],uq,())-- | 'same' provides a combinator for a common pattern; a set of 'NodeId's with the same rank.same::[NodeId]->Dot()same=share[("rank","same")]-- | 'cluster' builds an explicit, internally named subgraph (called cluster). cluster::Dota->Dot(NodeId,a)cluster(Dotfn)=Dot(\uq->letcid=NodeId$"cluster_"++showuqincasefn(succuq)of(elems,uq',a)->([SubGraphcidelems],uq',(cid,a)))-- | 'attribute' gives a attribute to the current scope.attribute::(String,String)->Dot()attribute(name,val)=Dot(\uq->([GraphAttributenameval],uq,()))-- 'showDot' renders a dot graph as a 'String'.showDot::Dota->StringshowDot(Dotdm)=casedm0of(elems,_,_)->"digraph G {\n"++unlines(mapshowGraphElementelems)++"\n}\n"showGraphElement(GraphAttributenameval)=showAttr(name,val)++";"showGraphElement(GraphNodenidattrs)=shownid++showAttrsattrs++";"showGraphElement(GraphEdgefromtoattrs)=showfrom++" -> "++showto++showAttrsattrs++";"showGraphElement(GraphEdge'fromoptFtooptTattrs)=showNamefromoptF++" -> "++showNametooptT++showAttrsattrs++";"whereshowNamenNothing=shownshowNamen(Justt)=shown++":"++tshowGraphElement(Scopeelems)="{\n"++unlines(mapshowGraphElementelems)++"\n}"showGraphElement(SubGraphnidelems)="subgraph "++shownid++" {\n"++unlines(mapshowGraphElementelems)++"\n}"showAttrs[]=""showAttrsxs="["++showAttrs'xs++"]"where-- never empty listshowAttrs'[a]=showAttrashowAttrs'(a:as)=showAttra++","++showAttrs'asshowAttr(name,val)=name++"=\""++foldrshowsDotChar""val++"\""showsDotChar'"'=("\\\""++)showsDotChar'\\'=("\\\\"++)showsDotCharx=showLitCharx-- | 'netlistGraph' generates a simple graph from a netlist.netlistGraph::(Orda)=>(b->[(String,String)])-- ^ Attributes for each node->(b->[a])-- ^ Out edges leaving each node->[(a,b)]-- ^ The netlist->Dot()netlistGraphattrFnoutFnassocs=doletnodes=S.fromList$[a|(a,_)<-assocs]letouts=S.fromList$[o|(_,b)<-assocs,o<-outFnb]nodeTab<-sequence[dond<-node(attrFnb)return(a,nd)|(a,b)<-assocs]otherTab<-sequence[dond<-node[]return(o,nd)|o<-S.toListouts,o`S.notMember`nodes]letfm=M.fromList(nodeTab++otherTab)sequence_[(fmM.!src).->.(fmM.!dst)|(dst,b)<-assocs,src<-outFnb]return()