summaryrefslogtreecommitdiff
path: root/src/GF/Visualization
diff options
context:
space:
mode:
Diffstat (limited to 'src/GF/Visualization')
-rw-r--r--src/GF/Visualization/Graphviz.hs116
-rw-r--r--src/GF/Visualization/VisualizeGrammar.hs125
-rw-r--r--src/GF/Visualization/VisualizeTree.hs58
3 files changed, 0 insertions, 299 deletions
diff --git a/src/GF/Visualization/Graphviz.hs b/src/GF/Visualization/Graphviz.hs
deleted file mode 100644
index b59e3ecd2..000000000
--- a/src/GF/Visualization/Graphviz.hs
+++ /dev/null
@@ -1,116 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module : Graphviz
--- Maintainer : BB
--- Stability : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/09/15 18:10:44 $
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.2 $
---
--- Graphviz DOT format representation and printing.
------------------------------------------------------------------------------
-
-module GF.Visualization.Graphviz (
- Graph(..), GraphType(..),
- Node(..), Edge(..),
- Attr,
- addSubGraphs,
- setName,
- setAttr,
- prGraphviz
- ) where
-
-import Data.Char
-
-import GF.Data.Utilities
-
--- | Graph type, graph ID, graph attirbutes, graph nodes, graph edges, subgraphs
-data Graph = Graph {
- gType :: GraphType,
- gId :: Maybe String,
- gAttrs :: [Attr],
- gNodes :: [Node],
- gEdges :: [Edge],
- gSubgraphs :: [Graph]
- }
- 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)
-
---
--- * Graph construction
---
-
-addSubGraphs :: [Graph] -> Graph -> Graph
-addSubGraphs gs g = g { gSubgraphs = gs ++ gSubgraphs g }
-
-setName :: String -> Graph -> Graph
-setName n g = g { gId = Just n }
-
-setAttr :: String -> String -> Graph -> Graph
-setAttr n v g = g { gAttrs = tableSet n v (gAttrs g) }
-
---
--- * Pretty-printing
---
-
-prGraphviz :: Graph -> String
-prGraphviz g@(Graph t i _ _ _ _) =
- graphtype t ++ " " ++ maybe "" esc i ++ " {\n" ++ prGraph g ++ "}\n"
-
-prSubGraph :: Graph -> String
-prSubGraph g@(Graph _ i _ _ _ _) =
- "subgraph" ++ " " ++ maybe "" esc i ++ " {\n" ++ prGraph g ++ "}"
-
-prGraph :: Graph -> String
-prGraph (Graph t id at ns es ss) =
- unlines $ map (++";") (map prAttr at
- ++ map prNode ns
- ++ map (prEdge t) es
- ++ map prSubGraph ss)
-
-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 ++ " " ++ esc y ++ " " ++ prAttrList at
-
-edgeop :: GraphType -> String
-edgeop Directed = "->"
-edgeop Undirected = "--"
-
-prAttrList :: [Attr] -> String
-prAttrList [] = ""
-prAttrList at = "[" ++ join "," (map prAttr at) ++ "]"
-
-prAttr :: Attr -> String
-prAttr (n,v) = esc n ++ " = " ++ esc v
-
-esc :: String -> String
-esc s | needEsc s = "\"" ++ concat [ if shouldEsc c then ['\\',c] else [c] | c <- s ] ++ "\""
- | otherwise = s
- where shouldEsc = (`elem` ['"', '\\'])
-
-needEsc :: String -> Bool
-needEsc [] = True
-needEsc xs | all isDigit xs = False
-needEsc (x:xs) = not (isIDFirst x && all isIDChar xs)
-
-isIDFirst, isIDChar :: Char -> Bool
-isIDFirst c = c `elem` (['_']++['a'..'z']++['A'..'Z'])
-isIDChar c = isIDFirst c || isDigit c
diff --git a/src/GF/Visualization/VisualizeGrammar.hs b/src/GF/Visualization/VisualizeGrammar.hs
deleted file mode 100644
index b5446aec8..000000000
--- a/src/GF/Visualization/VisualizeGrammar.hs
+++ /dev/null
@@ -1,125 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module : VisualizeGrammar
--- Maintainer : BB
--- Stability : (stable)
--- Portability : (portable)
---
--- > 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,
- visualizeSourceGrammar
- ) where
-
-import qualified GF.Infra.Modules as M
-import GF.Canon.GFC
-import GF.Infra.Ident
-import GF.Infra.Option
-import GF.Grammar.Grammar (SourceGrammar)
-
-import Data.List (intersperse, nub)
-import Data.Maybe (maybeToList)
-
-data GrType = GrAbstract
- | GrConcrete
- | GrResource
- | GrInterface
- | GrInstance
- deriving Show
-
-data Node = Node {
- label :: String,
- url :: String,
- grtype :: GrType,
- extends :: [String],
- opens :: [String],
- implements :: Maybe String
- }
- deriving Show
-
-
-visualizeCanonGrammar :: Options -> CanonGrammar -> String
-visualizeCanonGrammar opts = prGraph . canon2graph
-
-visualizeSourceGrammar :: SourceGrammar -> String
-visualizeSourceGrammar = prGraph . source2graph
-
-canon2graph :: CanonGrammar -> [Node]
-canon2graph gr = [ toNode i m | (i,M.ModMod m) <- M.modules gr ]
-
-source2graph :: SourceGrammar -> [Node]
-source2graph gr = [ toNode i m | (i,M.ModMod m) <- M.modules gr ] -- FIXME: handle ModWith?
-
-toNode :: Ident -> M.Module Ident f i -> Node
-toNode i m = Node {
- label = l,
- url = l ++ ".gf", -- FIXME: might be in a different directory
- grtype = t,
- extends = map prIdent (M.extends m),
- opens = nub $ map openName (M.opens m), -- FIXME: nub is needed because of triple open with
- -- instance modules
- implements = is
- }
- where
- l = prIdent i
- (t,is) = fromModType (M.mtype m)
-
-fromModType :: M.ModuleType Ident -> (GrType, Maybe String)
-fromModType t = case t of
- M.MTAbstract -> (GrAbstract, Nothing)
- M.MTTransfer _ _ -> error "Can't visualize transfer modules yet" -- FIXME
- M.MTConcrete i -> (GrConcrete, Just (prIdent i))
- M.MTResource -> (GrResource, Nothing)
- M.MTInterface -> (GrInterface, Nothing)
- M.MTInstance i -> (GrInstance, Just (prIdent i))
- M.MTReuse rt -> error "Can't visualize reuse modules yet" -- FIXME
- M.MTUnion _ _ -> error "Can't visualize union modules yet" -- FIXME
-
--- | FIXME: there is something odd about OQualif with 'with' modules,
--- both names seem to be the same.
-openName :: M.OpenSpec Ident -> String
-openName (M.OSimple q i) = prIdent i
-openName (M.OQualif q i _) = prIdent i
-
-prGraph :: [Node] -> String
-prGraph ns = concat $ map (++"\n") $ ["digraph {\n"] ++ map prNode ns ++ ["}"]
-
-prNode :: Node -> String
-prNode n = concat (map (++";\n") stmts)
- where
- l = label n
- t = grtype n
- stmts = [l ++ " [" ++ prAttributes attrs ++ "]"]
- ++ map (prExtend t l) (extends n)
- ++ map (prOpen l) (opens n)
- ++ map (prImplement t l) (maybeToList (implements n))
- (shape,style) = case t of
- GrAbstract -> ("ellipse","solid")
- GrConcrete -> ("box","dashed")
- GrResource -> ("ellipse","dashed")
- GrInterface -> ("ellipse","dotted")
- GrInstance -> ("diamond","dotted")
- attrs = [("style", style),("shape", shape),("URL", url n)]
-
-
-prExtend :: GrType -> String -> String -> String
-prExtend g f t = prEdge f t [("style","solid")]
-
-prOpen :: String -> String -> String
-prOpen f t = prEdge f t [("style","dotted")]
-
-prImplement :: GrType -> String -> String -> String
-prImplement g f t = prEdge f t [("arrowhead","empty"),("style","dashed")]
-
-prEdge :: String -> String -> [(String,String)] -> String
-prEdge f t as = f ++ " -> " ++ t ++ " [" ++ prAttributes as ++ "]"
-
-prAttributes :: [(String,String)] -> String
-prAttributes = concat . intersperse ", " . map (\ (n,v) -> n ++ " = " ++ show v)
diff --git a/src/GF/Visualization/VisualizeTree.hs b/src/GF/Visualization/VisualizeTree.hs
deleted file mode 100644
index 5fe740c12..000000000
--- a/src/GF/Visualization/VisualizeTree.hs
+++ /dev/null
@@ -1,58 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module : VisualizeTree
--- Maintainer : AR
--- Stability : (stable)
--- Portability : (portable)
---
--- > CVS $Date:
--- > CVS $Author:
--- > CVS $Revision:
---
--- 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
- ) where
-
-import GF.Infra.Ident
-import GF.Infra.Option
-import GF.Grammar.Abstract
-import GF.Data.Zipper
-import GF.Grammar.PrGrammar
-
-import Data.List (intersperse, nub)
-import Data.Maybe (maybeToList)
-
-visualizeTrees :: Options -> [Tree] -> String
-visualizeTrees opts = unlines . map (prGraph opts . tree2graph opts)
-
-tree2graph :: Options -> Tree -> [String]
-tree2graph opts = prf [] where
- prf ps t@(Tr (node, trees)) =
- let (nod,lab) = prn ps node in
- (nod ++ " [label = " ++ lab ++ ", style = \"solid\", shape = \"plaintext\"] ;") :
- [ pra (j:ps) nod t | (j,t) <- zip [0..] trees] ++
- concat [prf (j:ps) t | (j,t) <- zip [0..] trees]
- prn ps (N (bi,at,val,_,_)) =
- let
- lab =
- "\"" ++
- prb bi ++
- prc at val ++
- "\""
- in if oElem (iOpt "g") opts then (lab,lab) else (show(show (ps :: [Int])),lab)
- prb [] = ""
- prb bi = "\\" ++ concat (intersperse "," (map (prt_ . fst) bi)) ++ " -> "
- pra i nod t@(Tr (node,_)) = nod ++ arr ++ fst (prn i node) ++ " [style = \"solid\"];"
- prc a v
- | oElem (iOpt "c") opts = prt_ v
- | oElem (iOpt "f") opts = prt_ a
- | otherwise = prt_ a ++ " : " ++ prt_ v
- arr = if oElem (iOpt "g") opts then " -> " else " -- "
-
-prGraph opts ns = concat $ map (++"\n") $ [graph ++ "{\n"] ++ ns ++ ["}"] where
- graph = if oElem (iOpt "g") opts then "digraph" else "graph"
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 11:24:03 +0000