PGF.groupResults and the option l -groups, to show ambiguities grouped by laguage

2 files changed, 19 insertions, 4 deletions

diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs
index 39561654f..6723c4b8f 100644
--- a/src/compiler/GF/Command/Commands.hs
+++ b/src/compiler/GF/Command/Commands.hs
@@ -386,10 +386,11 @@ allCommands cod env@(pgf, mos) = Map.fromList [
        "gr -lang=LangHin -cat=Cl | l -table -to_devanagari -to_utf8 -- hindi table",
        "l -unlexer=\"LangSwe=to_utf8 LangHin=to_devanagari,to_utf8\" -- different lexers"
        ],
-     exec = \opts -> return . fromStrings . map (optLin opts),
+     exec = \opts -> return . fromStrings . optLins opts,
      options = [
        ("all","show all forms and variants, one by line (cf. l -list)"),
        ("bracket","show tree structure with brackets and paths to nodes"),
+       ("groups","all languages, grouped by lang, remove duplicate strings"),
        ("list","show all forms and variants, comma-separated on one line (cf. l -all)"),
        ("multi","linearize to all languages (default)"),
        ("table","show all forms labelled by parameters"),
@@ -871,11 +872,17 @@ allCommands cod env@(pgf, mos) = Map.fromList [
  
    void = ([],[])
 
+   optLins opts ts = case opts of
+     _ | isOpt "groups" opts ->
+       map (unlines . snd) $ groupResults
+         [[(lang, linear opts lang t) | lang <- optLangs opts] | t <- ts]
+     _ -> map (optLin opts) ts 
    optLin opts t = unlines $ 
      case opts of 
-       _ | isOpt "treebank" opts -> (showCId (abstractName pgf) ++ ": " ++ showExpr [] t) :
-                                    [showCId lang ++ ": " ++ linear opts lang t | lang <- optLangs opts]
-       _                         -> [linear opts lang t | lang <- optLangs opts] 
+       _ | isOpt "treebank" opts -> 
+         (showCId (abstractName pgf) ++ ": " ++ showExpr [] t) :
+         [showCId lang ++ ": " ++ linear opts lang t | lang <- optLangs opts]
+       _  -> [linear opts lang t | lang <- optLangs opts] 
     
    linear :: [Option] -> CId -> Expr -> String
    linear opts lang = let unl = unlex opts lang in case opts of
diff --git a/src/runtime/haskell/PGF.hs b/src/runtime/haskell/PGF.hs
index 9cb23bf50..d27abd76c 100644
--- a/src/runtime/haskell/PGF.hs
+++ b/src/runtime/haskell/PGF.hs
@@ -51,6 +51,7 @@ module PGF(
            -- * Operations
            -- ** Linearization
            linearize, linearizeAllLang, linearizeAll,
+           groupResults, -- lins of trees by language, removing duplicates
            showPrintName,
 
            -- ** Parsing
@@ -239,6 +240,13 @@ linearizeAll mgr = map snd . linearizeAllLang mgr
 linearizeAllLang mgr t = 
   [(lang,PGF.linearize mgr lang t) | lang <- languages mgr]
 
+groupResults :: [[(Language,String)]] -> [(Language,[String])]
+groupResults = Map.toList . foldr more Map.empty . start . concat
+ where
+  start ls = [(l,[s]) | (l,s) <- ls]
+  more (l,s) = 
+    Map.insertWith (\ [x] xs -> if elem x xs then xs else (x : xs)) l s
+
 parseAll mgr typ = map snd . parseAllLang mgr typ
 
 parseAllLang mgr typ s =