From 1c1679227e24e8169fb0fd967b26fc28e53fc0d2 Mon Sep 17 00:00:00 2001
From: hallgren <hallgren@chalmers.se>
Date: Mon, 2 Apr 2012 15:42:43 +0000
Subject: [PATCH] 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}]}
---
 src/server/PGFService.hs | 18 +++++++++++++++++-
 1 file changed, 17 insertions(+), 1 deletion(-)

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