dotgen 0.2 → 0.3

raw patch · 3 files changed

+154/−8 lines, 3 filesdep +containersnew-component:exe:dotgen-testPVP ok

version bump matches the API change (PVP)

Dependencies added: containers

API changes (from Hackage documentation)

Files

• Text/Dot.hs +47/−1
• dotgen.cabal +8/−7
• test/DotTest.hs +99/−0

@@ -21,6 +21,7 @@ 	, userNode 	  -- * Edges 	, edge+        , edge' 	, (.->.) 	  -- * Showing a graph 	, showDot@@ -30,8 +31,14 @@ 	, share 	, same 	, cluster+	  -- * Simple netlist generation+	, netlistGraph 	) where +import Data.Char+import qualified Data.Map as M+import qualified Data.Set as S+ data DotGraph = DotGraph [GraphElement]  data NodeId = NodeId String@@ -46,6 +53,7 @@ data GraphElement = GraphAttribute String String 		  | GraphNode NodeId        [(String,String)] 		  | GraphEdge NodeId NodeId [(String,String)]+		  | GraphEdge' NodeId (Maybe String) NodeId (Maybe String) [(String,String)] 		  | Scope           [GraphElement] 		  | SubGraph NodeId [GraphElement] @@ -75,6 +83,10 @@ edge      :: NodeId -> NodeId -> [(String,String)] -> Dot () edge  from to attrs = Dot (\ uq -> ( [ GraphEdge from to attrs ],uq,())) +-- | 'edge' generates an edge between two 'NodeId's, with optional node sub-labels, and attributes.+edge'      :: NodeId -> Maybe String -> NodeId -> Maybe String -> [(String,String)] -> Dot ()+edge'  from optF to optT attrs = Dot (\ uq -> ( [ GraphEdge' from optF to optF attrs ],uq,()))+ -- | '.->.' generates an edge between two 'NodeId's. (.->.) from to = edge from to [] @@ -115,6 +127,9 @@ showGraphElement (GraphAttribute name val) = showAttr (name,val) ++ ";" showGraphElement (GraphNode nid attrs)           = show nid ++ showAttrs attrs ++ ";" showGraphElement (GraphEdge from to attrs) = show from ++ " -> " ++ show to ++  showAttrs attrs ++ ";"+showGraphElement (GraphEdge' from optF to optT attrs) = showName from optF ++ " -> " ++ showName to optT ++  showAttrs attrs ++ ";"+    where showName n Nothing = show n+          showName n (Just t) = show n ++ ":" ++ t showGraphElement (Scope elems) = "{\n" ++ unlines (map showGraphElement elems) ++ "\n}" showGraphElement (SubGraph nid elems) = "subgraph " ++ show nid ++ " {\n" ++ unlines (map showGraphElement elems) ++ "\n}" @@ -125,4 +140,35 @@ 	showAttrs' [a]    = showAttr a 	showAttrs' (a:as) = showAttr a ++ "," ++ showAttrs' as -showAttr (name,val) = name ++ "=" ++ show val+showAttr (name,val) = name ++ "=\""   ++ foldr showsDotChar "" val ++ "\""++showsDotChar '"'  = ("\\\"" ++)+showsDotChar '\\' = ("\\\\" ++)+showsDotChar x    = showLitChar x+++-- | 'netlistGraph' generates a simple graph from a netlist.+netlistGraph :: (Ord a) +          => (b -> [(String,String)])   -- ^ Attributes for each node+          -> (b -> [a])                 -- ^ Out edges leaving each node+          -> [(a,b)] 			-- ^ The netlist+	  -> Dot ()+netlistGraph attrFn outFn assocs = do+    let nodes = S.fromList $ [ a | (a,_) <- assocs ]+    let outs  = S.fromList $ [ o | (_,b) <- assocs+				 , o <- outFn b +			     ]+    nodeTab <- sequence [ do nd <- node (attrFn b)+                             return (a,nd)+                        | (a,b) <- assocs ]+    otherTab <- sequence [ do nd <- node []+                              return (o,nd)+                         | o <- S.toList outs+                         , o `S.notMember` nodes+                         ]+    let fm = M.fromList (nodeTab ++ otherTab)+    sequence_ [ (fm M.! src) .->. (fm M.! dst)+              | (src,b) <- assocs+              , dst     <- outFn b+              ]+    return ()

@@ -1,21 +1,22 @@ Name:                dotgen-Version:             0.2+Version:             0.3 Synopsis:            A simple interface for building .dot graph files. Description:         This package 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.-Category:            Graphics+Category:            Text License:             BSD3 License-file:        LICENSE Author:              Andy Gill Maintainer:          Andy Gill <andygill@ku.edu>-Build-Depends:       base+Build-Depends:       base, containers Exposed-Modules:     Text.Dot Stability:	     alpha build-type: 	     Simple  -- Trivial (build) test framework---Executable:          dotgen-test---hs-source-dirs:	     test, .---ghc-options:	     -fhpc---Main-is:             DotTest.hs+Executable:          dotgen-test+hs-source-dirs:	     test, .+Main-is:             DotTest.hs+buildable: False+

@@ -0,0 +1,99 @@+module Main where++import Text.Dot++data Animation = Start++src label = node $ [ ("shape","none"),("label",label) ]+box label = node $ [ ("shape","box"),("style","rounded"),("label",label) ]++diamond label = node $ [("shape","diamond"),("label",label),("fontsize","10")]+++main = putStrLn $ showDot $ do+	attribute ("size","40,15")+	attribute ("rankdir","LR")+	refSpec <- src "S"+	tarSpec <- src "T"+	same [refSpec,tarSpec]++	c1 <- box "S"+	c2 <- box "C"+	c3 <- box "F"+	same [c1,c2,c3]++	refSpec .->. c1	+	tarSpec .->. c2	+	tarSpec .->. c3++	m1 <- box "x"+	m2 <- box "y"+	ntm <- box "z"++	same [m1,m2,ntm] +	c1 .->. m1+	c2 .->. m2++	xilinxSynthesis <- box "x"+	c3 .->. xilinxSynthesis++	gns <- box "G"+	xilinxSynthesis .->. gns++	gns .->. ntm++	ecs <- sequence+		[ diamond "E"+		, diamond "E"+		, diamond "Eq"+		]+	same ecs	++	m1 .->. (ecs !! 0)+	m1 .->. (ecs !! 1)+	m2 .->. (ecs !! 0)+	m2 .->. (ecs !! 2)+	ntm .->. (ecs !! 1)+	ntm .->. (ecs !! 2)++	sequence [ do evidence <- src "EE"+		      n .->. evidence+		 | n <- ecs +		 ]+++	edge refSpec tarSpec [("label","Engineering\nEffort"),("style","dotted")]++	() <- scope $ do v1 <- box "Hello"+		         v2 <- box "World"+		         v1 .->. v2++	(x,()) <- cluster $+		do v1 <- box "Hello"+		   v2 <- box "World"+		   v1 .->. v2+			+--	x .->. m2+	-- for hpc+	() <- same [x,x]+	v <- box "XYZ"+	v .->. v+	() <- attribute ("rankdir","LR")++	let n1 = userNodeId 1+	let n2 = userNodeId (-1)++	() <- n1 `userNode` [ ("shape","box")]+	n1 .->. n2+	+	v'' <- box "XYZ"++        box "(\n\\n)\"(/\\)"++	netlistGraph (\ a -> [("label","X" ++ show a)])+	             (\ a -> [succ a `mod` 10,pred a `mod` 10])+	             [ (n,n) | n <- [0..9]]+	             +	+	return ()+