PGF web service: add lexer support

The PGF web API commands parse, translate, translategroup, c-parse and
c-translate now support a lexer parameter. Possible values are "text",
"code" and "mixed".

This is used in the Wide Coverage Demo App to save one server roundtrip.

src/server/PGFService.hs

@@ -5,6 +5,7 @@ module PGFService(cgiMain,cgiMain',getPath,
 
 import PGF (PGF)
 import qualified PGF
+import PGF.Lexing
 import Cache
 import FastCGIUtils
 import URLEncoding
@@ -89,9 +90,9 @@ cgiMain' cache path =
 cpgfMain :: String -> (C.PGF,MVar ParseCache) -> CGI CGIResult
 cpgfMain command (pgf,pc) =
   case command of
-    "c-parse"     -> out =<< join (parse # input % from % start % limit % trie)
+    "c-parse"     -> out =<< join (parse#lexer%input%from%start%limit%trie)
     "c-linearize" -> out =<< lin # tree % to
-    "c-translate" -> out =<< join (trans # input % from % to % start % limit % trie)
+    "c-translate" -> out =<< join (trans#lexer%input%from%to%start%limit%trie)
     "c-flush"     -> out =<< flush
     "c-grammar"   -> out grammar
     _             -> badRequest "Unknown command" command
@@ -107,8 +108,8 @@ cpgfMain command (pgf,pc) =
       where
         languages = [makeObj ["name".= l] | (l,_)<-Map.toList (C.languages pgf)]
 
-    parse input (from,concr) start mlimit trie =
+    parse lexer input (from,concr) start mlimit trie =
-        do r <- parse' input (from,concr) start mlimit
+        do r <- parse' (lexer input) (from,concr) start mlimit
            return $ showJSON [makeObj ("from".=from:jsonParseResult r)]
 
     jsonParseResult = either bad good
@@ -135,8 +136,8 @@ cpgfMain command (pgf,pc) =
     lin tree tos = showJSON (lin' tree tos)
     lin' tree tos = [makeObj ["to".=to,"text".=C.linearize c tree]|(to,c)<-tos]
 
-    trans input (from,concr) tos start mlimit trie =
+    trans lexer input (from,concr) tos start mlimit trie =
-      do parses <- parse' input (from,concr) start mlimit
+      do parses <- parse' (lexer input) (from,concr) start mlimit
          return $
            showJSON [ makeObj ["from".=from,
                                "translations".= jsonParses parses]]
@@ -165,6 +166,16 @@ cpgfMain command (pgf,pc) =
     tree = do s <- maybe (missing "tree") return =<< getInput1 "tree"
               let t = C.readExpr s
               maybe (badRequest "bad tree" s) return t
+
+lexer = maybe (return id) lexerfun =<< getInput "lexer" 
+  where
+    lexerfun name =
+       case name of
+         "text" -> return (unwords . lexText)
+         "code" -> return (unwords . lexCode)
+         "mixed" -> return (unwords . lexMixed)
+         _ -> throwCGIError 400 "Unknown lexer" ["Unknown lexer: "++name]
+
 {-
 instance JSON C.CId where
     readJSON x = readJSON x >>= maybe (fail "Bad language.") return . C.readCId
@@ -182,15 +193,15 @@ instance JSON C.Expr where
 pgfMain :: String -> PGF -> CGI CGIResult
 pgfMain command pgf =
     case command of
-      "parse"          -> out =<< doParse pgf # input % cat % from % limit % trie
+      "parse"          -> out =<< parse#lexer%input%cat%from%limit%trie
       "complete"       -> out =<< doComplete pgf # input % cat % from % limit
       "linearize"      -> out =<< doLinearize pgf # tree % to
       "linearizeAll"   -> out =<< doLinearizes pgf # tree % to
       "linearizeTable" -> out =<< doLinearizeTabular pgf # tree % to
       "random"         -> cat >>= \c -> depth >>= \dp -> limit >>= \l -> to >>= \to -> liftIO (doRandom pgf c dp l to) >>= out
       "generate"       -> out =<< doGenerate pgf # cat % depth % limit % to
-      "translate"      -> out =<< doTranslate pgf # input % cat % from % to % limit % trie
+      "translate"      -> out =<< trans#lexer%input%cat%from%to%limit%trie
-      "translategroup" -> out =<< doTranslateGroup pgf # input % cat % from % to % limit
+      "translategroup" -> out =<< transgroup#lexer%input%cat%from%to%limit
       "grammar"        -> out =<< doGrammar pgf # requestAcceptLanguage
       "abstrtree"      -> outputGraphviz =<< abstrTree pgf # graphvizOptions % tree
       "alignment"      -> outputGraphviz =<< alignment pgf # tree % to
@@ -204,6 +215,10 @@ pgfMain command pgf =
                              doExternal cmd =<< input
       _                -> throwCGIError 400 "Unknown command" ["Unknown command: " ++ show command]
   where
+    parse lexer input = doParse pgf (lexer input)
+    trans lexer input = doTranslate pgf (lexer input)
+    transgroup lexer input = doTranslateGroup pgf (lexer input)
+
     tree :: CGI PGF.Tree
     tree = do ms <- getInput "tree"
               s <- maybe (throwCGIError 400 "No tree given" ["No tree given"]) return ms

src/www/js/gftranslate.js

@@ -20,7 +20,7 @@ gftranslate.translate=function(source,from,to,start,limit,cont) {
     function extract(result) { cont(result[0].translations) }
     if(encsrc.length<500)
 	gftranslate.call("?command=c-translate&input="+encsrc
-		      +"&from="+g+from+"&to="+g+to
+		      +"&lexer=text&from="+g+from+"&to="+g+to
 		      +"&start="+start+"&limit="+limit,extract)
     else cont([{error:"sentence too long"}])
 }

src/www/js/wc.js

@@ -124,7 +124,9 @@ wc.translate=function() {
 		if(wc.serial==current) {
 		    if(tra.length>=1) {
 			var r=tra[0]
-			if(r.error!=undefined) show_error(tra[0].error)
+			if(r.error!=undefined) {
+			    if(i==0 && rs.length==0) show_error(tra[0].error)
+			}
 			else if(r.linearizations) {
 			    r.t=trans_quality(r)
 			    unlextext(r.t.text,function(text){showit(r,text)})
@@ -135,7 +137,8 @@ wc.translate=function() {
 			}
 			else show_error("no linearizations")
 		    }
-		    else if(i==0) show_error("Unable to translate")
+		    else if(i==0 && rs.length==0)
+			show_error("Unable to translate")
 		}
 	    }
 	    gftranslate.translate(text,f.from.value,f.to.value,i,1,step3)
@@ -154,11 +157,13 @@ wc.translate=function() {
 	    }
 	    wc.pgf_online.translate({from:wc.cnl+f.from.value,
 				     to:wc.cnl+f.to.value,
-				     input:text},
+				     lexer:"text",input:text},
 				    step3cnl,
 				    function(){step2(text)})
 	}
-	lextext(is[si],wc.cnl ? step2cnl : step2)
+	//lextext(is[si],wc.cnl ? step2cnl : step2)
+	if(wc.cnl) step2cnl(is[si])
+	else step2(is[si])
     }
     wc.translating=f.input.value
     var is=wc.is=split_punct(wc.translating+"\n")