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

PGFService.hs: command=browse can now produce output in JSON format.

Browse Source 
To get JSON output, add the parameter format=json. The JSON structure contains
the output from the function PGF.browse.
The default is format=html for backwards compatibility.
This commit is contained in:
hallgren
2012-03-16 13:55:19 +00:00
parent 230f309317
commit 7c484aeada
1 changed files with 12 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
src/server/PGFService.hs
View File

@@ -69,7 +69,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)
"browse" -> outputHTML =<< doBrowse pgf `fmap` getId `ap` getCSSClass `ap` getHRef "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
doExternal cmd input doExternal cmd input
@@ -135,6 +135,8 @@ pgfMain pgf command =
Just lang | lang `elem` PGF.languages pgf -> return $ Just lang Just lang | lang `elem` PGF.languages pgf -> return $ Just lang
| otherwise -> throwCGIError 400 "Unknown language" ["Unknown language: " ++ l] | otherwise -> throwCGIError 400 "Unknown language" ["Unknown language: " ++ l]
getFormat def = maybe def id `fmap` getInput "format"
-- Hook for simple extensions of the PGF service -- Hook for simple extensions of the PGF service
doExternal Nothing input = throwCGIError 400 "Unknown external command" ["Unknown external command"] doExternal Nothing input = throwCGIError 400 "Unknown external command" ["Unknown external command"]
doExternal (Just cmd) input = doExternal (Just cmd) input =
@@ -263,7 +265,7 @@ doLinearize pgf tree mto = showJSON
doLinearizes :: PGF -> PGF.Tree -> Maybe PGF.Language -> JSValue doLinearizes :: PGF -> PGF.Tree -> Maybe PGF.Language -> JSValue
doLinearizes pgf tree mto = showJSON doLinearizes pgf tree mto = showJSON
[makeObj ["to".=PGF.showLanguage to, "texts".=texts] [makeObj ["to".=to, "texts".=texts]
| (to,texts) <- linearizes' pgf mto tree] | (to,texts) <- linearizes' pgf mto tree]
doRandom :: PGF -> Maybe PGF.Type -> Maybe Int -> Maybe Int -> Maybe PGF.Language -> IO JSValue doRandom :: PGF -> Maybe PGF.Type -> Maybe Int -> Maybe Int -> Maybe PGF.Language -> IO JSValue
@@ -310,7 +312,7 @@ doGrammar pgf macc = showJSON $ makeObj
functions = [PGF.showCId fun | fun <- PGF.functions pgf] functions = [PGF.showCId fun | fun <- PGF.functions pgf]
outputGraphviz code = outputGraphviz code =
do format <- maybe "png" id `fmap` getInput "format" do format <- getFormat "png"
case format of case format of
"gv" -> outputPlain code "gv" -> outputPlain code
_ -> outputFPS' format =<< liftIO (pipeIt2graphviz format code) _ -> outputFPS' format =<< liftIO (pipeIt2graphviz format code)
@@ -363,7 +365,13 @@ pipeIt2graphviz format code = do
ExitSuccess -> return output ExitSuccess -> return output
ExitFailure r -> fail ("pipeIt2graphviz: (exit " ++ show r ++ ")") ExitFailure r -> fail ("pipeIt2graphviz: (exit " ++ show r ++ ")")
doBrowse pgf id cssClass href = doBrowse pgf id _ _ "json" =
outputJSONP . makeObj . maybe [] obj $ PGF.browse pgf id
where
obj (def,ps,cs) = ["def".=def,"producers".=ps,"consumers".=cs]
doBrowse pgf id cssClass href _ = -- default to "html" format
outputHTML $
case PGF.browse pgf id of case PGF.browse pgf id of
Just (def,ps,cs) -> "<PRE>"++annotate def++"</PRE>\n"++ Just (def,ps,cs) -> "<PRE>"++annotate def++"</PRE>\n"++
syntax++ syntax++