summaryrefslogtreecommitdiff
path: root/src/GF/Visualization
diff options
context:
space:
mode:
Diffstat (limited to 'src/GF/Visualization')
-rw-r--r--src/GF/Visualization/Graphviz.hs68
-rw-r--r--src/GF/Visualization/VisualizeGrammar.hs8
-rw-r--r--src/GF/Visualization/VisualizeTree.hs2
3 files changed, 75 insertions, 3 deletions
diff --git a/src/GF/Visualization/Graphviz.hs b/src/GF/Visualization/Graphviz.hs
new file mode 100644
index 000000000..fe2dd0b82
--- /dev/null
+++ b/src/GF/Visualization/Graphviz.hs
@@ -0,0 +1,68 @@
+----------------------------------------------------------------------
+-- |
+-- Module : Graphviz
+-- Maintainer : BB
+-- Stability : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/09/14 15:17:30 $
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.1 $
+--
+-- Graphviz DOT format representation and printing.
+-----------------------------------------------------------------------------
+
+module GF.Visualization.Graphviz (
+ Graph(..), GraphType(..),
+ Node(..), Edge(..),
+ Attr,
+ prGraphviz
+ ) where
+
+import GF.Data.Utilities
+
+data Graph = Graph GraphType [Attr] [Node] [Edge]
+ deriving (Show)
+
+data GraphType = Directed | Undirected
+ deriving (Show)
+
+data Node = Node String [Attr]
+ deriving Show
+
+data Edge = Edge String String [Attr]
+ deriving Show
+
+type Attr = (String,String)
+
+prGraphviz :: Graph -> String
+prGraphviz (Graph t at ns es) =
+ unlines $ [graphtype t ++ " {"]
+ ++ map (++";") (map prAttr at
+ ++ map prNode ns
+ ++ map (prEdge t) es)
+ ++ ["}\n"]
+
+graphtype :: GraphType -> String
+graphtype Directed = "digraph"
+graphtype Undirected = "graph"
+
+prNode :: Node -> String
+prNode (Node n at) = esc n ++ " " ++ prAttrList at
+
+prEdge :: GraphType -> Edge -> String
+prEdge t (Edge x y at) = esc x ++ " " ++ edgeop t ++ " " ++ prAttrList at
+
+edgeop :: GraphType -> String
+edgeop Directed = "->"
+edgeop Undirected = "--"
+
+prAttrList :: [Attr] -> String
+prAttrList = join "," . map prAttr
+
+prAttr :: Attr -> String
+prAttr (n,v) = esc n ++ " = " ++ esc v
+
+esc :: String -> String
+esc s = "\"" ++ concat [ if shouldEsc c then ['\\',c] else [c] | c <- s ] ++ "\""
+ where shouldEsc = (`elem` ['"', '\\']) \ No newline at end of file
diff --git a/src/GF/Visualization/VisualizeGrammar.hs b/src/GF/Visualization/VisualizeGrammar.hs
index e217dd7e2..b5446aec8 100644
--- a/src/GF/Visualization/VisualizeGrammar.hs
+++ b/src/GF/Visualization/VisualizeGrammar.hs
@@ -5,11 +5,13 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/05/17 11:20:26 $
--- > CVS $Author: peb $
--- > CVS $Revision: 1.9 $
+-- > CVS $Date: 2005/09/14 15:17:30 $
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.10 $
--
-- Print a graph of module dependencies in Graphviz DOT format
+-- FIXME: change this to use GF.Visualization.Graphviz,
+-- instead of rolling its own.
-----------------------------------------------------------------------------
module GF.Visualization.VisualizeGrammar ( visualizeCanonGrammar,
diff --git a/src/GF/Visualization/VisualizeTree.hs b/src/GF/Visualization/VisualizeTree.hs
index 8edc5f3b2..5fe740c12 100644
--- a/src/GF/Visualization/VisualizeTree.hs
+++ b/src/GF/Visualization/VisualizeTree.hs
@@ -11,6 +11,8 @@
--
-- Print a graph of an abstract syntax tree in Graphviz DOT format
-- Based on BB's VisualizeGrammar
+-- FIXME: change this to use GF.Visualization.Graphviz,
+-- instead of rolling its own.
-----------------------------------------------------------------------------
module GF.Visualization.VisualizeTree ( visualizeTrees