summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Artyom Shalkhakov <artyom.shalkhakov@gmail.com>2019-01-12 16:20:14 +0200
committerGravatar Artyom Shalkhakov <artyom.shalkhakov@gmail.com>2019-01-12 16:20:14 +0200
commitba1871b3b9cc669c43420f993719690b45326e2f (patch)
treedb204c53b57326b23014674b90f7ac21d80a3430
parentdb68fd7f8dd17fda410ea06e7076e11ee2c57afc (diff)
Including app.js in output of endpoints
-rw-r--r--src/cjr_print.sml6
-rw-r--r--src/compiler.sig4
-rw-r--r--src/compiler.sml29
-rw-r--r--src/demo.sml4
-rw-r--r--src/endpoints.sig5
-rw-r--r--src/endpoints.sml25
-rw-r--r--src/main.mlton.sml24
-rw-r--r--src/settings.sig3
-rw-r--r--src/settings.sml7
9 files changed, 79 insertions, 28 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 31653a74..5983b9e5 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -2550,8 +2550,10 @@ fun p_decl env (dAll as (d, loc) : decl) =
(case Settings.getOutputJsFile () of
NONE => "app." ^ SHA1.bintohex (SHA1.hash s) ^ ".js"
| SOME s => s)
- val () = app_js := OS.Path.joinDirFile {dir = Settings.getUrlPrefix (),
- file = name}
+ val js = OS.Path.joinDirFile {dir = Settings.getUrlPrefix (),
+ file = name}
+ val () = app_js := js
+ val () = Endpoints.setJavaScript js
in
box [string "static char jslib[] = \"",
string (Prim.toCString s),
diff --git a/src/compiler.sig b/src/compiler.sig
index d4521b9f..6ed2f9a6 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -35,6 +35,7 @@ signature COMPILER = sig
sources : string list,
exe : string,
sql : string option,
+ endpoints : string option,
debug : bool,
profile : bool,
timeout : int,
@@ -116,6 +117,7 @@ signature COMPILER = sig
val css : (Core.file, Css.report) phase
val monoize : (Core.file, Mono.file) phase
val mono_opt : (Mono.file, Mono.file) phase
+ val endpoints : (Mono.file, Mono.file) phase
val untangle : (Mono.file, Mono.file) phase
val mono_reduce : (Mono.file, Mono.file) phase
val mono_shake : (Mono.file, Mono.file) phase
@@ -171,7 +173,7 @@ signature COMPILER = sig
val toEffectize : (string, Core.file) transform
val toCss : (string, Css.report) transform
val toMonoize : (string, Mono.file) transform
- val toEndpoints : (string, Endpoints.report) transform
+ val toEndpoints : (string, Mono.file) transform
val toMono_opt1 : (string, Mono.file) transform
val toUntangle : (string, Mono.file) transform
val toMono_reduce : (string, Mono.file) transform
diff --git a/src/compiler.sml b/src/compiler.sml
index 4ef9ba19..7099effc 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -39,6 +39,7 @@ type job = {
sources : string list,
exe : string,
sql : string option,
+ endpoints : string option,
debug : bool,
profile : bool,
timeout : int,
@@ -275,7 +276,7 @@ val parseUr = {
handle LrParser.ParseError => [],
print = SourcePrint.p_file}
-fun p_job ({prefix, database, exe, sql, sources, debug, profile,
+fun p_job ({prefix, database, exe, sql, endpoints, sources, debug, profile,
timeout, ffi, link, headers, scripts,
clientToServer, effectful, benignEffectful, clientOnly, serverOnly, jsModule, jsFuncs, ...} : job) =
let
@@ -304,6 +305,10 @@ fun p_job ({prefix, database, exe, sql, sources, debug, profile,
NONE => string "No SQL file."
| SOME sql => string ("SQL fle: " ^ sql),
newline,
+ case endpoints of
+ NONE => string "No endpoints file."
+ | SOME ep => string ("Endpoints fle: " ^ ep),
+ newline,
string "Timeout: ",
string (Int.toString timeout),
newline,
@@ -443,6 +448,7 @@ fun parseUrp' accLibs fname =
sources = [fname],
exe = fname ^ ".exe",
sql = NONE,
+ endpoints = NONE,
debug = Settings.getDebug (),
profile = false,
timeout = 120,
@@ -581,6 +587,7 @@ fun parseUrp' accLibs fname =
val database = ref (Settings.getDbstring ())
val exe = ref (Settings.getExe ())
val sql = ref (Settings.getSql ())
+ val endpoints = ref (Settings.getEndpoints ())
val debug = ref (Settings.getDebug ())
val profile = ref false
val timeout = ref NONE
@@ -622,6 +629,7 @@ fun parseUrp' accLibs fname =
exe = Option.getOpt (!exe, OS.Path.joinBaseExt {base = OS.Path.base filename,
ext = SOME "exe"}),
sql = !sql,
+ endpoints = !endpoints,
debug = !debug,
profile = !profile,
timeout = Option.getOpt (!timeout, 60),
@@ -684,6 +692,7 @@ fun parseUrp' accLibs fname =
database = mergeO (fn (old, _) => old) (#database old, #database new),
exe = #exe old,
sql = #sql old,
+ endpoints = #endpoints old,
debug = #debug old orelse #debug new,
profile = #profile old orelse #profile new,
timeout = #timeout old,
@@ -1430,13 +1439,13 @@ val mono_opt = {
}
val endpoints = {
- func = Endpoints.summarize,
- print = Endpoints.p_report
+ func = Endpoints.collect,
+ print = MonoPrint.p_file MonoEnv.empty
}
val toEndpoints = transform endpoints "endpoints" o toMonoize
-val toMono_opt1 = transform mono_opt "mono_opt1" o toMonoize
+val toMono_opt1 = transform mono_opt "mono_opt1" o toEndpoints
val untangle = {
func = Untangle.untangle,
@@ -1726,6 +1735,18 @@ fun compile job =
TextIO.closeOut outf
end;
+ case #endpoints job of
+ NONE => ()
+ | SOME endpoints =>
+ let
+ val report = Endpoints.summarize ()
+ val outf = TextIO.openOut endpoints
+ val s = TextIOPP.openOut {dst = outf, wid = 80}
+ in
+ Print.fprint s (Endpoints.p_report report);
+ TextIO.closeOut outf
+ end;
+
compileC {cname = cname, oname = oname, ename = ename, libs = libs,
profile = #profile job, debug = #debug job, linker = #linker job, link = #link job}
diff --git a/src/demo.sml b/src/demo.sml
index eaec38bb..ef57e65b 100644
--- a/src/demo.sml
+++ b/src/demo.sml
@@ -98,6 +98,10 @@ fun make' {prefix, dirname, guided} =
NONE => OS.Path.joinDirFile {dir = dirname,
file = "demo.sql"}
| SOME s => s),
+ endpoints = SOME (case Settings.getEndpoints () of
+ NONE => OS.Path.joinDirFile {dir = dirname,
+ file = "demo-endpoints.json"}
+ | SOME e => e),
debug = Settings.getDebug (),
timeout = Int.max (#timeout combined, #timeout urp),
profile = false,
diff --git a/src/endpoints.sig b/src/endpoints.sig
index f2c3c305..89e72add 100644
--- a/src/endpoints.sig
+++ b/src/endpoints.sig
@@ -36,6 +36,9 @@ signature ENDPOINTS = sig
type report = {Endpoints : endpoint list}
val p_report : report Print.printer
- val summarize : Mono.file -> report
+ val reset : unit -> unit
+ val collect : Mono.file -> Mono.file
+ val setJavaScript : string -> unit
+ val summarize : unit -> report
end
diff --git a/src/endpoints.sml b/src/endpoints.sml
index bb0b1d66..5699f319 100644
--- a/src/endpoints.sml
+++ b/src/endpoints.sml
@@ -59,7 +59,14 @@ fun p_report {Endpoints = el} =
p_list_sep (box [string ",", newline]) p_endpoint el,
string "]}"]
-fun summarize file =
+val endpoints = ref ([] : endpoint list)
+val jsFile = ref (NONE : string option)
+
+fun setJavaScript x = jsFile := SOME x
+
+fun reset () = (endpoints := []; jsFile := NONE)
+
+fun collect file =
let
fun exportKindToMethod (Link _) = GET
| exportKindToMethod (Action _) = POST
@@ -75,6 +82,8 @@ fun summarize file =
| _ => st
end
+ val () = reset ()
+
val (decls, _) = file
val ep = foldl decl [] decls
@@ -88,6 +97,20 @@ fun summarize file =
val ep = foldl jsfile ep (Settings.listJsFiles ())
in
+ endpoints := ep;
+ file
+ end
+
+fun summarize () =
+ let
+ val ep = !endpoints
+ val js = !jsFile
+ val ep =
+ case js of
+ NONE => ep
+ | SOME js =>
+ {Method = GET, Url = js, LastModified = NONE, ContentType = SOME "text/javascript"} :: ep
+ in
{Endpoints = ep}
end
diff --git a/src/main.mlton.sml b/src/main.mlton.sml
index 56d98587..bfa40265 100644
--- a/src/main.mlton.sml
+++ b/src/main.mlton.sml
@@ -114,7 +114,6 @@ fun oneRun args =
val demo = ref (NONE : (string * bool) option)
val tutorial = ref false
val css = ref false
- val endpoints = ref false
val () = (Compiler.debug := false;
Elaborate.verbose := false;
@@ -163,8 +162,6 @@ fun oneRun args =
SOME "print numeric version number and exit"),
("css", set_true css,
SOME "print categories of CSS properties"),
- ("endpoints", set_true endpoints,
- SOME "print exposed URL endpoints"),
("print-ccompiler", ZERO printCCompiler,
SOME "print C compiler and exit"),
("print-cinclude", ZERO printCInclude,
@@ -220,6 +217,8 @@ fun oneRun args =
SOME "serve JavaScript as <file>"),
("sql", ONE ("<file>", Settings.setSql o SOME),
SOME "output sql script as <file>"),
+ ("endpoints", ONE ("<file>", Settings.setEndpoints o SOME),
+ SOME "output exposed URL endpoints in JSON as <file>"),
("static", call_true Settings.setStaticLinking,
SOME "enable static linking"),
("stop", ONE ("<phase>", Compiler.setStop),
@@ -271,8 +270,8 @@ fun oneRun args =
" only one is allowed.\nSpecified projects: "^
String.concatWith ", " files)
in
- case (!css, !demo, !tutorial, !endpoints) of
- (true, _, _, _) =>
+ case (!css, !demo, !tutorial) of
+ (true, _, _) =>
(case Compiler.run Compiler.toCss job of
NONE => OS.Process.failure
| SOME {Overall = ov, Classes = cl} =>
@@ -285,24 +284,13 @@ fun oneRun args =
app (print o Css.othersToString) ots;
print "\n")) cl;
OS.Process.success))
- | (_, SOME (prefix, guided), _, _) =>
+ | (_, SOME (prefix, guided), _) =>
if Demo.make' {prefix = prefix, dirname = job, guided = guided} then
OS.Process.success
else
OS.Process.failure
- | (_, _, true, _) => (Tutorial.make job;
+ | (_, _, true) => (Tutorial.make job;
OS.Process.success)
- | (_, _, _, true) =>
- (case Compiler.run Compiler.toEndpoints job of
- NONE => OS.Process.failure
- | SOME es =>
- let
- val r = Endpoints.p_report es
- in
- Print.eprint r;
- print "\n";
- OS.Process.success
- end)
| _ =>
if !tc then
(Compiler.check Compiler.toElaborate job;
diff --git a/src/settings.sig b/src/settings.sig
index a6a9c5fc..97d56b45 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -240,6 +240,9 @@ signature SETTINGS = sig
val setSql : string option -> unit
val getSql : unit -> string option
+ val setEndpoints : string option -> unit
+ val getEndpoints : unit -> string option
+
val setCoreInline : int -> unit
val getCoreInline : unit -> int
diff --git a/src/settings.sml b/src/settings.sml
index f42df135..0e999587 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -703,6 +703,10 @@ val sql = ref (NONE : string option)
fun setSql so = sql := so
fun getSql () = !sql
+val endpoints = ref (NONE : string option)
+fun setEndpoints so = endpoints := so
+fun getEndpoints () = !endpoints
+
val coreInline = ref 5
fun setCoreInline n = coreInline := n
fun getCoreInline () = !coreInline
@@ -729,7 +733,7 @@ fun getSigFile () = !sigFile
val fileCache = ref (NONE : string option)
fun setFileCache v =
- (if Option.isSome v andalso (case #supportsSHA512 (currentDbms ()) of NONE => true
+ (if Option.isSome v andalso (case #supportsSHA512 (currentDbms ()) of NONE => true
| SOME _ => false) then
ErrorMsg.error "The selected database engine is incompatible with file caching."
else
@@ -1007,6 +1011,7 @@ fun reset () =
dbstring := NONE;
exe := NONE;
sql := NONE;
+ endpoints := NONE;
coreInline := 5;
monoInline := 5;
staticLinking := false;