Improvements of "gf -server" mode and related setup

"gf -server" mode now contains everything needed to run the minibar and
the grammar editor (including example-based grammar writing).

The Setup.hs script installs the required files where gf -server can find them.
These files have been moved to a new directory: src/www.

The separate server program pgf-http is now obsolete.

Setup.hs

@@ -1,4 +1,3 @@
-module Main where
 
 import Distribution.Simple
 import Distribution.Simple.LocalBuildInfo
@@ -7,26 +6,34 @@ import Distribution.Simple.Utils
 import Distribution.Simple.Setup
 import Distribution.PackageDescription hiding (Flag)
 import Control.Monad
-import Data.Maybe
 import Data.List(isPrefixOf)
 import System.IO
 import System.Cmd
 import System.FilePath
 import System.Directory
-import System.Environment
 import System.Process
 import System.Exit
 
+import WebSetup
+
 main :: IO ()
 main = defaultMainWithHooks simpleUserHooks{ preBuild =checkRGLArgs
                                            , postBuild=buildRGL
                                            , preInst  =checkRGLArgs
-                                           , postInst =installRGL
+                                           , postInst =gfPostInst
                                            , preCopy  =checkRGLArgs
-                                           , postCopy =copyRGL
+                                           , postCopy =gfPostCopy
                                            , sDistHook=sdistRGL
                                            , runTests =testRGL
                                            }
+  where
+    gfPostInst args flags pkg lbi =
+      do installWeb args flags pkg lbi 
+         installRGL args flags pkg lbi 
+
+    gfPostCopy args flags pkg lbi =
+      do copyWeb args flags pkg lbi 
+         copyRGL args flags pkg lbi 
 
 --------------------------------------------------------
 -- Commands for building the Resource Grammar Library

WebSetup.hs

@@ -0,0 +1,62 @@
+module WebSetup(installWeb,copyWeb) where
+
+import System.Directory(createDirectoryIfMissing,copyFile,removeFile)
+import System.FilePath((</>))
+import System.Cmd(system)
+import System.Exit(ExitCode(..))
+import Distribution.Simple.Setup(Flag(..),CopyDest(..),copyDest)
+import Distribution.Simple.LocalBuildInfo(datadir,buildDir,absoluteInstallDirs)
+
+{-
+   To test the GF web services, the minibar and the grammar editor, use
+   "cabal install" (or "runhaskell Setup.hs install") to install gf as usual.
+   Then start the server with the command "gf -server" and
+   open http://localhost:41296/minibar/minibar.html in your web browser
+   (Firefox, Safari, Opera or Chrome). The example grammars listed below will
+   be available in the minibar.
+-}
+
+example_grammars =  -- :: [(pgf, tmp, src)]
+   [("Foods.pgf","foods","contrib"</>"summerschool"</>"foods"</>"Foods???.gf"),
+    ("Letter.pgf","letter","examples"</>"letter"</>"Letter???.gf")]
+
+
+installWeb args flags pki lbi = setupWeb args dest pki lbi
+  where
+    dest = NoCopyDest
+
+copyWeb args flags pki lbi = setupWeb args dest pki lbi
+  where
+    dest = case copyDest flags of
+             NoFlag -> NoCopyDest
+             Flag d -> d
+
+setupWeb args dest pkg lbi =
+    do putStrLn "setupWeb"
+       mapM_ (createDirectoryIfMissing True) [grammars_dir,cloud_dir]
+       mapM_ build_pgf example_grammars
+  where
+    grammars_dir = www_dir </> "grammars"
+    cloud_dir = www_dir </> "tmp" -- hmm
+    www_dir = datadir (absoluteInstallDirs pkg lbi dest) </> "www"
+    gfo_dir = buildDir lbi </> "gfo"
+
+    build_pgf (pgf,tmp,src) =
+      do createDirectoryIfMissing True tmp_dir
+         execute cmd
+         copyFile pgf (grammars_dir</>pgf)
+         putStrLn (grammars_dir</>pgf)
+         removeFile pgf
+      where
+        tmp_dir = gfo_dir</>tmp
+        cmd = "gf -make -s -optimize-pgf --gfo-dir="++tmp_dir++
+           -- " --output-dir="++grammars_dir++  -- has no effect?!
+              " "++src
+
+execute command =
+  do putStrLn command
+     e <- system command
+     case e of
+       ExitSuccess -> return ()
+       _ -> fail "Command failed"
+     return ()

gf.cabal

@@ -12,10 +12,23 @@ homepage: http://www.grammaticalframework.org/
 bug-reports: http://code.google.com/p/grammatical-framework/issues/list
 tested-with: GHC==6.12.3, GHC==7.0.3
 
