diff --git a/GF.cabal b/GF.cabal index 14ca06fe0..3df470d39 100644 --- a/GF.cabal +++ b/GF.cabal @@ -52,6 +52,7 @@ library PGF.Binary PGF.Morphology PGF.ShowLinearize + PGF.VisualizeTree GF.Data.MultiMap GF.Data.TrieMap GF.Data.Utilities diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs index d182b65ba..c8ea292f3 100644 --- a/src/GF/Command/Commands.hs +++ b/src/GF/Command/Commands.hs @@ -15,10 +15,10 @@ module GF.Command.Commands ( import PGF import PGF.CId import PGF.ShowLinearize +import PGF.VisualizeTree import PGF.Macros import PGF.Data ---- import PGF.Morphology -import PGF.VisualizeTree import GF.Compile.Export import GF.Infra.Option (noOptions, readOutputFormat, Encoding(..)) import GF.Infra.UseIO @@ -146,7 +146,7 @@ allCommands cod env@(pgf, mos) = Map.fromList [ "flag -format." ], exec = \opts es -> do - let grph = if null es then [] else alignLinearize pgf (head es) + let grph = if null es then [] else graphvizAlignment pgf (head es) if isFlag "view" opts || isFlag "format" opts then do let file s = "_grph." ++ s let view = optViewGraph opts ++ " " @@ -592,7 +592,7 @@ allCommands cod env@(pgf, mos) = Map.fromList [ "" -> return Nothing _ -> readFile file >>= return . Just . getDepLabels . lines let lang = optLang opts - let grphs = unlines $ map (dependencyTree outp debug mlab Nothing pgf lang) es + let grphs = unlines $ map (graphvizDependencyTree outp debug mlab Nothing pgf lang) es if isFlag "view" opts || isFlag "format" opts then do let file s = "_grphd." ++ s let view = optViewGraph opts ++ " " @@ -631,7 +631,7 @@ allCommands cod env@(pgf, mos) = Map.fromList [ ], exec = \opts es -> do let lang = optLang opts - let grph = if null es then [] else parseTree Nothing pgf lang (head es) + let grph = if null es then [] else graphvizParseTree pgf lang (head es) if isFlag "view" opts || isFlag "format" opts then do let file s = "_grph." ++ s let view = optViewGraph opts ++ " " @@ -667,7 +667,7 @@ allCommands cod env@(pgf, mos) = Map.fromList [ exec = \opts es -> do let funs = not (isOpt "nofun" opts) let cats = not (isOpt "nocat" opts) - let grph = visualizeTrees pgf (funs,cats) es -- True=digraph + let grph = unlines (map (graphvizAbstractTree pgf (funs,cats)) es) -- True=digraph if isFlag "view" opts || isFlag "format" opts then do let file s = "_grph." ++ s let view = optViewGraph opts ++ " " diff --git a/src/PGF.hs b/src/PGF.hs index 81e6d5024..1345c027d 100644 --- a/src/PGF.hs +++ b/src/PGF.hs @@ -82,7 +82,13 @@ module PGF( -- ** Morphological Analysis Lemma, Analysis, Morpho, - lookupMorpho, buildMorpho + lookupMorpho, buildMorpho, + + -- ** Visualizations + graphvizAbstractTree, + graphvizParseTree, + graphvizDependencyTree, + graphvizAlignment ) where import PGF.CId @@ -90,6 +96,7 @@ import PGF.Linearize import PGF.Generate import PGF.TypeCheck import PGF.Paraphrase +import PGF.VisualizeTree import PGF.Macros import PGF.Expr (Tree) import PGF.Morphology diff --git a/src/PGF/VisualizeTree.hs b/src/PGF/VisualizeTree.hs index 4919f00f7..bd419e14f 100644 --- a/src/PGF/VisualizeTree.hs +++ b/src/PGF/VisualizeTree.hs @@ -15,9 +15,14 @@ -- instead of rolling its own. ----------------------------------------------------------------------------- -module PGF.VisualizeTree ( visualizeTrees, parseTree, dependencyTree, getDepLabels, - alignLinearize, PosText(..), readPosText - ) where +module PGF.VisualizeTree ( graphvizAbstractTree + , graphvizParseTree + , graphvizDependencyTree + , graphvizAlignment + + , getDepLabels + , PosText(..), readPosText + ) where import PGF.CId (CId,showCId,pCId,mkCId) import PGF.Data @@ -32,8 +37,8 @@ import qualified Text.ParserCombinators.ReadP as RP import Debug.Trace -visualizeTrees :: PGF -> (Bool,Bool) -> [Expr] -> String -visualizeTrees pgf funscats = unlines . map (prGraph False . tree2graph pgf funscats . expr2tree) +graphvizAbstractTree :: PGF -> (Bool,Bool) -> Expr -> String +graphvizAbstractTree pgf funscats = prGraph False . tree2graph pgf funscats . expr2tree tree2graph :: PGF -> (Bool,Bool) -> Tree -> [String] tree2graph pgf (funs,cats) = prf [] where @@ -60,8 +65,8 @@ prGraph digr ns = concat $ map (++"\n") $ [graph ++ "{\n"] ++ ns ++ ["}"] where -- dependency trees from Linearize.linearizeMark -dependencyTree :: String -> Bool -> Maybe Labels -> Maybe String -> PGF -> CId -> Expr -> String -dependencyTree format debug mlab ms pgf lang exp = case format of +graphvizDependencyTree :: String -> Bool -> Maybe Labels -> Maybe String -> PGF -> CId -> Expr -> String +graphvizDependencyTree format debug mlab ms pgf lang exp = case format of "malt" -> unlines (lin2dep format) "malt_input" -> unlines (lin2dep format) _ -> prGraph True (lin2dep format) @@ -158,8 +163,8 @@ getDepLabels ss = Map.fromList [(mkCId f,ls) | f:ls <- map words ss] -- parse trees from Linearize.linearizeMark ---- nubrec and domins are quadratic, but could be (n log n) -parseTree :: Maybe String -> PGF -> CId -> Expr -> String -parseTree ms pgf lang = prGraph False . lin2tree pgf . linMark where +graphvizParseTree :: PGF -> CId -> Expr -> String +graphvizParseTree pgf lang = prGraph False . lin2tree pgf . linMark where linMark = head . linearizesMark pgf lang ---- use Just str if you have str to match against @@ -209,8 +214,8 @@ mtag = tag . ('n':) . uncommas -- word alignments from Linearize.linearizesMark -- words are chunks like {[0,1,1,0] old} -alignLinearize :: PGF -> Expr -> String -alignLinearize pgf = prGraph True . lin2graph . linsMark where +graphvizAlignment :: PGF -> Expr -> String +graphvizAlignment pgf = prGraph True . lin2graph . linsMark where linsMark t = [s | la <- cncnames pgf, s <- take 1 (linearizesMark pgf la t)] lin2graph :: [String] -> [String]