PGF web service: add unlexers and enable client side caching

Most PGF web API commands that produce linearizations now accept an
unlexer parameter. Possible values are "text", "code" and "mixed".

The web service now include Date and Last-Modified headers in the HTTP,
responses. This means that browsers can treat responses as static content and
cache them, so it becomes less critical to cache parse results in the server.

Also did some cleanup in PGFService.hs, e.g. removed a couple of functions
that can now be imported from PGF.Lexing instead.

1 files changed, 8 insertions, 1 deletions

diff --git a/src/compiler/GFServer.hs b/src/compiler/GFServer.hs
index cad43a97d..049b60d26 100644
--- a/src/compiler/GFServer.hs
+++ b/src/compiler/GFServer.hs
@@ -15,7 +15,7 @@ import GF.System.Directory(doesDirectoryExist,doesFileExist,createDirectory,
                            setCurrentDirectory,getCurrentDirectory,
                            getDirectoryContents,removeFile,removeDirectory,
                            getModificationTime)
-import Data.Time (formatTime)
+import Data.Time (getCurrentTime,formatTime)
 import System.Locale(defaultTimeLocale,rfc822DateFormat)
 import System.FilePath(dropExtension,takeExtension,takeFileName,takeDirectory,
                        (</>))
@@ -132,6 +132,7 @@ hmbracket_ pre post m =
 -- | HTTP request handler
 handle logLn documentroot state0 cache execute1 stateVar
        rq@(Request method URI{uriPath=upath,uriQuery=q} hdrs body) =
+    addDate $
     case method of
       "POST" -> normal_request (utf8inputs body)
       "GET"  -> normal_request (utf8inputs q)
@@ -140,6 +141,12 @@ handle logLn documentroot state0 cache execute1 stateVar
     logPutStrLn msg = liftIO $ logLn msg
     debug msg = logPutStrLn msg
 
+    addDate m =
+      do t <- getCurrentTime
+         r <- m
+         let fmt = formatTime defaultTimeLocale rfc822DateFormat t
+         return r{resHeaders=("Date",fmt):resHeaders r}
+
     normal_request qs =
       do logPutStrLn $ method++" "++upath++" "++show (mapSnd (take 100.fst) qs)
          let stateful m = modifyMVar stateVar $ \ s -> run m (qs,s)