the morpho server is now updated and works with the current GF. the sources are moved in directory server

10 files changed, 296 insertions, 31 deletions

diff --git a/src/server/MorphoService.hs b/src/server/MorphoService.hs
new file mode 100644
index 000000000..15590b356
--- /dev/null
+++ b/src/server/MorphoService.hs
@@ -0,0 +1,79 @@
+import GF.Compile
+import GF.Data.Operations
+import GF.Grammar.API
+import GF.Grammar.Parser
+import GF.Grammar.Grammar (Term)
+import GF.Grammar.PrGrammar (prTermTabular)
+import GF.Infra.Option
+import GF.Infra.UseIO
+import GF.Text.UTF8
+
+import Network.FastCGI
+import Text.JSON
+import qualified Codec.Binary.UTF8.String as UTF8 (encodeString)
+import Data.ByteString.Char8 as BS
+
+import Control.Monad
+import System.Environment
+import System.FilePath
+
+import Cache
+import FastCGIUtils
+import URLEncoding
+
+-- FIXME !!!!!!
+grammarFile :: FilePath
+grammarFile = "/usr/local/share/gf-3.0/lib/alltenses/ParadigmsFin.gfo"
+
+grammarPath :: FilePath
+grammarPath = "/usr/local/share/gf-3.0/lib/prelude"
+
+main :: IO ()
+main = do initFastCGI
+          r <- newCache readGrammar
+          loopFastCGI (handleErrors (handleCGIErrors (fcgiMain r)))
+
+fcgiMain :: Cache Grammar -> CGI CGIResult
+fcgiMain cache = liftIO (readCache cache grammarFile) >>= cgiMain
+
+readGrammar :: FilePath -> IO Grammar
+readGrammar file = 
+    do let opts = concatOptions [modifyFlags $ \fs -> fs { optVerbosity = Quiet },
+                                 modifyFlags $ \fs -> fs { optLibraryPath = [grammarPath] }]
+       mgr <- appIOE $ batchCompile opts [file]
+       err (fail "Grammar loading error") return mgr
+
+cgiMain :: Grammar -> CGI CGIResult
+cgiMain sgr =
+    do path <- pathInfo
+       json <- case path of
+         "/eval"           -> do mjson <- return (doEval sgr) `ap` getTerm
+                                 err (throwCGIError 400 "Evaluation error" . (:[])) return mjson
+         _                 -> throwCGIError 404 "Not Found" ["Resource not found: " ++ path]
+       outputJSON json
+  where
+    getTerm :: CGI String
+    getTerm = do mt <- getInput "term"
+                 maybe (throwCGIError 400 "No term given" ["No term given"]) (return . urlDecodeUnicode) mt
+
+doEval :: Grammar -> String -> Err JSValue
+doEval sgr t = liftM termToJSValue $ eval sgr t 
+
+termToJSValue :: Term -> JSValue
+termToJSValue t = showJSON [toJSObject [("name", name), ("value",value)] | (name,value) <- prTermTabular t]
+
+eval :: Grammar -> String -> Err Term
+eval sgr t = 
+  case runP pExp (BS.pack t) of
+    Right e       -> checkTerm sgr e >>= computeTerm sgr
+    Left  (_,msg) -> fail msg
+
+-- * General CGI and JSON stuff
+
+outputJSON :: JSON a => a -> CGI CGIResult
+outputJSON x = do setHeader "Content-Type" "text/json; charset=utf-8"
+                  outputStrict $ UTF8.encodeString $ encode x
+
+outputStrict :: String -> CGI CGIResult
+outputStrict x | x == x = output x
+               | otherwise = fail "I am the pope."
diff --git a/src/server/Setup.hs b/src/server/Setup.hs
new file mode 100644
index 000000000..c46cb0330
--- /dev/null
+++ b/src/server/Setup.hs
@@ -0,0 +1,6 @@
+module Main where
+
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMainWithHooks simpleUserHooks
diff --git a/src/server/gf-server.cabal b/src/server/gf-server.cabal
new file mode 100644
index 000000000..f573e3f07
--- /dev/null
+++ b/src/server/gf-server.cabal
@@ -0,0 +1,57 @@
+name: gf-server
+version: 1.0
+cabal-version: >= 1.2
+build-type: Simple
+license: GPL
+license-file: LICENSE
+synopsis: FastCGI Server for Grammatical Framework
+
+executable pgf-server
+  build-depends: base,
+                 old-time,
+                 directory,
+                 filepath,
+                 containers,
+                 gf >= 3.0,
+                 cgi >= 3001.1.7.0,
+                 fastcgi >= 3001.0.2.1,
+                 json >= 0.3.3,
+                 utf8-string >= 0.3.1.1
+  if !os(windows)
+    build-depends: unix
+  main-is: PGFService.hs
+  other-modules:
+    FastCGIUtils
+    Cache
+    URLEncoding
+  ghc-options: -threaded
+  if os(windows)
+    ghc-options: -optl-mwindows
+
+executable morpho-server
+  build-depends: base,
+                 old-time,
+                 directory,
+                 filepath,
+                 containers,
+                 gf >= 3.0,
+                 cgi >= 3001.1.7.0,
+                 fastcgi >= 3001.0.2.1,
+                 json >= 0.3.3,
+                 utf8-string >= 0.3.1.1,
+                 bytestring,
+                 pretty,
+                 array,
+                 process,
+                 mtl,
+                 random
+  if !os(windows)
+    build-depends: unix
+  main-is: MorphoService.hs
+  other-modules:
+    FastCGIUtils
+    Cache
+    URLEncoding
+  hs-source-dirs: .. . ../../dist/build/autogen
+  if os(windows)
+    ghc-options: -optl-mwindows
diff --git a/src/server/gwt/Morpho-compile b/src/server/gwt/Morpho-compile
new file mode 100644
index 000000000..e3cb451ed
--- /dev/null
+++ b/src/server/gwt/Morpho-compile
@@ -0,0 +1,19 @@
+#!/bin/sh
+
+APPDIR=`dirname $0`;
+
+if [ -z "$GWT_CLASSPATH" ]; then
+  echo 'ERROR: $GWT_CLASSPATH is not set'
+  echo 'Set $GWT_CLASSPATH to point to the GWT JAR files. For example:'
+  echo 'export GWT_DIR="/Users/bringert/src/gwt-mac-1.5.2"'
+  echo 'export GWT_CLASSPATH="$GWT_DIR/gwt-user.jar:$GWT_DIR/gwt-dev-mac.jar"'
+  exit 1
+fi
+
+if [ `uname` = "Darwin" ]; then 
+  GWT_JAVA_OPTS=-XstartOnFirstThread
+fi
+
+LIBS=$APPDIR/lib/gwt-dnd-2.5.6.jar
+
+java $GWT_JAVA_OPTS -Xmx256M -cp "$APPDIR/src:$APPDIR/bin:$LIBS:$GWT_CLASSPATH" com.google.gwt.dev.GWTCompiler -out "$APPDIR/www/morpho" "$@" se.chalmers.cs.gf.gwt.MorphoApp;
diff --git a/src/server/gwt/src/se/chalmers/cs/gf/gwt/MorphoApp.gwt.xml b/src/server/gwt/src/se/chalmers/cs/gf/gwt/MorphoApp.gwt.xml
new file mode 100644
index 000000000..3743667f7
--- /dev/null
+++ b/src/server/gwt/src/se/chalmers/cs/gf/gwt/MorphoApp.gwt.xml
@@ -0,0 +1,24 @@
+<module>
+
+      <!-- Inherit the core Web Toolkit stuff.                        -->
+      <inherits name="com.google.gwt.user.User" />
+      <inherits name="com.google.gwt.xml.XML" />
+
+      <!-- Inherit the default GWT style sheet.  You can change       -->
+      <!-- the theme of your GWT application by uncommenting          -->
+      <!-- any one of the following lines.                            -->
+      <inherits name="com.google.gwt.user.theme.standard.Standard"/>
+      <!-- <inherits name="com.google.gwt.user.theme.chrome.Chrome"/> -->
+      <!-- <inherits name="com.google.gwt.user.theme.dark.Dark"/>     -->
+
+      <!-- Other module inherits                                      -->
+      <inherits name='com.allen_sauer.gwt.dnd.gwt-dnd'/>
+
+
+      <!-- Specify the app entry point class.                         -->
+      <entry-point class="se.chalmers.cs.gf.gwt.client.MorphoApp" />
+    
+      <!-- Specify the application specific style sheet.              -->
+      <stylesheet src="Morpho.css" />
+	
+</module>
diff --git a/src/server/gwt/src/se/chalmers/cs/gf/gwt/client/MorphoApp.java b/src/server/gwt/src/se/chalmers/cs/gf/gwt/client/MorphoApp.java
new file mode 100644
index 000000000..20c137e74
--- /dev/null
+++ b/src/server/gwt/src/se/chalmers/cs/gf/gwt/client/MorphoApp.java
@@ -0,0 +1,63 @@
+package se.chalmers.cs.gf.gwt.client;
+
+import java.util.*;
+
+import com.google.gwt.core.client.*;
+import com.google.gwt.user.client.ui.*;
+import com.google.gwt.core.client.JavaScriptObject;
+
+public class MorphoApp implements EntryPoint {
+	private TextBox lemmaBox = new TextBox();
+	private Button submitButton = new Button("Submit");
+	private Grid outputGrid = new Grid(2,0);
+
+	public void onModuleLoad() {
+                HorizontalPanel inputPanel = new HorizontalPanel();
+		inputPanel.add(lemmaBox);
+		inputPanel.add(submitButton);
+
+		submitButton.addClickListener(new ClickListener() {
+			public void onClick(Widget sender) {
+		
+				String url = "http://localhost:41296/morpho/morpho.fcgi/eval";
+				List<JSONRequestBuilder.Arg> args = new ArrayList<JSONRequestBuilder.Arg>();
+				args.add(new JSONRequestBuilder.Arg("term", lemmaBox.getText()));
+					
+				JSONRequestBuilder.sendRequest(url, args, new TableCallback() {
+					public void onResult (IterableJsArray<InflectionForm> table)
+					{
+						outputGrid.resize(table.length(),2);
+						int row = 0;
+						for (InflectionForm form : table.iterable()) {
+							outputGrid.setText(row,0,form.getName());
+							outputGrid.setText(row,1,form.getValue());
+							row++;
+						}
+					}
+
+					public void onError (Throwable e)
+					{
+						outputGrid.resize(1,1);
+						outputGrid.setText(0,0,e.toString());
+					}
+				});
+			}
+		});
+		
+
+		VerticalPanel mainPanel = new VerticalPanel();
+		mainPanel.add(inputPanel);
+		mainPanel.add(outputGrid);
+		RootPanel.get().add(mainPanel);
+	}
+
+	public interface TableCallback extends JSONCallback<IterableJsArray<InflectionForm>> { }
+
+	public static class InflectionForm extends JavaScriptObject {
+		protected InflectionForm() { }
+
+		public final native String getName() /*-{ return this.name; }-*/;
+
+		public final native String getValue() /*-{ return this.value; }-*/;
+	}
+}
diff --git a/src/server/gwt/www/morpho/index.html b/src/server/gwt/www/morpho/index.html
new file mode 100644
index 000000000..9e3beabb6
--- /dev/null
+++ b/src/server/gwt/www/morpho/index.html
@@ -0,0 +1,36 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<!-- The HTML 4.01 Transitional DOCTYPE declaration-->
+<!-- above set at the top of the file will set     -->
+<!-- the browser's rendering engine into           -->
+<!-- "Quirks Mode". Replacing this declaration     -->
+<!-- with a "Standards Mode" doctype is supported, -->
+<!-- but may lead to some differences in layout.   -->
+
+<html>
+  <head>
+    <meta http-equiv="content-type" content="text/html; charset=UTF-8">
+    <!--                                           -->
+    <!-- Any title is fine                         -->
+    <!--                                           -->
+    <title>Morpho</title>
+    
+    <!--                                           -->
+    <!-- This script loads your compiled module.   -->
+    <!-- If you add any GWT meta tags, they must   -->
+    <!-- be added before this line.                -->
+    <!--                                           -->
+    <script type="text/javascript" language="javascript" src="se.chalmers.cs.gf.gwt.MorphoApp/se.chalmers.cs.gf.gwt.MorphoApp.nocache.js"></script>
+  </head>
+
+  <!--                                           -->
+  <!-- The body can have arbitrary html, or      -->
+  <!-- you can leave the body empty if you want  -->
+  <!-- to create a completely dynamic UI.        -->
+  <!--                                           -->
+  <body>
+
+    <!-- OPTIONAL: include this if you want history support -->
+    <iframe src="javascript:''" id="__gwt_historyFrame" tabIndex='-1' style="position:absolute;width:0;height:0;border:0"></iframe>
+
+  </body>
+</html>
diff --git a/src/server/gwt/www/morpho/morpho.fcgi b/src/server/gwt/www/morpho/morpho.fcgi
new file mode 100644
index 000000000..8d1c8b69c
--- /dev/null
+++ b/src/server/gwt/www/morpho/morpho.fcgi
@@ -0,0 +1 @@
+ 
diff --git a/src/server/lighttpd.conf b/src/server/lighttpd.conf
index 23b7f6d8c..285bf399d 100644
--- a/src/server/lighttpd.conf
+++ b/src/server/lighttpd.conf
@@ -47,7 +47,7 @@ $HTTP["host"] =~ "^(.*)$" {
 }
 
 fastcgi.debug = 0
