1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
----------------------------------------------------------------------
-- |
-- Module : VisualizeGrammar
-- Maintainer : BB
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/05/17 11:20:26 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.9 $
--
-- Print a graph of module dependencies in Graphviz DOT format
-----------------------------------------------------------------------------
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)
|
