diff options
Diffstat (limited to 'src/example-based')
| -rw-r--r-- | src/example-based/ExampleService.hs | 46 | ||||
| -rw-r--r-- | src/example-based/gf-exb.cabal | 2 |
2 files changed, 24 insertions, 24 deletions
diff --git a/src/example-based/ExampleService.hs b/src/example-based/ExampleService.hs index 165caccba..e4198a87b 100644 --- a/src/example-based/ExampleService.hs +++ b/src/example-based/ExampleService.hs @@ -1,4 +1,5 @@ -module ExampleService(cgiMain,newPGFCache) where +module ExampleService(cgiMain,cgiMain',newPGFCache) where +import System.FilePath((</>),makeRelative) import Data.Map(fromList) import Data.Char(isDigit) import Data.Maybe(fromJust) @@ -14,31 +15,30 @@ 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 = +cgiMain = handleErrors . handleCGIErrors . cgiMain' "." "." + +cgiMain' root cwd cache = + do command <- getInp "command" + environ <- parseEnviron =<< getInp "state" + case command of + "possibilities" -> outputJSONP (E.getNext environ) + "provide_example" -> doProvideExample root cwd cache environ + "abstract_example" -> doAbstractExample cwd cache environ + "test_function" -> doTestFunction cwd cache environ + _ -> throwCGIError 400 ("Unknown command: "++command) [] + +doProvideExample root cwd cache environ = do Just lang <- readInput "lang" fun <- getCId "fun" - parsePGF <- readParsePGF cache - pgf <- liftIO . readCache cache =<< getInp "grammar" + parsePGF <- readParsePGF cwd cache + let adjpath path = root</>makeRelative "/" (makeRelative root cwd</>path) + pgf <- liftIO . readCache cache . adjpath =<< getInp "grammar" let Just (e,s) = E.provideExample environ fun parsePGF pgf lang res = (showExpr [] e,s) liftIO $ logError $ "proveExample ... = "++show res outputJSONP res -doAbstractExample cache environ = +doAbstractExample cwd cache environ = do example <- getInp "input" Just params <- readInput "params" absstr <- getInp "abstract" @@ -46,7 +46,7 @@ doAbstractExample cache environ = liftIO $ logError $ "abstract = "++showExpr [] abs Just cat <- readInput "cat" let t = mkType [] cat [] - parsePGF <- readParsePGF cache + parsePGF <- readParsePGF cwd cache let lang:_ = languages parsePGF ae <- liftIO $ abstractExample parsePGF environ lang t abs example outputJSONP (fmap (\(e,_)->(exprToAPI (instExpMeta params e),e)) ae) @@ -54,9 +54,9 @@ doAbstractExample cache environ = abstractExample parsePGF env lang cat abs example = E.searchGoodTree env abs (parse parsePGF lang cat example) -doTestFunction cache environ = +doTestFunction cwd cache environ = do fun <- getCId "fun" - parsePGF <- readParsePGF cache + parsePGF <- readParsePGF cwd cache let lang:_ = languages parsePGF Just txt <- return (E.testThis environ fun parsePGF lang) outputJSONP txt @@ -70,7 +70,7 @@ getLimit = maybe err return =<< readInput "limit" where err = throwCGIError 400 "Missing/bad limit" [] -readParsePGF cache = liftIO $ readCache cache "ParseEngAbs.pgf" +readParsePGF cwd cache = liftIO $ readCache cache (cwd</>"ParseEngAbs.pgf") parseEnviron s = do state <- liftIO $ readIO s return $ environ state diff --git a/src/example-based/gf-exb.cabal b/src/example-based/gf-exb.cabal index 75b1a49a1..1366e75da 100644 --- a/src/example-based/gf-exb.cabal +++ b/src/example-based/gf-exb.cabal @@ -17,7 +17,7 @@ executable exb.fcgi build-depends: base >=4.2 && <5, json, cgi, fastcgi, random, containers, old-time, directory, bytestring, utf8-string, - pretty, array, mtl, fst + pretty, array, mtl, fst, filepath if os(windows) ghc-options: -optl-mwindows |