summaryrefslogtreecommitdiff
path: root/src/server/MorphoService.hs
diff options
context:
space:
mode:
authorkrasimir <krasimir@chalmers.se>2009-10-15 11:32:25 +0000
committerkrasimir <krasimir@chalmers.se>2009-10-15 11:32:25 +0000
commit861e0a4c13db96d10be40156ebdc2783d27e78ff (patch)
tree8df61b7fadf4a380e80e9b90a05554733555ebba /src/server/MorphoService.hs
parent93da32c1d43945c709fadf3fcaaedef369cc8046 (diff)
make the GF server to compile after that changes in the PGF runtime
Diffstat (limited to 'src/server/MorphoService.hs')
-rw-r--r--src/server/MorphoService.hs30
1 files changed, 19 insertions, 11 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."
+