From d1da0e06de1d50e5246ea362ea8f2949b6a2a950 Mon Sep 17 00:00:00 2001
From: hallgren <hallgren@chalmers.se>
Date: Wed, 9 Apr 2014 17:51:25 +0000
Subject: 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.
---
 src/compiler/GFServer.hs | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

(limited to 'src/compiler')

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)
-- 
cgit v1.2.3