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)