From b7a60b5e4568cc33a30e83226b514b672d0edd96 Mon Sep 17 00:00:00 2001
From: aarne <aarne@chalmers.se>
Date: Tue, 6 Apr 2010 08:53:44 +0000
Subject: [PATCH] dependency graph can be restricted to some modules; added
 help dg

---
 src/compiler/GF/Command/Commands.hs   | 25 ++++++++++++++++
 src/compiler/GF/Infra/Dependencies.hs | 41 ++++++++++++++++++---------
 src/compiler/GFI.hs                   |  6 +++-
 3 files changed, 57 insertions(+), 15 deletions(-)

diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs
index 51f1c1426..0ca54839c 100644
--- a/src/compiler/GF/Command/Commands.hs
+++ b/src/compiler/GF/Command/Commands.hs
@@ -208,6 +208,31 @@ allCommands cod env@(pgf, mos) = Map.fromList [
        ],
      needsTypeCheck = False
      }),
+  ("dg",  emptyCommandInfo {
+     longname = "dependency_graph",
+     syntax = "dg (-only=MODULES)?",
+     synopsis = "print module dependency graph",
+     explanation = unlines [
+       "Prints the dependency graph of source modules.",
+       "Requires that import has been done with the -retain flag.",
+       "The graph is written in the file _gfdepgraph.dot",
+       "which can be further processed by Graphviz (the system command 'dot').",
+       "By default, all modules are shown, but the -only flag restricts them",
+       "by a comma-separated list of patterns, where 'name*' matches modules",
+       "whose name has prefix 'name', and other patterns match modules with",
+       "exactly the same name. The graphical conventions are:",
+       "  solid box = abstract, solid ellipse = concrete, dashed ellipse = other",
+       "  solid arrow empty head = of, solid arrow = **, dashed arrow = open",
+       "  dotted arrow = other dependency"
+       ],
+     flags = [
+       ("only","list of modules included (default: all), literally or by prefix*")
+       ],
+     examples = [
+       "dg -only=SyntaxEng,Food*  -- shows only SyntaxEng, and those with prefix Food"
+       ],
+     needsTypeCheck = False
+     }),
   ("dt",  emptyCommandInfo {
      longname = "define_tree",
      syntax = "dt IDENT (TREE | STRING | \"<\" COMMANDLINE)",
diff --git a/src/compiler/GF/Infra/Dependencies.hs b/src/compiler/GF/Infra/Dependencies.hs
index 9a870b139..82606a865 100644
--- a/src/compiler/GF/Infra/Dependencies.hs
+++ b/src/compiler/GF/Infra/Dependencies.hs
@@ -6,8 +6,11 @@ import GF.Grammar.Grammar
 import GF.Infra.Modules
 import GF.Infra.Ident
 
-depGraph :: SourceGrammar -> String
-depGraph = prDepGraph . grammar2moddeps
+import Data.List (nub,isPrefixOf)
+
+-- the list gives the only modules to show, e.g. to hide the library details
+depGraph :: Maybe [String] -> SourceGrammar -> String
+depGraph only = prDepGraph . grammar2moddeps only
 
 prDepGraph :: [(Ident,ModDeps)] -> String
 prDepGraph deps = unlines $ [
@@ -47,15 +50,25 @@ data ModDeps = ModDeps {
 
 noModDeps = ModDeps MTAbstract [] [] [] [] [] [] []
 
-grammar2moddeps :: SourceGrammar -> [(Ident,ModDeps)]
-grammar2moddeps gr = [(i,depMod m) | (i,m) <- modules gr] where
-  depMod m = noModDeps{
-    modtype = mtype m,
-    ofs     = case mtype m of 
-                MTConcrete i -> [i]
-                MTInstance i -> [i]
-                _ -> [],
-    extendeds = map fst (extend m),
-    openeds = map openedModule (opens m),
-    extrads = mexdeps m
-    }
+grammar2moddeps :: Maybe [String] -> SourceGrammar -> [(Ident,ModDeps)]
+grammar2moddeps monly gr = [(i,depMod i m) | (i,m) <- modules gr, yes i]
+  where
+    depMod i m = 
+        noModDeps{
+          modtype = mtype m,
+          ofs     = case mtype m of 
+                     MTConcrete i -> [i | yes i]
+                     MTInstance i -> [i | yes i]
+                     _ -> [],
+          extendeds = nub $ filter yes $ map fst (extend m),
+          openeds = nub $ filter yes $ map openedModule (opens m),
+          extrads = nub $ filter yes $ mexdeps m
+          }
+    yes i = case monly of 
+      Just only -> match (showIdent i) only
+      _ -> True
+    match s os = any (\x -> doMatch x s) os
+    doMatch x s = case last x of 
+      '*' -> isPrefixOf (init x) s
+      _   -> x == s
+
diff --git a/src/compiler/GFI.hs b/src/compiler/GFI.hs
index e80403145..9561c407f 100644
--- a/src/compiler/GFI.hs
+++ b/src/compiler/GFI.hs
@@ -7,6 +7,7 @@ import GF.Command.Commands
 import GF.Command.Abstract
 import GF.Command.Parse
 import GF.Data.ErrM
+import GF.Data.Operations (chunks)
 import GF.Grammar hiding (Ident)
 import GF.Grammar.Parser (runP, pExp)
 import GF.Grammar.ShowTerm
@@ -133,7 +134,10 @@ loop opts gfenv0 = do
                                  Bad s -> putStrLn $ enc s
              loopNewCPU gfenv
           "dg":ws -> do
-             writeFile "_gfdepgraph.dot" (depGraph sgr)
+             let stop = case ws of
+                   ('-':'o':'n':'l':'y':'=':fs):_ -> Just $ chunks ',' fs
+                   _ -> Nothing
+             writeFile "_gfdepgraph.dot" (depGraph stop sgr)
              putStrLn "wrote graph in file _gfdepgraph.dot"
              loopNewCPU gfenv
           "eh":w:_ -> do