msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

PGFService.hs: add web API function "abstrjson"

Browse Source 
Abstract syntax trees are represented as strings in the web API. To make them
easier to manipulate in JavaScript, the new function converts them to JSON.

To support structural editing, the nodes are numbered in the same way as in
the bracketed string created when linearizing an abstract syntax tree.

Example: "Pred (That Fish) Fresh" is converted to

	{fun:"Pred",fid:3,
	 children:[{fun:"That",fid:1,
		    children:[{fun:"Fish",fid:0}]},
		   {fun:"Fresh",fid:2}]}
This commit is contained in:
hallgren
2012-04-02 15:42:43 +00:00
parent 1db4fab25c
commit 1c1679227e
1 changed files with 17 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
src/server/PGFService.hs
View File

@@ -18,6 +18,7 @@ import qualified Data.ByteString.Lazy as BS
import Control.Concurrent
import Control.Exception(evaluate)
import Control.Monad
import Control.Monad.State(State,evalState,get,put)
import Data.Char
import Data.Function (on)
import Data.List (sortBy,intersperse,mapAccumL,nub,isSuffixOf)
@@ -69,6 +70,7 @@ pgfMain pgf command =
"parsetree" -> do t <- getTree
Just l <- getFrom
outputGraphviz (parseTree pgf l t)
"abstrjson" -> outputJSONP . jsonExpr =<< getTree
"browse" -> id =<< doBrowse pgf `fmap` getId `ap` getCSSClass `ap` getHRef `ap` getFormat "html"
"external" -> do cmd <- getInput "external"
input <- getText
@@ -170,7 +172,7 @@ doTranslate pgf input mcat mfrom mto =
[makeObj ["tree".=tree,
"linearizations".=
[makeObj ["to".=to, "text".=text, "brackets".=bs]
| (to,text,bs)<- linearizeAndBind pgf mto tree]]
| (to,text,bs)<- linearizeAndBind pgf mto tree]]
| tree <- trees]]
PGF.ParseIncomplete -> ["incomplete".=True]
PGF.ParseFailed n -> ["parseFailed".=n]
@@ -449,6 +451,20 @@ instance JSON PGF.CId where
readJSON x = readJSON x >>= maybe (fail "Bad language.") return . PGF.readLanguage
showJSON = showJSON . PGF.showLanguage
jsonExpr e = evalState (expr e) 0
where
expr e = maybe other app (PGF.unApp e)
where
other = return (makeObj ["other".=e])
app (f,es) = do js <- mapM expr es
let children=["children".=js | not (null js)]
i<-inc
return $ makeObj (["fun".=f,"fid".=i]++children)
inc :: State Int Int
inc = do i <- get; put (i+1); return i
instance JSON PGF.Expr where
readJSON x = readJSON x >>= maybe (fail "Bad expression.") return . PGF.readExpr
showJSON = showJSON . PGF.showExpr []