PGFService.hs: add web API function "abstrjson"

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

View File

@@ -18,6 +18,7 @@ import qualified Data.ByteString.Lazy as BS
import Control.Concurrent import Control.Concurrent
import Control.Exception(evaluate) import Control.Exception(evaluate)
import Control.Monad import Control.Monad
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)
@@ -69,6 +70,7 @@ pgfMain pgf command =
"parsetree" -> do t <- getTree "parsetree" -> do t <- getTree
Just l <- getFrom Just l <- getFrom
outputGraphviz (parseTree pgf l t) outputGraphviz (parseTree pgf l t)
"abstrjson" -> outputJSONP . jsonExpr =<< getTree
"browse" -> id =<< doBrowse pgf `fmap` getId `ap` getCSSClass `ap` getHRef `ap` getFormat "html" "browse" -> id =<< doBrowse pgf `fmap` getId `ap` getCSSClass `ap` getHRef `ap` getFormat "html"
"external" -> do cmd <- getInput "external" "external" -> do cmd <- getInput "external"
input <- getText input <- getText
@@ -170,7 +172,7 @@ doTranslate pgf input mcat mfrom mto =
[makeObj ["tree".=tree, [makeObj ["tree".=tree,
"linearizations".= "linearizations".=
[makeObj ["to".=to, "text".=text, "brackets".=bs] [makeObj ["to".=to, "text".=text, "brackets".=bs]
| (to,text,bs)<- linearizeAndBind pgf mto tree]] | (to,text,bs)<- linearizeAndBind pgf mto tree]]
| tree <- trees]] | tree <- trees]]
PGF.ParseIncomplete -> ["incomplete".=True] PGF.ParseIncomplete -> ["incomplete".=True]
PGF.ParseFailed n -> ["parseFailed".=n] 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 readJSON x = readJSON x >>= maybe (fail "Bad language.") return . PGF.readLanguage
showJSON = showJSON . PGF.showLanguage 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 instance JSON PGF.Expr where
readJSON x = readJSON x >>= maybe (fail "Bad expression.") return . PGF.readExpr readJSON x = readJSON x >>= maybe (fail "Bad expression.") return . PGF.readExpr
showJSON = showJSON . PGF.showExpr [] showJSON = showJSON . PGF.showExpr []