mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-24 03:52:50 -06:00
PGF Web Service: include entire completion in full mode
When using full=yes in the web service 'complete' command,
you now get an additional field 'seq' with the longest possible completion.
So, given:
lin
f1 = ss "the" ;
f2 = ss ("the red house" | "the real deal") ;
and trying to complete on input "th", you get:
[
{
"from": "TestCnc",
"brackets": {
"cat": "_",
"fid": 0,
"index": 0,
"fun": "_",
"children": []
},
"text": "th",
"completions": [
{
"token": "the",
"funs": [
{
"fun": "f1",
"hyps": [],
"cat": "C",
"seq": "the"
},
{
"fun": "f2",
"hyps": [],
"cat": "C",
"seq": "the red house"
},
{
"fun": "f2",
"hyps": [],
"cat": "C",
"seq": "the real deal"
}
]
}
]
}
]
This commit is contained in:
@@ -15,7 +15,7 @@ module PGF.Parse
|
|||||||
|
|
||||||
import Data.Array.IArray
|
import Data.Array.IArray
|
||||||
import Data.Array.Base (unsafeAt)
|
import Data.Array.Base (unsafeAt)
|
||||||
import Data.List (isPrefixOf, foldl')
|
import Data.List (isPrefixOf, foldl', intercalate)
|
||||||
import Data.Maybe (fromMaybe, maybeToList)
|
import Data.Maybe (fromMaybe, maybeToList)
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import qualified PGF.TrieMap as TrieMap
|
import qualified PGF.TrieMap as TrieMap
|
||||||
@@ -506,14 +506,26 @@ type Continuation = TrieMap.TrieMap Token ActiveSet
|
|||||||
|
|
||||||
-- | Return the Continuation of a Parsestate with exportable types
|
-- | Return the Continuation of a Parsestate with exportable types
|
||||||
-- Used by PGFService
|
-- Used by PGFService
|
||||||
getContinuationInfo :: ParseState -> Map.Map [Token] [(FunId, CId)]
|
getContinuationInfo :: ParseState -> Map.Map [Token] [(FunId, CId, String)]
|
||||||
getContinuationInfo pstate = Map.map (map f . Set.toList) contMap
|
getContinuationInfo pstate = Map.map (map f . Set.toList) contMap
|
||||||
where
|
where
|
||||||
PState abstr concr chart cont = pstate
|
PState abstr concr chart cont = pstate
|
||||||
contMap = Map.fromList (TrieMap.toList cont) -- always get [([], _::ActiveSet)]
|
contMap = Map.fromList (TrieMap.toList cont) -- always get [([], _::ActiveSet)]
|
||||||
f :: Active -> (FunId,CId)
|
f :: Active -> (FunId,CId,String)
|
||||||
f (Active int dotpos funid seqid pargs ak) = (funid, cid)
|
f (Active int dotpos funid seqid pargs ak) = (funid, cid, seq)
|
||||||
where CncFun cid _ = cncfuns concr ! funid
|
where
|
||||||
|
CncFun cid _ = cncfuns concr ! funid
|
||||||
|
seq = showSeq dotpos (sequences concr ! seqid)
|
||||||
|
|
||||||
|
showSeq :: DotPos -> Sequence -> String
|
||||||
|
showSeq pos seq = intercalate " " $ scan (drop (pos-1) (elems seq))
|
||||||
|
where
|
||||||
|
-- Scan left-to-right, stop at first non-token
|
||||||
|
scan :: [Symbol] -> [String]
|
||||||
|
scan [] = []
|
||||||
|
scan (sym:syms) = case sym of
|
||||||
|
SymKS token -> token : scan syms
|
||||||
|
_ -> []
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
-- Error State
|
-- Error State
|
||||||
|
|||||||
@@ -30,7 +30,7 @@ import Control.Monad
|
|||||||
import Control.Monad.State(State,evalState,get,put)
|
import Control.Monad.State(State,evalState,get,put)
|
||||||
import Data.Char
|
import Data.Char
|
||||||
import Data.Function (on)
|
import Data.Function (on)
|
||||||
import Data.List (sortBy,intersperse,mapAccumL,nub,isSuffixOf)
|
import Data.List (sortBy,intersperse,mapAccumL,nub,isSuffixOf,nubBy)
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import System.Random
|
import System.Random
|
||||||
@@ -594,18 +594,19 @@ completionInfo :: PGF -> PGF.Token -> PGF.ParseState -> JSValue
|
|||||||
completionInfo pgf token pstate =
|
completionInfo pgf token pstate =
|
||||||
makeObj
|
makeObj
|
||||||
["token".= token
|
["token".= token
|
||||||
,"funs" .= (nub (map mkFun funs))
|
,"funs" .= (map mkFun (nubBy ignoreFunIds funs))
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
contInfo = PGF.getContinuationInfo pstate
|
contInfo = PGF.getContinuationInfo pstate
|
||||||
funs = snd . head $ Map.toList contInfo -- always get [([],_)] ; funs :: [(fid,cid)]
|
funs = snd . head $ Map.toList contInfo -- always get [([],_)] ; funs :: [(fid,cid,seq)]
|
||||||
mkFun (funid,cid) = case PGF.functionType pgf cid of
|
ignoreFunIds (_,cid1,seq1) (_,cid2,seq2) = (cid1,seq1) == (cid2,seq2)
|
||||||
|
mkFun (funid,cid,seq) = case PGF.functionType pgf cid of
|
||||||
Just typ ->
|
Just typ ->
|
||||||
makeObj [ "fid".=funid, "fun".=cid, "hyps".=hyps', "cat".=cat ]
|
makeObj [ {-"fid".=funid,-} "fun".=cid, "hyps".=hyps', "cat".=cat, "seq".=seq ]
|
||||||
where
|
where
|
||||||
(hyps,cat,es) = PGF.unType typ
|
(hyps,cat,es) = PGF.unType typ
|
||||||
hyps' = [ PGF.showType [] typ | (_,_,typ) <- hyps ]
|
hyps' = [ PGF.showType [] typ | (_,_,typ) <- hyps ]
|
||||||
Nothing -> makeObj [] -- shouldn't happen
|
Nothing -> makeObj [ "error".=("Function "++show cid++" not found") ] -- shouldn't happen
|
||||||
|
|
||||||
doLinearize :: PGF -> PGF.Tree -> To -> JSValue
|
doLinearize :: PGF -> PGF.Tree -> To -> JSValue
|
||||||
doLinearize pgf tree (tos,unlex) = showJSON
|
doLinearize pgf tree (tos,unlex) = showJSON
|
||||||
|
|||||||
Reference in New Issue
Block a user