-fastcgi.server = ( ".pgf" =>
+fastcgi.server = (".pgf" =>
                   ((
                     "socket" => basedir + "/" + var.PID + "-pgf.socket",
                     "bin-path" => basedir + "/dist/build/pgf-server/pgf-server",
@@ -58,10 +58,19 @@ fastcgi.server = ( ".pgf" =>
                     "max-procs" => 1,
                     "broken-scriptfilename" => "disable",
 		    "check-local" => "disable"
+                   )),
+                  ".fcgi" =>
+                  ((
+                    "socket" => basedir + "/" + var.PID + "-morpho.socket",
+                    "bin-path" => basedir + "/dist/build/morpho-server/morpho-server",
+                    "bin-environment" => ("GHCRTS" => "-M512M"),
+                    "min-procs" => 1,
+                    "max-procs" => 1,
+                    "broken-scriptfilename" => "disable",
+		    "check-local" => "disable"
                    ))
                  )
 
-
 ## deny access the file-extensions
 #
 # ~    is for backupfiles from vi, emacs, joe, ...
diff --git a/src/server/pgf-server.cabal b/src/server/pgf-server.cabal
deleted file mode 100644
index 076a198b1..000000000
--- a/src/server/pgf-server.cabal
+++ /dev/null
@@ -1,29 +0,0 @@
-name: pgf-server
-version: 1.0
-cabal-version: >= 1.2
-build-type: Simple
-license: GPL
-license-file: LICENSE
-synopsis: FastCGI Server for Grammatical Framework
-
-executable pgf-server
-  build-depends: base,
-                 old-time,
-                 directory,
-                 filepath,
-                 containers,
-                 gf >= 3.0,
-                 cgi >= 3001.1.7.0,
-                 fastcgi >= 3001.0.2.1,
-                 json >= 0.3.3,
-                 utf8-string >= 0.3.1.1
-  if !os(windows)
-    build-depends: unix
-  main-is: PGFService.hs
-  other-modules:
-    FastCGIUtils
-    Cache
-    URLEncoding
-  ghc-options: -threaded
-  if os(windows)
-    ghc-options: -optl-mwindows