From e6c93e5b8ed862d096d2120aa0be2a125b332776 Mon Sep 17 00:00:00 2001 From: Artyom Shalkhakov Date: Mon, 7 Jan 2019 15:54:06 +0200 Subject: -endpoints switch to view all endpoints defined in JSON format --- src/endpoints.sig | 41 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) create mode 100644 src/endpoints.sig (limited to 'src/endpoints.sig') diff --git a/src/endpoints.sig b/src/endpoints.sig new file mode 100644 index 00000000..d766eb43 --- /dev/null +++ b/src/endpoints.sig @@ -0,0 +1,41 @@ +(* Copyright (c) 2010, Adam Chlipala + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * - Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * - Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * - The names of contributors may not be used to endorse or promote products + * derived from this software without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. + *) + +signature ENDPOINTS = sig + + datatype method = GET | POST + val methodToString : method -> string + + type endpoint = {Method : method, Url : string} + val p_endpoint : endpoint Print.printer + + type report = {Endpoints : endpoint list} + val p_report : report Print.printer + + val summarize : Mono.file -> report + +end -- cgit v1.2.3 From 6b3886a9cf4b0cc16d156cc5cb6b8b5ec9b85f05 Mon Sep 17 00:00:00 2001 From: Artyom Shalkhakov Date: Mon, 7 Jan 2019 16:45:46 +0200 Subject: Including JS and other static files into endpoints --- src/endpoints.sig | 2 +- src/endpoints.sml | 30 +++++++++++++++++++++++------- 2 files changed, 24 insertions(+), 8 deletions(-) (limited to 'src/endpoints.sig') diff --git a/src/endpoints.sig b/src/endpoints.sig index d766eb43..852f78ce 100644 --- a/src/endpoints.sig +++ b/src/endpoints.sig @@ -30,7 +30,7 @@ signature ENDPOINTS = sig datatype method = GET | POST val methodToString : method -> string - type endpoint = {Method : method, Url : string} + type endpoint = {Method : method, Url : string, ContentType : string option, LastModified : Time.time option} val p_endpoint : endpoint Print.printer type report = {Endpoints : endpoint list} diff --git a/src/endpoints.sml b/src/endpoints.sml index 22186cbb..c4a31738 100644 --- a/src/endpoints.sml +++ b/src/endpoints.sml @@ -37,14 +37,20 @@ datatype method = GET | POST fun methodToString GET = "GET" | methodToString POST = "POST" -type endpoint = {Method : method, Url : string} +type endpoint = {Method : method, Url : string, ContentType : string option, LastModified : Time.time option} type report = {Endpoints : endpoint list} -fun p_endpoint {Method = m, Url = u} = - box [string "{", - string "\"method\": \"", string (methodToString m), string "\",", - string "\"url\": \"", string u, string "\"", - string "}"] +fun p_endpoint {Method = m, Url = u, ContentType = oct, LastModified = olm} = + let + val rfcFmt = "%a, %d %b %Y %H:%M:%S GMT" + in + box [string "{", + string "\"method\": \"", string (methodToString m), string "\", ", + string "\"url\": \"", string u, string "\", ", + string "\"content-type\": ", (case oct of SOME ct => box [string "\"", string ct, string"\""] + | NONE => string "null"), + string "}"] + end fun p_report {Endpoints = el} = box [string "{\"endpoints\":", @@ -65,12 +71,22 @@ fun summarize file = in case d of DExport (ek, id, i, tl, rt, f) => - {Method = exportKindToMethod ek, Url = id} :: st + {Method = exportKindToMethod ek, Url = id, LastModified = NONE, ContentType = NONE} :: st | _ => st end val (decls, _) = file val ep = foldl decl [] decls + + fun binfile ({Uri = u, ContentType = ct, LastModified = lm, Bytes = _ }, st) = + {Method = GET, Url = u, LastModified = SOME lm, ContentType = ct} :: st + + val ep = foldl binfile ep (Settings.listFiles ()) + + fun jsfile ({Filename = f, Content = _}, st) = + {Method = GET, Url = f, LastModified = NONE, ContentType = SOME "text/javascript"} :: st + + val ep = foldl jsfile ep (Settings.listJsFiles ()) in {Endpoints = ep} end -- cgit v1.2.3 From db68fd7f8dd17fda410ea06e7076e11ee2c57afc Mon Sep 17 00:00:00 2001 From: Artyom Shalkhakov Date: Mon, 7 Jan 2019 20:03:42 +0200 Subject: Fixing the author in copyright blurb. --- src/endpoints.sig | 2 +- src/endpoints.sml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'src/endpoints.sig') diff --git a/src/endpoints.sig b/src/endpoints.sig index 852f78ce..f2c3c305 100644 --- a/src/endpoints.sig +++ b/src/endpoints.sig @@ -1,4 +1,4 @@ -(* Copyright (c) 2010, Adam Chlipala +(* Copyright (c) 2019, Artyom Shalkhakov * All rights reserved. * * Redistribution and use in source and binary forms, with or without diff --git a/src/endpoints.sml b/src/endpoints.sml index c4a31738..bb0b1d66 100644 --- a/src/endpoints.sml +++ b/src/endpoints.sml @@ -1,4 +1,4 @@ -(* Copyright (c) 2010, 2013, Adam Chlipala +(* Copyright (c) 2019 Artyom Shalkhakov * All rights reserved. * * Redistribution and use in source and binary forms, with or without -- cgit v1.2.3 From ba1871b3b9cc669c43420f993719690b45326e2f Mon Sep 17 00:00:00 2001 From: Artyom Shalkhakov Date: Sat, 12 Jan 2019 16:20:14 +0200 Subject: Including app.js in output of endpoints --- src/cjr_print.sml | 6 ++++-- src/compiler.sig | 4 +++- src/compiler.sml | 29 +++++++++++++++++++++++++---- src/demo.sml | 4 ++++ src/endpoints.sig | 5 ++++- src/endpoints.sml | 25 ++++++++++++++++++++++++- src/main.mlton.sml | 24 ++++++------------------ src/settings.sig | 3 +++ src/settings.sml | 7 ++++++- 9 files changed, 79 insertions(+), 28 deletions(-) (limited to 'src/endpoints.sig') 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 @@ -87,6 +96,20 @@ fun summarize file = {Method = GET, Url = f, LastModified = NONE, ContentType = SOME "text/javascript"} :: st 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 "), ("sql", ONE ("", Settings.setSql o SOME), SOME "output sql script as "), + ("endpoints", ONE ("", Settings.setEndpoints o SOME), + SOME "output exposed URL endpoints in JSON as "), ("static", call_true Settings.setStaticLinking, SOME "enable static linking"), ("stop", ONE ("", 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; -- cgit v1.2.3