tree visualization command

src-3.0/GF/Command/Abstract.hs

@@ -54,6 +54,9 @@ valOpts flag def opts = case lookup flag flags of
 isOpt :: String -> [Option] -> Bool
 isOpt o opts = elem o [x | OOpt x <- opts]
 
+isFlag :: String -> [Option] -> Bool
+isFlag o opts = elem o [x | OFlag x _ <- opts]
+
 prOpt :: Option -> String
 prOpt (OOpt i) = i ----
 

src-3.0/GF/Command/Commands.hs

@@ -16,6 +16,7 @@ import PGF.Macros
 import PGF.Data ----
 import PGF.Morphology
 import PGF.Quiz
+import PGF.VisualizeTree
 import GF.Compile.Export
 import GF.Infra.Option (noOptions)
 import GF.Infra.UseIO
@@ -436,6 +437,38 @@ allCommands pgf = Map.fromList [
        ("thai",      "Thai")
        ] 
      }),
+  ("vt", emptyCommandInfo {
+     longname = "visualize_tree",
+     synopsis = "show a set of trees graphically",
+     explanation = unlines [
+       "Prints a set of trees in the .dot format (the graphviz format).",
+       "The graph can be saved in a file by the wf command as usual.",
+       "If the -view flag is defined, the graph is saved in a temporary file",
+       "which is processed by graphviz and displayed by the program indicated",
+       "by the flag. The target format is postscript, unless overridden by the",
+       "flag -format."
+       ],
+     exec = \opts ts -> do
+         let grph = visualizeTrees False ts -- True=digraph
+         if isFlag "view" opts || isFlag "format" opts then do
+           let file s = "_grph." ++ s
+           let view = optViewGraph opts ++ " "
+           let format = optViewFormat opts 
+           writeFile (file "dot") grph
+           system $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format ++ 
+                    " ; " ++ view ++ file format
+           return void
+          else return $ fromString grph,
+     examples = [
+       "p \"hello\" | vt              -- parse a string and show trees as graph script",
+       "p \"hello\" | vt -view=\"open\" -- parse a string and display trees on a Mac"
+       ],
+
+     flags = [
+       ("format","format of the visualization file (default \"ps\")"),
+       ("view","program to open the resulting file (default \"gv\")")
+       ] 
+     }),
   ("wf", emptyCommandInfo {
      longname = "write_file",
      synopsis = "send string or tree to a file",
@@ -480,6 +513,8 @@ allCommands pgf = Map.fromList [
    optLang opts = head $ optLangs opts ++ ["#NOLANG"] 
    optCat opts = valIdOpts "cat" (lookStartCat pgf) opts
    optComm opts = valStrOpts "command" "" opts
+   optViewFormat opts = valStrOpts "format" "ps" opts
+   optViewGraph opts = valStrOpts "view" "gv" opts
    optNum opts = valIntOpts "number" 1 opts
    optNumInf opts = valIntOpts "number" 1000000000 opts ---- 10^9
 

src-3.0/PGF/VisualizeTree.hs

@@ -0,0 +1,42 @@
+----------------------------------------------------------------------
+-- |
+-- 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 PGF.VisualizeTree ( visualizeTrees
+			) where
+
+import PGF.CId (prCId)
+import PGF.Data
+
+visualizeTrees :: Bool -> [Tree] -> String
+visualizeTrees digr = unlines . map (prGraph digr . tree2graph digr)
+
+tree2graph :: Bool -> Tree -> [String]
+tree2graph digr = prf [] where
+  prf ps t = case t of
+    Fun cid trees -> 
+      let (nod,lab) = prn ps cid 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 cid = 
+    let lab = "\"" ++ prCId cid ++ "\""
+    in (show(show (ps :: [Int])),lab)
+  pra i nod t@(Fun cid _) =  nod ++ arr ++ fst (prn i cid) ++ " [style = \"solid\"];"
+  arr = if digr then " -> " else " -- "
+
+prGraph digr ns = concat $ map (++"\n") $ [graph ++ "{\n"] ++ ns ++ ["}"] where
+  graph = if digr then "digraph" else "graph"