GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 19:42:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

PGF service: command=browse&format=json returns info on all cats and funs

Browse Source 
The browse command used to have a required parameter id=... and it returned
info on the given identifier only. Now, if format=json, the id=... parameter
can be omitted to get info on all identifiers at the same time. The returned
JSON structure in this case is

        {cats:{...},funs:{...}}

where the inner objects contain one field per category and function,
respectively, in the same format as when you request info on one category or
function.
This commit is contained in:
hallgren
2012-11-17 14:22:30 +00:00
parent 73c78c8840
commit ca5b066588
1 changed files with 22 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

30
src/server/PGFService.hs
View File

@@ -71,7 +71,7 @@ pgfMain pgf command =
Just l <- getFrom Just l <- getFrom
outputGraphviz (parseTree pgf l t) outputGraphviz (parseTree pgf l t)
"abstrjson" -> outputJSONP . jsonExpr =<< getTree "abstrjson" -> outputJSONP . jsonExpr =<< getTree
"browse" -> id =<< doBrowse pgf `fmap` getId `ap` getCSSClass `ap` getHRef `ap` getFormat "html" "browse" -> id =<< doBrowse pgf `fmap` getOptId `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
@@ -109,10 +109,13 @@ pgfMain pgf command =
getTo = getLang "to" getTo = getLang "to"
getId :: CGI PGF.CId getId :: CGI PGF.CId
getId = do mb_id <- fmap (>>= PGF.readCId) (getInput "id") getId = maybe errorMissingId return =<< getOptId
case mb_id of
Just id -> return id getOptId :: CGI (Maybe PGF.CId)
Nothing -> throwCGIError 400 "Bad identifier" [] getOptId = maybe (return Nothing) rd =<< getInput "id"
where
rd = maybe err (return . Just) . PGF.readCId
err = throwCGIError 400 "Bad identifier" []
getCSSClass :: CGI (Maybe String) getCSSClass :: CGI (Maybe String)
getCSSClass = getInput "css-class" getCSSClass = getInput "css-class"
@@ -137,6 +140,9 @@ 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]
errorMissingId = throwCGIError 400 "Missing identifier" []
getFormat def = maybe def id `fmap` getInput "format" getFormat def = maybe def id `fmap` getInput "format"
-- Hook for simple extensions of the PGF service -- Hook for simple extensions of the PGF service
@@ -367,12 +373,20 @@ 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 _ _ "json" = browse1json pgf id = makeObj . maybe [] obj $ PGF.browse pgf id
outputJSONP . makeObj . maybe [] obj $ PGF.browse pgf id
where where
obj (def,ps,cs) = ["def".=def,"producers".=ps,"consumers".=cs] obj (def,ps,cs) = ["def".=def,"producers".=ps,"consumers".=cs]
doBrowse pgf id cssClass href _ = -- default to "html" format doBrowse pgf (Just id) _ _ "json" = outputJSONP $ browse1json pgf id
doBrowse pgf Nothing _ _ "json" =
outputJSONP $ makeObj ["cats".=all (PGF.categories pgf),
"funs".=all (PGF.functions pgf)]
where
all = makeObj . map one
one id = PGF.showCId id.=browse1json pgf id
doBrowse pgf Nothing cssClass href _ = errorMissingId
doBrowse pgf (Just id) cssClass href _ = -- default to "html" format
outputHTML $ 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"++