From dc00e7ea3aa652cad4e3513ef6057a6d5e9a16ca Mon Sep 17 00:00:00 2001
From: aarne <aarne@chalmers.se>
Date: Fri, 28 May 2010 03:40:35 +0000
Subject: [PATCH] disambiguation in Phrasebook: show Eng instead of AST if
 DisambL is missing; show all alternative disambiguations for each alternative
 translation

---
 src/server/PGFService.hs | 37 ++++++++++++++++++++++++++-----------
 1 file changed, 26 insertions(+), 11 deletions(-)

diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs
index 900e3f7cd..a969cdd75 100644
--- a/src/server/PGFService.hs
+++ b/src/server/PGFService.hs
@@ -16,7 +16,7 @@ import Control.Exception
 import Control.Monad
 import Data.Char
 import Data.Function (on)
-import Data.List (sortBy)
+import Data.List (sortBy,intersperse)
 import qualified Data.Map as Map
 import Data.Maybe
 import System.Directory
@@ -133,8 +133,8 @@ doTranslateGroup pgf input mcat mfrom mto =
      [toJSObject [("from",          showJSON (langOnly (PGF.showLanguage from))),
                   ("to",            showJSON (langOnly (PGF.showLanguage to))),
                   ("linearizations",showJSON 
-                      [toJSObject (("text", doText (doBind alt)) : disamb lg from t) | 
-                                                (t,alt) <- output, let lg = length output])
+                      [toJSObject (("text", doText (doBind alt)) : disamb lg from ts) | 
+                                             (ts,alt) <- output, let lg = length output])
                  ]
         | 
           (from,trees) <- parse' pgf input mcat mfrom,
@@ -144,9 +144,15 @@ doTranslateGroup pgf input mcat mfrom mto =
    groupResults = Map.toList . foldr more Map.empty . start . collect
      where
        collect tls = [(t,(l,s)) | (t,ls) <- tls, (l,s) <- ls, notDisamb l]
-       start ls = [(l,[(t,s)]) | (t,(l,s)) <- ls]
+       start ls = [(l,[([t],s)]) | (t,(l,s)) <- ls]
        more (l,s) = 
-         Map.insertWith (\ [(t,x)] xs -> if elem x (map snd xs) then xs else ((t,x) : xs)) l s
+         Map.insertWith (\ [([t],x)] xs -> insertAlt t x xs) l s
+
+   insertAlt t x xs = case xs of
+     (ts,y):xs2 -> if x==y then (t:ts,y):xs2        -- if string is there add only tree
+                   else (ts,y) : insertAlt t x xs2
+     _ -> [([t],x)]
+
    doBind = unwords . bind . words
    doText s = case s of
      c:cs | elem (last s) ".?!" -> toUpper c : init (init cs) ++ [last s]
@@ -158,15 +164,24 @@ doTranslateGroup pgf input mcat mfrom mto =
          _ -> ws
    langOnly = reverse . take 3 . reverse
 
-   disamb lg from t = 
+   disamb lg from ts = 
      if lg < 2 
        then [] 
-       else [("tree", "-- " ++ doText (doBind (disambLang from t)))]
+       else [("tree", "-- " ++ groupDisambs [doText (doBind (disambLang from t)) | t <- ts])]
 
-   disambLang f t = let disf = PGF.mkCId ("Disamb" ++ PGF.showLanguage f) in
-     if elem disf (PGF.languages pgf) 
-       then PGF.linearize pgf disf t 
-       else PGF.showExpr [] t
+   groupDisambs = unwords . intersperse "/"
+
+   disambLang f t = 
+     let 
+       disfl lang = PGF.mkCId ("Disamb" ++ lang) 
+       disf       = disfl (PGF.showLanguage f) 
+       disfEng    = disfl (reverse (drop 3 (reverse (PGF.showLanguage f))) ++ "Eng") 
+     in
+       if elem disf (PGF.languages pgf)         -- if Disamb f exists use it
+         then PGF.linearize pgf disf t          
+       else if elem disfEng (PGF.languages pgf) -- else try DisambEng
+         then PGF.linearize pgf disfEng t 
+       else "AST " ++ PGF.showExpr [] t                   -- else show abstract tree
 
    notDisamb = (/="Disamb") . take 6 . PGF.showLanguage