+data-dir: src
+data-files: www/index.html
+	    www/gfse/*.html
+	    www/gfse/*.css
+	    www/gfse/*.js
+	    www/gfse/P/*.png
+	    www/gfse/P/*.jpg
+	    www/minibar/*.html
+	    www/minibar/*.css
+	    www/minibar/*.js
+	    www/minibar/*.png
+
 source-repository head
   type:     darcs
   location: http://www.grammaticalframework.org/
 
+
 flag interrupt
   Description: Enable Ctrl+Break in the shell
   Default:     True

src/compiler/GFServer.hs

@@ -27,21 +27,19 @@ import qualified ExampleService as ES
 import Paths_gf(getDataDir)
 import RunHTTP(Options(..),cgiHandler)
 
--- * Configuraiton
-
-options = Options { documentRoot = "." {-datadir</>"www"-}, port = gfport }
-gfport = 41296
-
 -- * HTTP server
 server execute1 state0 = 
   do state <- newMVar M.empty
      cache <- PS.newPGFCache
-     --datadir <- getDataDir
+     datadir <- getDataDir
-     putStrLn $ "Starting server on port "++show gfport
+     let options = Options { documentRoot = datadir</>"www", port = 41296 }
-     initServer gfport (modifyMVar state . handle state0 cache execute1)
+     putStrLn $ "Starting HTTP server, open http://localhost:"
+                ++show (port options)++"/ in your web browser."
+     initServer (port options)
+                (modifyMVar state . handle options state0 cache execute1)
 
 -- * HTTP request handler
-handle state0 cache execute1
+handle options state0 cache execute1
        rq@(Request method URI{uriPath=upath,uriQuery=q} hdrs body) state =
     do let qs = decodeQ $ 
                 case method of
@@ -67,6 +65,8 @@ handle state0 cache execute1
   where
     root = documentRoot options
 
+    translatePath rpath = root</>rpath -- hmm, check for ".."
+
     wrapCGI cgi = 
       do resp <- cgiHandler root (handleErrors . handleCGIErrors $ cgi) rq
          return (state,resp)
@@ -191,8 +191,6 @@ escape1 c   = [c]
 
 -- * Static content
 
-translatePath path = documentRoot options</>path -- hmm, check for ".."
-
 serveStaticFile path =
   do b <- doesDirectoryExist path
      let path' = if b then path </> "index.html" else path

src/www/gfse/index.html

@@ -32,7 +32,7 @@ This page does not work without JavaScript.
 <hr>
 <div class=modtime><small>
 HTML
-<!-- hhmts start --> Last modified: Mon Oct 10 17:54:37 CEST 2011 <!-- hhmts end -->
+<!-- hhmts start --> Last modified: Mon Oct 10 19:24:05 CEST 2011 <!-- hhmts end -->
 </small></div>
 <a href="about.html">About</a>
 <pre id=debug></pre>
@@ -42,7 +42,7 @@ HTML
 <script type="text/javascript" src="gf_abs.js"></script>
 <script type="text/javascript" src="example_based.js"></script>
 <script type="text/javascript" src="editor.js"></script>
-<script type="text/javascript" src="cloud.js"></script>
+<script type="text/javascript" src="cloud2.js"></script>
 <script type="text/javascript" src="sort.js"></script>
 </body>
 </html>

src/www/gfse/share.html

@@ -13,12 +13,12 @@
 
 <hr>
 <address></address>
-<!-- hhmts start --> Last modified: Mon Aug  1 16:24:44 CEST 2011 <!-- hhmts end -->
+<!-- hhmts start --> Last modified: Mon Oct 10 20:29:01 CEST 2011 <!-- hhmts end -->
 <script type="text/javascript" src="support.js"></script>
 <script type="text/javascript" src="localstorage.js"></script>
 <script type="text/javascript" src="gf_abs.js"></script>
 <script type="text/javascript" src="editor.js"></script>
-<script type="text/javascript" src="cloud.js"></script>
+<script type="text/javascript" src="cloud2.js"></script>
 <script type="text/javascript" src="sort.js"></script>
 <script type="text/javascript">
 download_from_cloud();

src/www/index.html

@@ -0,0 +1,18 @@
+<!DOCTYPE html>
+
+<!-- This is the start page served by "gf -server" -->
+
+<title>GF web service</title>
+<h1>GF web service</h1>
+
+<h2>Available web services</h2>
+
+<ul>
+  <li><a href="minibar/minibar.html">Minibar</a>
+  <li><a href="gfse/">GF online editor for simple multilingual grammars</a>
+</ul>
+
+
+<hr>
+
+<a href="http://www.grammaticalframework.org/">Grammatical Framework</a>