diff options
Diffstat (limited to 'src-3.0/GF/Visualization/VisualizeGrammar.hs')
| -rw-r--r-- | src-3.0/GF/Visualization/VisualizeGrammar.hs | 125 |
1 files changed, 0 insertions, 125 deletions
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) |
