GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-20 18:29:33 -06:00
Code Issues Packages Projects Releases Wiki Activity

PGF service & minibar: put a limit on the number of parse trees

Browse Source 
+ In the PGF web service API, the commands parse, translate and translategroup
  now accept a limit parameter. It limits the number of parse trees returned.
  If no limit is given, the behaviour is backwards compatible, i.e. no limit
  is applied.
+ In minibar, the limit is now set to 25 by default.

This change is based on a suggestion by Kaarel Kaljurand.
This commit is contained in:
hallgren
2012-09-30 15:35:25 +00:00
parent 26cb037a78
commit fc09b7e604
3 changed files with 20 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
src/server/PGFService.hs
View File

@@ -56,14 +56,14 @@ cgiMain' cache path =
pgfMain :: PGF -> String -> CGI CGIResult
pgfMain pgf command =
case command of
"parse" -> outputJSONP =<< doParse pgf `fmap` getText `ap` getCat `ap` getFrom
"parse" -> outputJSONP =<< doParse pgf `fmap` getText `ap` getCat `ap` getFrom `ap` getLimit
"complete" -> outputJSONP =<< doComplete pgf `fmap` getText `ap` getCat `ap` getFrom `ap` getLimit
"linearize" -> outputJSONP =<< doLinearize pgf `fmap` getTree `ap` getTo
"linearizeAll" -> outputJSONP =<< doLinearizes pgf `fmap` getTree `ap` getTo
"random" -> getCat >>= \c -> getDepth >>= \dp -> getLimit >>= \l -> getTo >>= \to -> liftIO (doRandom pgf c dp l to) >>= outputJSONP
"generate" -> outputJSONP =<< doGenerate pgf `fmap` getCat `ap` getDepth `ap` getLimit `ap` getTo
"translate" -> outputJSONP =<< doTranslate pgf `fmap` getText `ap` getCat `ap` getFrom `ap` getTo
"translategroup" -> outputJSONP =<< doTranslateGroup pgf `fmap` getText `ap` getCat `ap` getFrom `ap` getTo
"translate" -> outputJSONP =<< doTranslate pgf `fmap` getText `ap` getCat `ap` getFrom `ap` getTo `ap` getLimit
"translategroup" -> outputJSONP =<< doTranslateGroup pgf `fmap` getText `ap` getCat `ap` getFrom `ap` getTo `ap` getLimit
"grammar" -> outputJSONP =<< doGrammar pgf `fmap` requestAcceptLanguage
"abstrtree" -> outputGraphviz . abstrTree pgf =<< getTree
"alignment" -> outputGraphviz . alignment pgf =<< getTree
@@ -159,8 +159,8 @@ doExternal (Just cmd) input =
liftIO $ removeFile tmpfile2
return r
doTranslate :: PGF -> String -> Maybe PGF.Type -> Maybe PGF.Language -> Maybe PGF.Language -> JSValue
doTranslate pgf input mcat mfrom mto =
doTranslate :: PGF -> String -> Maybe PGF.Type -> Maybe PGF.Language -> Maybe PGF.Language -> Maybe Int -> JSValue
doTranslate pgf input mcat mfrom mto mlimit =
showJSON
[makeObj ("from".=from : "brackets".=bs : jsonTranslateOutput po)
| (from,po,bs) <- parse' pgf input mcat mfrom]
@@ -173,7 +173,7 @@ doTranslate pgf input mcat mfrom mto =
"linearizations".=
[makeObj ["to".=to, "text".=text, "brackets".=bs]
| (to,text,bs)<- linearizeAndBind pgf mto tree]]
| tree <- trees]]
| tree <- maybe id take mlimit trees]]
PGF.ParseIncomplete -> ["incomplete".=True]
PGF.ParseFailed n -> ["parseFailed".=n]
PGF.TypeError errs -> jsonTypeErrors errs
@@ -183,8 +183,8 @@ jsonTypeErrors errs =
| (fid,err) <- errs]]
-- used in phrasebook
doTranslateGroup :: PGF -> String -> Maybe PGF.Type -> Maybe PGF.Language -> Maybe PGF.Language -> JSValue
doTranslateGroup pgf input mcat mfrom mto =
doTranslateGroup :: PGF -> String -> Maybe PGF.Type -> Maybe PGF.Language -> Maybe PGF.Language -> Maybe Int -> JSValue
doTranslateGroup pgf input mcat mfrom mto mlimit =
showJSON
[makeObj ["from".=langOnly (PGF.showLanguage from),
"to".=langOnly (PGF.showLanguage to),
@@ -194,7 +194,7 @@ doTranslateGroup pgf input mcat mfrom mto =
]
|
(from,po,bs) <- parse' pgf input mcat mfrom,
(to,output) <- groupResults [(t, linearize' pgf mto t) | t <- case po of {PGF.ParseOk ts -> ts; _ -> []}]
(to,output) <- groupResults [(t, linearize' pgf mto t) | t <- case po of {PGF.ParseOk ts -> maybe id take mlimit ts; _ -> []}]
]
where
groupResults = Map.toList . foldr more Map.empty . start . collect
@@ -240,14 +240,14 @@ doTranslateGroup pgf input mcat mfrom mto =
notDisamb = (/="Disamb") . take 6 . PGF.showLanguage
doParse :: PGF -> String -> Maybe PGF.Type -> Maybe PGF.Language -> JSValue
doParse pgf input mcat mfrom = showJSON $ map makeObj
doParse :: PGF -> String -> Maybe PGF.Type -> Maybe PGF.Language -> Maybe Int -> JSValue
doParse pgf input mcat mfrom mlimit = showJSON $ map makeObj
["from".=from : "brackets".=bs : jsonParseOutput po
| (from,po,bs) <- parse' pgf input mcat mfrom]
where
jsonParseOutput output =
case output of
PGF.ParseOk trees -> ["trees".=trees]
PGF.ParseOk trees -> ["trees".=maybe id take mlimit trees]
PGF.TypeError errs -> jsonTypeErrors errs
PGF.ParseIncomplete -> ["incomlete".=True]
PGF.ParseFailed n -> ["parseFailed".=n]