diff options
Diffstat (limited to 'src-3.0/GF/Visualization')
| -rw-r--r-- | src-3.0/GF/Visualization/Graphviz.hs | 116 | ||||
| -rw-r--r-- | src-3.0/GF/Visualization/VisualizeGrammar.hs | 125 | ||||
| -rw-r--r-- | src-3.0/GF/Visualization/VisualizeTree.hs | 58 |
3 files changed, 0 insertions, 299 deletions
diff --git a/src-3.0/GF/Visualization/Graphviz.hs b/src-3.0/GF/Visualization/Graphviz.hs deleted file mode 100644 index b59e3ecd2..000000000 --- a/src-3.0/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-3.0/GF/Visualization/VisualizeGrammar.hs b/src-3.0/GF/Visualization/VisualizeGrammar.hs deleted file mode 100644 index b5446aec8..000000000 --- a/src-3.0/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-3.0/GF/Visualization/VisualizeTree.hs b/src-3.0/GF/Visualization/VisualizeTree.hs deleted file mode 100644 index 5fe740c12..000000000 --- a/src-3.0/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" |