diff options
| -rw-r--r-- | src-3.0/GF/Command/Abstract.hs | 3 | ||||
| -rw-r--r-- | src-3.0/GF/Command/Commands.hs | 35 | ||||
| -rw-r--r-- | src-3.0/PGF/VisualizeTree.hs | 42 |
3 files changed, 80 insertions, 0 deletions
diff --git a/src-3.0/GF/Command/Abstract.hs b/src-3.0/GF/Command/Abstract.hs index b26499d54..23f76fa82 100644 --- a/src-3.0/GF/Command/Abstract.hs +++ b/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 ---- diff --git a/src-3.0/GF/Command/Commands.hs b/src-3.0/GF/Command/Commands.hs index 27c8e5fb4..04c47413a 100644 --- a/src-3.0/GF/Command/Commands.hs +++ b/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 diff --git a/src-3.0/PGF/VisualizeTree.hs b/src-3.0/PGF/VisualizeTree.hs new file mode 100644 index 000000000..1bf4dc075 --- /dev/null +++ b/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" |