1
0
forked from GitHub/gf-core

gfse: show grammar comments in the list of public grammars

gf -server now includes the comment field from the grammar in the
response to /cloud requests with command=ls-t and ext=.json
This commit is contained in:
Thomas Hallgren
2018-03-29 18:23:32 +02:00
parent 750a1349ff
commit 3d6a5e8864
2 changed files with 14 additions and 4 deletions

View File

@@ -33,7 +33,7 @@ import Network.Shed.Httpd(initServer,Request(..),Response(..),noCache)
--import qualified Network.FastCGI as FCGI -- from hackage direct-fastcgi
import Network.CGI(handleErrors,liftIO)
import CGIUtils(handleCGIErrors)--,outputJSONP,stderrToFile
import Text.JSON(encode,showJSON,makeObj)
import Text.JSON(JSValue(..),Result(..),valFromObj,encode,decode,showJSON,makeObj)
--import System.IO.Silently(hCapture)
import System.Process(readProcessWithExitCode)
import System.Exit(ExitCode(..))
@@ -283,13 +283,17 @@ handle logLn documentroot state0 cache execute1 stateVar
skip_empty = filter (not.null.snd)
jsonList = jsonList' return
jsonListLong = jsonList' (mapM addTime)
jsonListLong ext = jsonList' (mapM (addTime ext)) ext
jsonList' details ext = fmap (json200) (details =<< ls_ext "." ext)
addTime path =
addTime ext path =
do t <- getModificationTime path
return $ makeObj ["path".=path,"time".=format t]
if ext==".json"
then addComment (time t) <$> liftIO (try $ getComment path)
else return . makeObj $ time t
where
addComment t = makeObj . either (const t) (\c->t++["comment".=c])
time t = ["path".=path,"time".=format t]
format = formatTime defaultTimeLocale rfc822DateFormat
rm path | takeExtension path `elem` ok_to_delete =
@@ -331,6 +335,11 @@ handle logLn documentroot state0 cache execute1 stateVar
do paths <- getDirectoryContents dir
return [path | path<-paths, takeExtension path==ext]
getComment path =
do Ok (JSObject obj) <- decode <$> readFile path
Ok cmnt <- return (valFromObj "comment" obj)
return (cmnt::String)
-- * Dynamic content
jsonresult cwd dir cmd (ecode,stdout,stderr) files =