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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
module ExampleService(cgiMain,newPGFCache) where
import Data.Map(fromList)
import PGF
import GF.Compile.ToAPI
import Network.CGI
import Text.JSON
import FastCGIUtils
import Cache
import qualified ExampleDemo as E
newPGFCache = newCache readPGF
cgiMain :: Cache PGF -> CGI CGIResult
cgiMain cache =
handleErrors . handleCGIErrors $
do command <- getInp "command"
environ <- parseEnviron =<< getInp "state"
cgiMain' cache command environ
cgiMain' cache command environ =
case command of
"possibilities" -> outputJSONP (E.getNext environ)
"provide_example" -> doProvideExample cache environ
"abstract_example" -> doAbstractExample cache environ
"test_function" -> doTestFunction cache environ
_ -> throwCGIError 400 ("Unknown command: "++command) []
doProvideExample cache environ =
do Just lang <- readInput "lang"
fun <- getCId "fun"
parsePGF <- readParsePGF cache
pgf <- liftIO . readCache cache =<< getInp "grammar"
let Just s = E.provideExample environ fun parsePGF pgf lang
outputJSONP s
doAbstractExample cache environ =
do example <- getInp "input"
Just abs <- readInput "abstract"
Just cat <- readInput "cat"
let t = mkType [] cat []
parsePGF <- readParsePGF cache
let lang:_ = languages parsePGF
Just (e,_) <- liftIO $ abstractExample parsePGF environ lang t abs example
outputJSONP (exprToAPI e)
abstractExample parsePGF env lang cat abs example =
E.searchGoodTree env abs (parse parsePGF lang cat example)
doTestFunction cache environ =
do fun <- getCId "fun"
parsePGF <- readParsePGF cache
let lang:_ = languages parsePGF
Just txt <- return (E.testThis environ fun parsePGF lang)
outputJSONP txt
getCId :: String -> CGI CId
getCId name = maybe err return =<< fmap readCId (getInp name)
where err = throwCGIError 400 ("Bad "++name) []
getLimit :: CGI Int
getLimit = maybe err return =<< readInput "limit"
where err = throwCGIError 400 "Missing/bad limit" []
readParsePGF cache = liftIO $ readCache cache "ParseEngAbs.pgf"
parseEnviron s = do state <- liftIO $ readIO s
return $ environ state
getInp name = maybe err return =<< getInput name
where err = throwCGIError 400 ("Missing parameter: "++name) []
instance JSON CId where
showJSON = showJSON . show
readJSON = (readResult =<<) . readJSON
instance JSON Expr where
showJSON = showJSON . show
readJSON = (readResult =<<) . readJSON
readResult s = case reads s of
(x,r):_ | lex r==[("","")] -> Ok x
_ -> Error "read failed"
-- cat lincat fun lin fun cat cat
environ :: ([(CId, CId)],[(CId, Expr)],[((CId, CId), [CId])]) -> E.Environ
environ (lincats,lins,funs) =
E.initial (fromList lincats) concmap fs allfs
where
concmap = fromList lins
allfs = map E.mkFuncWithArg funs
fs = [E.mkFuncWithArg f | f@((fn,_),_)<-funs, fn `elem` cns]
cns = map fst lins
|
