blob: fcaa9619728a7c8b84fbb48d65483a312f3c0247 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
import GF.Compile
import GF.Data.Operations
import GF.Grammar.API
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 Control.Monad
import System.Environment
import System.FilePath
import FastCGIUtils
import URLEncoding
-- FIXME !!!!!!
grammarFile :: IO FilePath
grammarFile = return "/Users/bringert/Projects/gf/lib/alltenses/ParadigmsFin.gfo"
grammarPath :: FilePath
grammarPath = "/Users/bringert/Projects/gf/lib/prelude"
main :: IO ()
main = do initFastCGI
r <- newDataRef
loopFastCGI (handleErrors (handleCGIErrors (fcgiMain r)))
fcgiMain :: DataRef Grammar -> CGI CGIResult
fcgiMain ref = liftIO grammarFile >>= getData readGrammar ref >>= cgiMain
readGrammar :: FilePath -> CGI Grammar
readGrammar file =
do let opts = concatOptions [modifyFlags $ \fs -> fs { optVerbosity = Quiet },
modifyModuleFlags $ \fs -> fs { optLibraryPath = [grammarPath] }]
mgr <- liftIO $ appIOE $ batchCompile opts [file]
err (throwCGIError 500 "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
-- FIXME
termToJSValue :: Term -> JSValue
termToJSValue = showJSON . toJSObject . prTermTabular
eval :: Grammar -> String -> Err Term
eval sgr t = pTerm t >>= checkTerm sgr >>= computeTerm sgr
-- * 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."
|
