From 861e0a4c13db96d10be40156ebdc2783d27e78ff Mon Sep 17 00:00:00 2001
From: krasimir <krasimir@chalmers.se>
Date: Thu, 15 Oct 2009 11:32:25 +0000
Subject: [PATCH] make the GF server to compile after that changes in the PGF
 runtime

---
 src/server/MorphoService.hs | 30 +++++++++++++++++++-----------
 src/server/PGFService.hs    |  8 ++++----
 2 files changed, 23 insertions(+), 15 deletions(-)

diff --git a/src/server/MorphoService.hs b/src/server/MorphoService.hs
index cd1aac8b0..c078145e1 100644
--- a/src/server/MorphoService.hs
+++ b/src/server/MorphoService.hs
@@ -1,15 +1,19 @@
 import GF.Compile
+import GF.Compile.Compute (computeConcrete)
+import GF.Compile.Rename (renameSourceTerm)
+import GF.Compile.CheckGrammar (inferLType)
 import GF.Data.Operations
-import GF.Grammar.API
+import GF.Grammar
 import GF.Grammar.Parser
-import GF.Grammar.Grammar (Term)
---import GF.Grammar.PrGrammar (prTermTabular)
 import GF.Infra.Option
 import GF.Infra.UseIO
+import GF.Infra.Modules (greatestResource)
+import GF.Infra.CheckM
 import GF.Text.UTF8
 
 import Network.FastCGI
 import Text.JSON
+import Text.PrettyPrint
 import qualified Codec.Binary.UTF8.String as UTF8 (decodeString, encodeString)
 import Data.ByteString.Char8 as BS
 
@@ -33,17 +37,17 @@ main = do initFastCGI
           r <- newCache readGrammar
           loopFastCGI (handleErrors (handleCGIErrors (fcgiMain r)))
 
-fcgiMain :: Cache Grammar -> CGI CGIResult
+fcgiMain :: Cache SourceGrammar -> CGI CGIResult
 fcgiMain cache = liftIO (readCache cache grammarFile) >>= cgiMain
 
-readGrammar :: FilePath -> IO Grammar
+readGrammar :: FilePath -> IO SourceGrammar
 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 :: SourceGrammar -> CGI CGIResult
 cgiMain sgr =
     do path <- pathInfo
        json <- case path of
@@ -56,17 +60,20 @@ cgiMain sgr =
     getTerm = do mt <- getInput "term"
                  maybe (throwCGIError 400 "No term given" ["No term given"]) (return . urlDecodeUnicode . UTF8.decodeString) mt
 
-doEval :: Grammar -> String -> Err JSValue
+doEval :: SourceGrammar -> String -> Err JSValue
 doEval sgr t = liftM termToJSValue $ eval sgr t 
 
 termToJSValue :: Term -> JSValue
-termToJSValue t = error "prTermTabular undefined"
----- showJSON [toJSObject [("name", name), ("value",value)] | (name,value) <- prTermTabular t]
+termToJSValue t =
+  showJSON [toJSObject [("name", render name), ("value",render value)] | (name,value) <- ppTermTabular Unqualified t]
 
-eval :: Grammar -> String -> Err Term
+eval :: SourceGrammar -> String -> Err Term
 eval sgr t = 
   case runP pExp (BS.pack t) of
-    Right e       -> checkTerm sgr e >>= computeTerm sgr
+    Right t       -> do mo <- maybe (Bad "no source grammar in scope") return $ greatestResource sgr
+                        (t,_) <- runCheck (renameSourceTerm sgr mo t)
+                        ((t,_),_) <- runCheck (inferLType sgr [] t)
+                        computeConcrete sgr t
     Left  (_,msg) -> fail msg
 
 -- * General CGI and JSON stuff
@@ -78,3 +85,4 @@ outputJSON x = do setHeader "Content-Type" "text/json; charset=utf-8"
 outputStrict :: String -> CGI CGIResult
 outputStrict x | x == x = output x
                | otherwise = fail "I am the pope."
+
diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs
index 576ba7a30..d0fac03d9 100644
--- a/src/server/PGFService.hs
+++ b/src/server/PGFService.hs
@@ -57,7 +57,7 @@ pgfMain pgf command =
     getTree :: CGI PGF.Tree
     getTree = do mt <- getInput "tree"
                  t <- maybe (throwCGIError 400 "No tree given" ["No tree given"]) return mt
-                 maybe (throwCGIError 400 "Bad tree" ["Bad tree: " ++ t]) return (PGF.readTree t)
+                 maybe (throwCGIError 400 "Bad tree" ["Bad tree: " ++ t]) return (PGF.readExpr t)
 
     getCat :: CGI (Maybe PGF.Type)
     getCat = 
@@ -106,7 +106,7 @@ doTranslate pgf input mcat mfrom mto = showJSON $ map toJSObject
 
 doParse :: PGF -> String -> Maybe PGF.Type -> Maybe PGF.Language -> JSValue
 doParse pgf input mcat mfrom = showJSON $ map toJSObject
-     [[("from", PGF.showLanguage from),("tree",PGF.showTree tree)]
+     [[("from", PGF.showLanguage from),("tree",PGF.showExpr [] tree)]
          | (from,trees) <- parse' pgf input mcat mfrom,
            tree <- trees ]
 
@@ -125,7 +125,7 @@ doLinearize pgf tree mto = showJSON $ map toJSObject
 doRandom :: PGF -> Maybe PGF.Type -> Maybe Int -> IO JSValue
 doRandom pgf mcat mlimit = 
     do trees <- random' pgf mcat
-       return $ showJSON $ map toJSObject [[("tree", PGF.showTree tree)] | tree <- limit trees]
+       return $ showJSON $ map toJSObject [[("tree", PGF.showExpr [] tree)] | tree <- limit trees]
   where limit = take (fromMaybe 1 mlimit)
 
 doGrammar :: PGF -> Maybe (Accept Language) -> JSValue
@@ -139,7 +139,7 @@ doGrammar pgf macc = showJSON $ toJSObject
                       ("languageCode", showJSON $ fromMaybe "" (PGF.languageCode pgf l)),
                       ("canParse",     showJSON $ PGF.canParse pgf l)]
                      | l <- PGF.languages pgf]
-        categories = map toJSObject [[("cat", PGF.showType cat)] | cat <- PGF.categories pgf]
+        categories = map toJSObject [[("cat", PGF.showType [] cat)] | cat <- PGF.categories pgf]
 
 instance JSON PGF.CId where
     readJSON x = readJSON x >>= maybe (fail "Bad language.") return . PGF.readLanguage