diff options
| author | john.j.camilleri <john.j.camilleri@chalmers.se> | 2013-01-18 09:39:50 +0000 |
|---|---|---|
| committer | john.j.camilleri <john.j.camilleri@chalmers.se> | 2013-01-18 09:39:50 +0000 |
| commit | 3d5d424fef5df225416085fd36e0b19a61dcd809 (patch) | |
| tree | 12cdbe6950aae221b60c80d027fe28d647798ade /src | |
| parent | 35aedadc83b9baca19c42da8a85b974f1500b611 (diff) | |
Add fun/cat printnames to PGF web service
This is accessible vis the `browse` command, by adding the flag `printnames`
e.g.: .../Letter.pgf?command=browse&id=Recipient&format=json&printnames=1
Diffstat (limited to 'src')
| -rw-r--r-- | src/server/PGFService.hs | 31 |
1 files changed, 23 insertions, 8 deletions
diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs index 71c4f37d3..a353207f1 100644 --- a/src/server/PGFService.hs +++ b/src/server/PGFService.hs @@ -72,7 +72,7 @@ pgfMain command pgf = Just l <- getFrom outputGraphviz (parseTree pgf l t) "abstrjson" -> outputJSONP . jsonExpr =<< getTree - "browse" -> id =<< doBrowse pgf `fmap` getOptId `ap` getCSSClass `ap` getHRef `ap` getFormat "html" + "browse" -> id =<< doBrowse pgf `fmap` getOptId `ap` getCSSClass `ap` getHRef `ap` getFormat "html" `ap` getIncludePrintNames "external" -> do cmd <- getInput "external" input <- getText doExternal cmd input @@ -140,6 +140,9 @@ pgfMain command pgf = Nothing -> throwCGIError 400 "Bad language" ["Bad language: " ++ l] Just lang | lang `elem` PGF.languages pgf -> return $ Just lang | otherwise -> throwCGIError 400 "Unknown language" ["Unknown language: " ++ l] + + getIncludePrintNames :: CGI Bool + getIncludePrintNames = maybe (return False) (\_->return True) =<< getInput "printnames" errorMissingId = throwCGIError 400 "Missing identifier" [] @@ -372,20 +375,24 @@ pipeIt2graphviz format code = do ExitSuccess -> return output ExitFailure r -> fail ("pipeIt2graphviz: (exit " ++ show r ++ ")") -browse1json pgf id = makeObj . maybe [] obj $ PGF.browse pgf id +browse1json pgf id pn = makeObj . maybe [] obj $ PGF.browse pgf id where - obj (def,ps,cs) = ["def".=def,"producers".=ps,"consumers".=cs] + obj (def,ps,cs) = if pn then (baseobj ++ pnames) else baseobj + where + baseobj = ["def".=def, "producers".=ps, "consumers".=cs] + pnames = ["printnames".=makeObj [(show lang).=PGF.showPrintName pgf lang id | lang <- PGF.languages pgf]] + -doBrowse pgf (Just id) _ _ "json" = outputJSONP $ browse1json pgf id -doBrowse pgf Nothing _ _ "json" = +doBrowse pgf (Just id) _ _ "json" pn = outputJSONP $ browse1json pgf id pn +doBrowse pgf Nothing _ _ "json" pn = 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 + one id = PGF.showCId id.=browse1json pgf id pn -doBrowse pgf Nothing cssClass href _ = errorMissingId -doBrowse pgf (Just id) cssClass href _ = -- default to "html" format +doBrowse pgf Nothing cssClass href _ pn = errorMissingId +doBrowse pgf (Just id) cssClass href _ pn = -- default to "html" format outputHTML $ case PGF.browse pgf id of Just (def,ps,cs) -> "<PRE>"++annotate def++"</PRE>\n"++ @@ -399,6 +406,11 @@ doBrowse pgf (Just id) cssClass href _ = -- default to "html" format then "<BR/>"++ "<H3>Consumers</H3>"++ "<P>"++annotateCIds cs++"</P>\n" + else "")++ + (if pn + then "<BR/>"++ + "<H3>Print Names</H3>"++ + "<P>"++annotatePrintNames++"</P>\n" else "") Nothing -> "" where @@ -459,6 +471,9 @@ doBrowse pgf (Just id) cssClass href _ = -- default to "html" format Just s -> "class=\""++s++"\"" mkLink s = "<A "++hrefAttr s++" "++classAttr++">"++s++"</A>" + + annotatePrintNames = "<DL>"++(unwords pns)++"</DL>" + where pns = ["<DT>"++(show lang)++"</DT><DD>"++(PGF.showPrintName pgf lang id)++"</DD>" | lang <- PGF.languages pgf ] instance JSON PGF.CId where readJSON x = readJSON x >>= maybe (fail "Bad language.") return . PGF.readLanguage |