From 747287055fd78be58c273d096bbc11b27ed310f1 Mon Sep 17 00:00:00 2001 From: john Date: Fri, 11 Jul 2014 09:25:26 +0000 Subject: [PATCH] PGF web service: Return additional completion info with 'full' flag BETA! The 'complete' command now has a new flag 'full' which when set returns additional info about completions. Without 'full' flag (default): [ { "from": "PhrasebookEng", "brackets": { "cat": "_", "fid": 0, "index": 0, "fun": "_", "children": [ { "token": "the" } ] }, "text": "su", "completions": [ "supermarket", "suspect" ] } ] With full=true or full=yes: [ { "from": "PhrasebookEng", "brackets": { "cat": "_", "fid": 0, "index": 0, "fun": "_", "children": [ { "token": "the" } ] }, "text": "su", "completions": [ { "token": "supermarket", "funs": [ { "fid": 421, "fun": "Supermarket", "hyps": [], "cat": "PlaceKind" } ] }, { "token": "suspect", "funs": [ { "fid": 445, "fun": "Suspect", "hyps": [], "cat": "Property" } ] } ] } ] --- src/runtime/haskell/PGF.hs | 1 + src/runtime/haskell/PGF/Parse.hs | 12 ++++++++++ src/server/PGFService.hs | 41 +++++++++++++++++++++++++------- 3 files changed, 46 insertions(+), 8 deletions(-) diff --git a/src/runtime/haskell/PGF.hs b/src/runtime/haskell/PGF.hs index c1d903f4f..77eac1ada 100644 --- a/src/runtime/haskell/PGF.hs +++ b/src/runtime/haskell/PGF.hs @@ -88,6 +88,7 @@ module PGF( Parse.initState, Parse.nextState, Parse.getCompletions, Parse.recoveryStates, Parse.ParseInput(..), Parse.simpleParseInput, Parse.mkParseInput, Parse.ParseOutput(..), Parse.getParseOutput, + Parse.getContinuationInfo, -- ** Generation -- | The PGF interpreter allows automatic generation of diff --git a/src/runtime/haskell/PGF/Parse.hs b/src/runtime/haskell/PGF/Parse.hs index 0ab1ad9fb..ad31cc25f 100644 --- a/src/runtime/haskell/PGF/Parse.hs +++ b/src/runtime/haskell/PGF/Parse.hs @@ -10,6 +10,7 @@ module PGF.Parse , ParseOutput(..), getParseOutput , parse , parseWithRecovery + , getContinuationInfo ) where import Data.Array.IArray @@ -503,6 +504,17 @@ data Chart type Continuation = TrieMap.TrieMap Token ActiveSet +-- | Return the Continuation of a Parsestate with exportable types +-- Used by PGFService +getContinuationInfo :: ParseState -> Map.Map [Token] [(FunId, CId)] +getContinuationInfo pstate = Map.map (map f . Set.toList) contMap + where + PState abstr concr chart cont = pstate + contMap = Map.fromList (TrieMap.toList cont) -- always get [([], _::ActiveSet)] + f :: Active -> (FunId,CId) + f (Active int dotpos funid seqid pargs ak) = (funid, cid) + where CncFun cid _ = cncfuns concr ! funid + ---------------------------------------------------------------- -- Error State ---------------------------------------------------------------- diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs index c7518e19e..854f70936 100644 --- a/src/server/PGFService.hs +++ b/src/server/PGFService.hs @@ -312,7 +312,7 @@ unlexer = maybe (return id) unlexerfun =<< getInput "unlexer" pgfMain command (t,pgf) = case command of "parse" -> o =<< doParse pgf # input % cat % limit % trie - "complete" -> o =<< doComplete pgf # input % cat % limit + "complete" -> o =<< doComplete pgf # input % cat % limit % full "linearize" -> o =<< doLinearize pgf # tree % to "linearizeAll" -> o =<< doLinearizes pgf # tree % to "linearizeTable" -> o =<< doLinearizeTabular pgf # tree % to @@ -405,6 +405,9 @@ pgfMain command (t,pgf) = Just lang | lang `elem` PGF.languages pgf -> return lang | otherwise -> badRequest "Unknown language" l + full :: CGI Bool + full = maybe False toBool # getInput "full" + -- * Request parameter access and related auxiliary functions --out = outputJSONP @@ -574,14 +577,36 @@ doParse pgf (mfrom,input) mcat mlimit trie = showJSON $ map makeObj addTrie trie trees = ["trie".=map head (PGF.toTrie (map PGF.toATree trees))|trie] -doComplete :: PGF -> From -> Maybe PGF.Type -> Maybe Int -> JSValue -doComplete pgf (mfrom,input) mcat mlimit = showJSON - [makeObj ["from".=from, "brackets".=bs, "completions".=cs, "text".=s] - | from <- froms, let (bs,s,cs) = complete' pgf from cat mlimit input] +doComplete :: PGF -> From -> Maybe PGF.Type -> Maybe Int -> Bool -> JSValue +doComplete pgf (mfrom,input) mcat mlimit full = showJSON + [makeObj ( + ["from".=from, "brackets".=bs, "text".=s] ++ + if full + then [ "completions" .= Map.elems (Map.mapWithKey (completionInfo pgf) cs) ] + else [ "completions" .= Map.keys cs ] + ) + | from <- froms, let (bs,s,cs) = complete' pgf from cat mlimit input] where froms = maybe (PGF.languages pgf) (:[]) mfrom cat = fromMaybe (PGF.startCat pgf) mcat +completionInfo :: PGF -> PGF.Token -> PGF.ParseState -> JSValue +completionInfo pgf token pstate = + makeObj + ["token".= token + ,"funs" .= (nub (map mkFun funs)) + ] + where + contInfo = PGF.getContinuationInfo pstate + funs = snd . head $ Map.toList contInfo -- always get [([],_)] ; funs :: [(fid,cid)] + mkFun (funid,cid) = case PGF.functionType pgf cid of + Just typ -> + makeObj [ "fid".=funid, "fun".=cid, "hyps".=hyps', "cat".=cat ] + where + (hyps,cat,es) = PGF.unType typ + hyps' = [ PGF.showType [] typ | (_,_,typ) <- hyps ] + Nothing -> makeObj [] -- shouldn't happen + doLinearize :: PGF -> PGF.Tree -> To -> JSValue doLinearize pgf tree (tos,unlex) = showJSON [makeObj ["to".=to, "text".=unlex text,"brackets".=bs] @@ -853,15 +878,15 @@ parse' pgf input mcat mfrom = cat = fromMaybe (PGF.startCat pgf) mcat complete' :: PGF -> PGF.Language -> PGF.Type -> Maybe Int -> String - -> (PGF.BracketedString, String, [String]) + -> (PGF.BracketedString, String, Map.Map PGF.Token PGF.ParseState) complete' pgf from typ mlimit input = let (ws,prefix) = tokensAndPrefix input ps0 = PGF.initState pgf from typ (ps,ws') = loop ps0 ws bs = snd (PGF.getParseOutput ps typ Nothing) in if not (null ws') - then (bs, unwords (if null prefix then ws' else ws'++[prefix]), []) - else (bs, prefix, maybe id take mlimit $ order $ Map.keys (PGF.getCompletions ps prefix)) + then (bs, unwords (if null prefix then ws' else ws'++[prefix]), Map.empty) + else (bs, prefix, PGF.getCompletions ps prefix) where order = sortBy (compare `on` map toLower)