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

@@ -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

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
 ----------------------------------------------------------------

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 -> From -> Maybe PGF.Type -> Maybe Int -> Bool -> JSValue
-doComplete pgf (mfrom,input) mcat mlimit = showJSON
+doComplete pgf (mfrom,input) mcat mlimit full = showJSON
-    [makeObj ["from".=from, "brackets".=bs, "completions".=cs, "text".=s]
+    [makeObj (
-       | from <- froms, let (bs,s,cs) = complete' pgf from cat mlimit input]
+        ["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]), [])
+       then (bs, unwords (if null prefix then ws' else ws'++[prefix]), Map.empty)
-       else (bs, prefix, maybe id take mlimit $ order $ Map.keys (PGF.getCompletions ps prefix))
+       else (bs, prefix, PGF.getCompletions ps prefix)
   where
     order = sortBy (compare `on` map toLower)