From 5fe680c8376a425a8cbf15e4cd9340e2b9f398f2 Mon Sep 17 00:00:00 2001 From: hallgren Date: Wed, 24 Apr 2013 18:32:53 +0000 Subject: [PATCH] PGF service: apply the token binding operator &+ to all linearizations The &+ operator is now consistently eliminated from the output of commmands that produce linearizations. Before, only the commands translate and translategroup did this. --- src/server/PGFService.hs | 62 +++++++++++++++++----------------------- 1 file changed, 26 insertions(+), 36 deletions(-) diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs index 24152ca53..5b1f65448 100644 --- a/src/server/PGFService.hs +++ b/src/server/PGFService.hs @@ -218,12 +218,12 @@ doTranslateGroup pgf input mcat mfrom tos mlimit = [makeObj ["from".=langOnly (PGF.showLanguage from), "to".=langOnly (PGF.showLanguage to), "linearizations".= - [toJSObject (("text", doText (doBind alt)) : disamb lg from ts) + [toJSObject (("text", doText alt) : disamb lg from ts) | (ts,alt) <- output, let lg = length output] ] | (from,po,bs) <- parse' pgf input mcat mfrom, - (to,output) <- groupResults [(t, linearize' pgf tos t) | t <- case po of {PGF.ParseOk ts -> maybe id take mlimit ts; _ -> []}] + (to,output) <- groupResults [(t, linearizeAndBind pgf tos t) | t <- case po of {PGF.ParseOk ts -> maybe id take mlimit ts; _ -> []}] ] where groupResults = Map.toList . foldr more Map.empty . start . collect @@ -237,21 +237,16 @@ doTranslateGroup pgf input mcat mfrom tos mlimit = 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] _ -> s - bind ws = case ws of - w : "&+" : u : ws2 -> bind ((w ++ u) : ws2) - "&+":ws2 -> bind ws2 - w : ws2 -> w : bind ws2 - _ -> ws + langOnly = reverse . take 3 . reverse disamb lg from ts = if lg < 2 then [] - else [("tree", "-- " ++ groupDisambs [doText (doBind (disambLang from t)) | t <- ts])] + else [("tree", "-- " ++ groupDisambs [doText (disambLang from t) | t <- ts])] groupDisambs = unwords . intersperse "/" @@ -292,12 +287,18 @@ doComplete pgf input mcat mfrom mlimit = showJSON doLinearize :: PGF -> PGF.Tree -> [PGF.Language] -> JSValue doLinearize pgf tree tos = showJSON [makeObj ["to".=to, "text".=text,"brackets".=bs] - | (to,text,bs) <- linearize' pgf tos tree] + | (to,text,bs) <- linearizeAndBind pgf tos tree] doLinearizes :: PGF -> PGF.Tree -> [PGF.Language] -> JSValue doLinearizes pgf tree tos = showJSON - [makeObj ["to".=to, "texts".=texts] + [makeObj ["to".=to, "texts".=map doBind texts] | (to,texts) <- linearizes' pgf tos tree] + where + linearizes' pgf tos tree = + [(to,lins to (transfer to tree)) | to <- langs] + where + langs = if null tos then PGF.languages pgf else tos + lins to = nub . concatMap (map snd) . PGF.tabularLinearizes pgf to doLinearizeTabular :: PGF -> PGF.Tree -> [PGF.Language] -> JSValue doLinearizeTabular pgf tree tos = showJSON @@ -322,7 +323,7 @@ doGenerate pgf mcat mdepth mlimit tos = showJSON [makeObj ["tree".=PGF.showExpr [] tree, "linearizations".= [makeObj ["to".=to, "text".=text] - | (to,text,bs) <- linearize' pgf tos tree]] + | (to,text,bs) <- linearizeAndBind pgf tos tree]] | tree <- limit trees] where trees = PGF.generateAllDepth pgf cat (Just depth) @@ -567,26 +568,10 @@ complete' pgf from typ mlimit input = Left es -> (ps,w:ws) Right ps -> loop ps ws -linearize' :: PGF -> [PGF.Language] -> PGF.Tree -> [(PGF.Language,String,PGF.BracketedString)] -linearize' pgf to tree = - [(to,s,bs) | to<-langs, - let bs = PGF.bracketedLinearize pgf to (transfer to tree) - s = unwords $ PGF.flattenBracketedString bs] - where - langs = if null to then PGF.languages pgf else to - transfer lang = if "LaTeX" `isSuffixOf` show lang then fold -- OpenMath LaTeX transfer else id --- | list all variants and their forms -linearizes' :: PGF -> [PGF.Language] -> PGF.Tree -> [(PGF.Language,[String])] -linearizes' pgf tos tree = - [(to,lins to (transfer to tree)) | to <- langs] - where - langs = if null tos then PGF.languages pgf else tos - lins to = nub . concatMap (map snd) . PGF.tabularLinearizes pgf to - -- | tabulate all variants and their forms linearizeTabular :: PGF -> [PGF.Language] -> PGF.Tree -> [(PGF.Language,[(String,[String])])] @@ -594,19 +579,24 @@ linearizeTabular pgf tos tree = [(to,lintab to (transfer to tree)) | to <- langs] where langs = if null tos then PGF.languages pgf else tos - lintab to t = [(p,nub [t|(p',t)<-vs,p'==p])|p<-ps] + lintab to t = [(p,map doBind (nub [t|(p',t)<-vs,p'==p]))|p<-ps] where ps = nub (map fst vs) vs = concat (PGF.tabularLinearizes pgf to t) -linearizeAndBind pgf mto t = - [(la, binds s,bs) | (la,s,bs) <- linearize' pgf mto t] +linearizeAndBind pgf mto tree = + [(to,s,bs) | to<-langs, + let bs = PGF.bracketedLinearize pgf to (transfer to tree) + s = unwords . bind $ PGF.flattenBracketedString bs] where - binds = unwords . bs . words - bs ws = case ws of - u:"&+":v:ws2 -> bs ((u ++ v):ws2) - u:ws2 -> u : bs ws2 - _ -> [] + langs = if null mto then PGF.languages pgf else mto + +doBind = unwords . bind . words +bind ws = case ws of + w : "&+" : u : ws2 -> bind ((w ++ u) : ws2) + "&+":ws2 -> bind ws2 + w : ws2 -> w : bind ws2 + _ -> ws selectLanguage :: PGF -> Maybe (Accept Language) -> PGF.Language selectLanguage pgf macc = case acceptable of