summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/compiler/GFServer.hs23
-rw-r--r--src/compiler/SimpleEditor/Convert.hs71
-rw-r--r--src/compiler/SimpleEditor/JSON.hs47
-rw-r--r--src/compiler/SimpleEditor/Syntax.hs39
-rw-r--r--src/www/gfse/cloud2.js6
-rw-r--r--src/www/gfse/editor.js61
6 files changed, 236 insertions, 11 deletions
diff --git a/src/compiler/GFServer.hs b/src/compiler/GFServer.hs
index 3fcec3f4d..cb66137b2 100644
--- a/src/compiler/GFServer.hs
+++ b/src/compiler/GFServer.hs
@@ -21,10 +21,9 @@ import Network.URI(URI(..),parseURI)
import Network.Shed.Httpd(initServer,Request(..),Response(..),queryToArguments,
noCache)
--import qualified Network.FastCGI as FCGI -- from hackage direct-fastcgi
---import qualified Data.ByteString.Char8 as BS(pack,unpack,length)
import Network.CGI(handleErrors,liftIO)
import FastCGIUtils(outputJSONP,handleCGIErrors,stderrToFile)
-import Text.JSON(encode,showJSON,toJSObject)
+import Text.JSON(encode,showJSON,makeObj)
import System.IO.Silently(hCapture)
import System.Process(readProcessWithExitCode)
import System.Exit(ExitCode(..))
@@ -35,6 +34,7 @@ import qualified ExampleService as ES
import Data.Version(showVersion)
import Paths_gf(getDataDir,version)
import GF.Infra.BuildInfo (buildInfo)
+import SimpleEditor.Convert(parseModule)
import RunHTTP(cgiHandler)
--logFile :: FilePath
@@ -105,6 +105,7 @@ handle state0 cache execute1
-- "/stop" ->
-- "/start" ->
"/gfshell" -> inDir qs $ look "command" . command
+ "/parse" -> parse qs
"/cloud" -> inDir qs $ look "command" . cloud
'/':rpath ->
case (takeDirectory path,takeFileName path,takeExtension path) of
@@ -157,6 +158,8 @@ handle state0 cache execute1
let state' = maybe state (flip (M.insert dir) state) st'
return (state',ok200 output)
+ parse qs = return (state,json200 (makeObj (map parseModule qs)))
+
cloud dir cmd qs =
case cmd of
"make" -> make dir qs
@@ -226,14 +229,12 @@ handle state0 cache execute1
-- * Dynamic content
jsonresult cwd dir cmd (ecode,stdout,stderr) files =
- toJSObject [
- field "errorcode" (if ecode==ExitSuccess then "OK" else "Error"),
- field "command" cmd,
- field "output" (unlines [rel stderr,rel stdout]),
- field "minibar_url" ("/minibar/minibar.html?"++dir++pgf)]
+ makeObj [
+ prop "errorcode" (if ecode==ExitSuccess then "OK" else "Error"),
+ prop "command" cmd,
+ prop "output" (unlines [rel stderr,rel stdout]),
+ prop "minibar_url" ("/minibar/minibar.html?"++dir++pgf)]
where
- field n v = (n,showJSON v)
-
pgf = case files of
(abstract,_):_ -> "%20"++dropExtension abstract++".pgf"
_ -> ""
@@ -390,4 +391,6 @@ inputs = queryToArguments . fixplus
decode '+' = "%20" -- httpd-shed bug workaround
decode c = [c]
-mapFst f xys = [(f x,y)|(x,y)<-xys] \ No newline at end of file
+mapFst f xys = [(f x,y)|(x,y)<-xys]
+
+prop n v = (n,showJSON v)
diff --git a/src/compiler/SimpleEditor/Convert.hs b/src/compiler/SimpleEditor/Convert.hs
new file mode 100644
index 000000000..93844ea18
--- /dev/null
+++ b/src/compiler/SimpleEditor/Convert.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE NoMonomorphismRestriction #-}
+module SimpleEditor.Convert where
+
+import Control.Monad(unless,foldM,ap)
+import qualified Data.Map as Map
+import qualified Data.ByteString.Char8 as BS(pack)
+import Text.JSON(encode,makeObj)
+
+--import GF.Compile.GetGrammar (getSourceModule)
+--import GF.Infra.Option(noOptions)
+import GF.Infra.Ident(showIdent)
+--import GF.Infra.UseIO(appIOE)
+import GF.Grammar.Grammar
+import GF.Grammar.Parser(runP,pModDef)
+import GF.Grammar.Lexer(Posn(..))
+import GF.Data.ErrM
+
+import SimpleEditor.Syntax
+import SimpleEditor.JSON
+
+
+parseModule (path,source) =
+ prop path $
+ case runP pModDef (BS.pack source) of
+ Left (Pn l c,msg) ->
+ makeObj [prop "error" msg,
+ prop "location" (show l++":"++show c)]
+ Right mod -> case convAbstract mod of
+ Ok g -> makeObj [prop "converted" g]
+ Bad msg -> makeObj [prop "parsed" msg]
+
+{-
+convAbstractFile path =
+ appIOE (fmap encode . convAbstract =<< getSourceModule noOptions path)
+-}
+convAbstract (modid,src) =
+ do unless (isModAbs src) $ fail "Abstract syntax expected"
+ unless (isCompleteModule src) $ fail "A complete abstract syntax expected"
+ extends <- convExtends (mextend src)
+ (cats,funs) <- convJments (jments src)
+ let startcat = head (cats++["-"]) -- !!!
+ return $ Grammar (convId modid) extends (Abstract startcat cats funs) []
+
+convExtends = mapM convExtend
+convExtend (modid,MIAll) = return (convId modid)
+convExtend _ = fail "unsupported module extension"
+
+convJments jments = foldM convJment ([],[]) (Map.toList jments)
+
+convJment (cats,funs) (name,jment) =
+ case jment of
+ AbsCat octx -> do unless (null (maybe [] unLoc octx)) $
+ fail "category with context"
+ let cat = convId name
+ return (cat:cats,funs)
+ AbsFun (Just lt) _ oeqns _ -> do unless (null (maybe [] id oeqns)) $
+ fail "function with equations"
+ let f = convId name
+ typ <- convType (unLoc lt)
+ let fun = Fun f typ
+ return (cats,fun:funs)
+ _ -> fail $ "unsupported judgement form: "++show jment
+
+convType (Prod _ _ t1 t2) = (:) `fmap` convSimpleType t1 `ap` convType t2
+convType t = (:[]) `fmap` convSimpleType t
+
+
+convSimpleType (Vr id) = return (convId id)
+convSimpleType t = fail "unsupported type"
+
+convId = showIdent
diff --git a/src/compiler/SimpleEditor/JSON.hs b/src/compiler/SimpleEditor/JSON.hs
new file mode 100644
index 000000000..3c15e731b
--- /dev/null
+++ b/src/compiler/SimpleEditor/JSON.hs
@@ -0,0 +1,47 @@
+module SimpleEditor.JSON where
+
+import Text.JSON
+
+import SimpleEditor.Syntax
+
+
+instance JSON Grammar where
+ showJSON (Grammar name extends abstract concretes) =
+ makeObj [prop "basename" name,
+ prop "extends" extends,
+ prop "abstract" abstract,
+ prop "concretes" concretes]
+
+instance JSON Abstract where
+ showJSON (Abstract startcat cats funs) =
+ makeObj [prop "startcat" startcat,
+ prop "cats" cats,
+ prop "funs" funs]
+
+instance JSON Fun where showJSON (Fun name typ) = signature name typ
+instance JSON Param where showJSON (Param name rhs) = definition name rhs
+instance JSON Oper where showJSON (Oper name rhs) = definition name rhs
+
+signature name typ = makeObj [prop "name" name,prop "type" typ]
+definition name rhs = makeObj [prop "name" name,prop "rhs" rhs]
+
+instance JSON Concrete where
+ showJSON (Concrete langcode opens params lincats opers lins) =
+ makeObj [prop "langcode" langcode,
+ prop "opens" opens,
+ prop "params" params,
+ prop "lincats" lincats,
+ prop "opers" opers,
+ prop "lins" lins]
+
+instance JSON Lincat where
+ showJSON (Lincat cat lintype) =
+ makeObj [prop "cat" cat,prop "type" lintype]
+
+instance JSON Lin where
+ showJSON (Lin fun args lin) =
+ makeObj [prop "fun" fun,
+ prop "args" args,
+ prop "lin" lin]
+
+prop name v = (name,showJSON v)
diff --git a/src/compiler/SimpleEditor/Syntax.hs b/src/compiler/SimpleEditor/Syntax.hs
new file mode 100644
index 000000000..4a5eb6da8
--- /dev/null
+++ b/src/compiler/SimpleEditor/Syntax.hs
@@ -0,0 +1,39 @@
+{-
+Abstract syntax for the small subset of GF grammars supported
+in gfse, the JavaScript-based simple grammar editor.
+-}
+module SimpleEditor.Syntax where
+
+type Id = String -- all sorts of identifiers
+type ModId = Id -- module name
+type Cat = Id -- category name
+type FunId = Id -- function name
+type Type = [Cat] -- [Cat_1,...,Cat_n] means Cat_1 -> ... -> Cat_n
+
+data Grammar = Grammar { basename :: ModId,
+ extends :: [ModId],
+ abstract :: Abstract,
+ concretes:: [Concrete] }
+ deriving Show
+
+data Abstract = Abstract { startcat:: Cat, cats:: [Cat], funs:: [Fun] }
+ deriving Show
+data Fun = Fun { fname:: FunId, ftype:: Type }
+ deriving Show
+
+data Concrete = Concrete { langcode:: Id,
+ opens:: [ModId],
+ params:: [Param],
+ lincats:: [Lincat],
+ opers:: [Oper],
+ lins:: [Lin] }
+ deriving Show
+
+data Param = Param {pname:: Id, prhs:: String} deriving Show
+data Lincat = Lincat {cat :: Cat, lintype:: Term} deriving Show
+data Oper = Oper {oname:: Lhs, orhs:: Term} deriving Show
+data Lin = Lin {fun :: FunId, args:: [Id], lin:: Term} deriving Show
+
+type Lhs = String -- name and type of oper,
+ -- e.g "regN : Str -> { s:Str,g:Gender} ="
+type Term = String -- arbitrary GF term (not parsed by the editor)
diff --git a/src/www/gfse/cloud2.js b/src/www/gfse/cloud2.js
index 8d33315bd..02af9d91a 100644
--- a/src/www/gfse/cloud2.js
+++ b/src/www/gfse/cloud2.js
@@ -193,6 +193,12 @@ function gfshell(cmd,cont) {
})
}
+// Check the syntax of a source module
+function check_module(path,source,cont) {
+ var enc=encodeURIComponent;
+ http_get_json("/parse?"+enc(path)+"="+enc(source),cont)
+}
+
// Check the syntax of an expression
function check_exp(s,cont) {
function check(gf_message) {
diff --git a/src/www/gfse/editor.js b/src/www/gfse/editor.js
index b630f69ab..60abf2142 100644
--- a/src/www/gfse/editor.js
+++ b/src/www/gfse/editor.js
@@ -453,7 +453,7 @@ function draw_abstract(g) {
timestamp(g.abstract);
save_grammar(g);
}
- return div_id("file",
+ var file=div_id("file",
[kw("abstract "),ident(g.basename),sep(" = "),
draw_timestamp(g.abstract),
draw_extends(g),
@@ -462,6 +462,65 @@ function draw_abstract(g) {
indent(draw_cats(g))]),
extensible([kw_fun,
indent_sortable(draw_funs(g),sort_funs)])])]);
+ if(navigator.onLine) {
+ var mode_button=text_mode(g,file);
+ insertBefore(mode_button,file.firstChild)
+ }
+ return file;
+}
+
+function text_mode(g,file) {
+ var path=g.basename+".gf"
+ function switch_to_guided_mode() {
+ edit_grammar(g); // !!
+ }
+ function store_parsed(parse_results) {
+ var dst=compiler_output;
+ var msg=parse_results[path];
+ if(dst) dst.innerHTML=""
+ console.log(msg)
+ if(dst && msg.error)
+ dst.appendChild(span_class("error_message",
+ text(msg.location+": "+msg.error)))
+ else if(dst && msg.parsed)
+ dst.innerHTML=
+ "Accepted by GF, but not by this editor ("+msg.parsed+")"
+ else if(msg.converted) {
+ var gnew=msg.converted;
+ g.abstract=gnew.abstract;
+ g.extends=gnew.extends;
+ timestamp(g.abstract);
+ save_grammar(g);
+ }
+ else if(dst) dst.innerHTML="unexpected parse result";
+ }
+ var last_source=show_abstract(g);
+ function parse(source) {
+ if(source!=last_source) {
+ if(navigator.onLine) {
+ //compiler_output.innerHTML="";
+ last_source=source;
+ check_module(path,source,store_parsed)
+ }
+ else if(compiler_output)
+ compiler_output.innerHTML="Offline, edits will not be saved"
+ }
+ }
+ function switch_to_text_mode() {
+ var ta=node("textarea",{class:"text_mode",rows:25,cols:80},
+ [text(show_abstract(g))])
+ var timeout;
+ ta.onkeyup=function() {
+ if(timeout) clearTimeout(timeout);
+ timeout=setTimeout(function(){parse(ta.value)},400)
+ }
+ var mode_button=div_class("right",[button("Guided mode",switch_to_guided_mode)])
+ file.innerHTML="";
+ appendChildren(file,[mode_button,ta])
+ ta.focus();
+ }
+ var mode_button=div_class("right",[button("Text mode",switch_to_text_mode)])
+ return mode_button;
}
function add_cat(g,el) {
generated by cgit v1.2.3 (git 2.39.1) at 2026-07-13 18:27:04 +0000