msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

make the GF server to compile after that changes in the PGF runtime

Browse Source
This commit is contained in:
krasimir
2009-10-15 11:32:25 +00:00
parent 93da32c1d4
commit 861e0a4c13
2 changed files with 23 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

30
src/server/MorphoService.hs
View File

@@ -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."