diff options
| author | hallgren <hallgren@chalmers.se> | 2012-04-02 15:42:43 +0000 |
|---|---|---|
| committer | hallgren <hallgren@chalmers.se> | 2012-04-02 15:42:43 +0000 |
| commit | 1c1679227e24e8169fb0fd967b26fc28e53fc0d2 (patch) | |
| tree | 06177a2c6b2142faf3f9ff64820a136eb494acbb /src | |
| parent | 1db4fab25cf6c884c842d7c127e69c00179f145a (diff) | |
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}]}
Diffstat (limited to 'src')
| -rw-r--r-- | src/server/PGFService.hs | 18 |
1 files changed, 17 insertions, 1 deletions
diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs index 0c05b4e57..7bd1c11e4 100644 --- a/src/server/PGFService.hs +++ b/src/server/PGFService.hs @@ -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 [] |