forked from GitHub/gf-core
disambiguation in Phrasebook: show Eng instead of AST if DisambL is missing; show all alternative disambiguations for each alternative translation
This commit is contained in:
@@ -16,7 +16,7 @@ import Control.Exception
|
|||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Data.Char
|
import Data.Char
|
||||||
import Data.Function (on)
|
import Data.Function (on)
|
||||||
import Data.List (sortBy)
|
import Data.List (sortBy,intersperse)
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import System.Directory
|
import System.Directory
|
||||||
@@ -133,8 +133,8 @@ doTranslateGroup pgf input mcat mfrom mto =
|
|||||||
[toJSObject [("from", showJSON (langOnly (PGF.showLanguage from))),
|
[toJSObject [("from", showJSON (langOnly (PGF.showLanguage from))),
|
||||||
("to", showJSON (langOnly (PGF.showLanguage to))),
|
("to", showJSON (langOnly (PGF.showLanguage to))),
|
||||||
("linearizations",showJSON
|
("linearizations",showJSON
|
||||||
[toJSObject (("text", doText (doBind alt)) : disamb lg from t) |
|
[toJSObject (("text", doText (doBind alt)) : disamb lg from ts) |
|
||||||
(t,alt) <- output, let lg = length output])
|
(ts,alt) <- output, let lg = length output])
|
||||||
]
|
]
|
||||||
|
|
|
|
||||||
(from,trees) <- parse' pgf input mcat mfrom,
|
(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
|
groupResults = Map.toList . foldr more Map.empty . start . collect
|
||||||
where
|
where
|
||||||
collect tls = [(t,(l,s)) | (t,ls) <- tls, (l,s) <- ls, notDisamb l]
|
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) =
|
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
|
doBind = unwords . bind . words
|
||||||
doText s = case s of
|
doText s = case s of
|
||||||
c:cs | elem (last s) ".?!" -> toUpper c : init (init cs) ++ [last s]
|
c:cs | elem (last s) ".?!" -> toUpper c : init (init cs) ++ [last s]
|
||||||
@@ -158,15 +164,24 @@ doTranslateGroup pgf input mcat mfrom mto =
|
|||||||
_ -> ws
|
_ -> ws
|
||||||
langOnly = reverse . take 3 . reverse
|
langOnly = reverse . take 3 . reverse
|
||||||
|
|
||||||
disamb lg from t =
|
disamb lg from ts =
|
||||||
if lg < 2
|
if lg < 2
|
||||||
then []
|
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
|
groupDisambs = unwords . intersperse "/"
|
||||||
if elem disf (PGF.languages pgf)
|
|
||||||
then PGF.linearize pgf disf t
|
disambLang f t =
|
||||||
else PGF.showExpr [] 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
|
notDisamb = (/="Disamb") . take 6 . PGF.showLanguage
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user