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

1 files changed, 13 insertions, 4 deletions

diff --git a/src/compiler/GF/Server.hs b/src/compiler/GF/Server.hs
index de0ec6abc..1ca6f399d 100644
--- a/src/compiler/GF/Server.hs
+++ b/src/compiler/GF/Server.hs
@@ -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 =