diff options
| author | krangelov <kr.angelov@gmail.com> | 2019-08-18 09:09:40 +0200 |
|---|---|---|
| committer | krangelov <kr.angelov@gmail.com> | 2019-08-18 09:09:40 +0200 |
| commit | 148590927c698770a51e1c70057a96dc4c5a6c02 (patch) | |
| tree | 823a40e24df08fb6915511f21f302df7085652b4 /src/server/exec/MorphoService.hs | |
| parent | 85a81ef741239717cbc81e883e10433d8c0bc2b3 (diff) | |
remove obsolete code
Diffstat (limited to 'src/server/exec/MorphoService.hs')
| -rw-r--r-- | src/server/exec/MorphoService.hs | 88 |
1 files changed, 0 insertions, 88 deletions
diff --git a/src/server/exec/MorphoService.hs b/src/server/exec/MorphoService.hs deleted file mode 100644 index 5c173c868..000000000 --- a/src/server/exec/MorphoService.hs +++ /dev/null @@ -1,88 +0,0 @@ -import GF.Compile -import GF.Compile.Rename (renameSourceTerm) -import GF.Compile.Concrete.Compute (computeConcrete) -import GF.Compile.Concrete.TypeCheck (inferLType) -import GF.Data.Operations -import GF.Grammar -import GF.Grammar.Parser -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 - -import Control.Monad -import System.Environment -import System.FilePath - -import Cache -import FastCGIUtils -import URLEncoding - --- FIXME !!!!!! -grammarFile :: FilePath -grammarFile = "/usr/local/share/gf-3.1/lib/alltenses/ParadigmsFin.gfo" - -grammarPath :: FilePath -grammarPath = "/usr/local/share/gf-3.1/lib/prelude" - -main :: IO () -main = do initFastCGI - r <- newCache readGrammar - loopFastCGI (handleErrors (handleCGIErrors (fcgiMain r))) - -fcgiMain :: Cache SourceGrammar -> CGI CGIResult -fcgiMain cache = liftIO (readCache cache grammarFile) >>= cgiMain - -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 :: SourceGrammar -> 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 . UTF8.decodeString) mt - -doEval :: SourceGrammar -> String -> Err JSValue -doEval sgr t = liftM termToJSValue $ eval sgr t - -termToJSValue :: Term -> JSValue -termToJSValue t = - showJSON [toJSObject [("name", render name), ("value",render value)] | (name,value) <- ppTermTabular Unqualified t] - -eval :: SourceGrammar -> String -> Err Term -eval sgr t = - case runP pExp (BS.pack t) of - 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 - -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." - |
