summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Artyom Shalkhakov <artyom.shalkhakov@gmail.com>2019-01-07 15:54:06 +0200
committerGravatar Artyom Shalkhakov <artyom.shalkhakov@gmail.com>2019-01-07 15:54:06 +0200
commite6c93e5b8ed862d096d2120aa0be2a125b332776 (patch)
treead5632a47e57edb07c89d51b0ddab8b1cdd7d152 /src
parent4ada57be570bfbe18137c5b37ed5e0d327de82db (diff)
-endpoints switch to view all endpoints defined in JSON format
Diffstat (limited to 'src')
-rw-r--r--src/compiler.sig1
-rw-r--r--src/compiler.sml7
-rw-r--r--src/endpoints.sig41
-rw-r--r--src/endpoints.sml78
-rw-r--r--src/main.mlton.sml28
5 files changed, 148 insertions, 7 deletions
diff --git a/src/compiler.sig b/src/compiler.sig
index 09c913f8..d4521b9f 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -171,6 +171,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 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 868dd628..4ef9ba19 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -1429,6 +1429,13 @@ val mono_opt = {
print = MonoPrint.p_file MonoEnv.empty
}
+val endpoints = {
+ func = Endpoints.summarize,
+ print = Endpoints.p_report
+}
+
+val toEndpoints = transform endpoints "endpoints" o toMonoize
+
val toMono_opt1 = transform mono_opt "mono_opt1" o toMonoize
val untangle = {
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
diff --git a/src/endpoints.sml b/src/endpoints.sml
new file mode 100644
index 00000000..22186cbb
--- /dev/null
+++ b/src/endpoints.sml
@@ -0,0 +1,78 @@
+(* Copyright (c) 2010, 2013, 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.
+ *)
+
+structure Endpoints :> ENDPOINTS = struct
+
+open Print.PD
+open Print
+
+open Mono
+
+datatype method = GET | POST
+
+fun methodToString GET = "GET"
+ | methodToString POST = "POST"
+
+type endpoint = {Method : method, Url : string}
+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_report {Endpoints = el} =
+ box [string "{\"endpoints\":",
+ space,
+ string "[",
+ p_list_sep (box [string ",", newline]) p_endpoint el,
+ string "]}"]
+
+fun summarize file =
+ let
+ fun exportKindToMethod (Link _) = GET
+ | exportKindToMethod (Action _) = POST
+ | exportKindToMethod (Rpc _) = POST
+ | exportKindToMethod (Extern _) = POST
+
+ fun decl ((d, _), st as endpoints) =
+ let
+ in
+ case d of
+ DExport (ek, id, i, tl, rt, f) =>
+ {Method = exportKindToMethod ek, Url = id} :: st
+ | _ => st
+ end
+
+ val (decls, _) = file
+ val ep = foldl decl [] decls
+ in
+ {Endpoints = ep}
+ end
+
+end
diff --git a/src/main.mlton.sml b/src/main.mlton.sml
index 99005df5..56d98587 100644
--- a/src/main.mlton.sml
+++ b/src/main.mlton.sml
@@ -49,7 +49,7 @@ fun parse_flags flag_info args =
| "--h" => "-help"
| "--help" => "-help"
| _ => arg
-
+
fun loop [] : string list = []
| loop (arg :: args) =
let
@@ -114,6 +114,7 @@ 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;
@@ -162,12 +163,14 @@ 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,
SOME "print directory of C headers and exit"),
("ccompiler", ONE ("<program>", Settings.setCCompiler),
- SOME "set the C compiler to <program>"),
+ SOME "set the C compiler to <program>"),
("demo", ONE ("<prefix>", fn prefix =>
demo := SOME (prefix, false)),
NONE),
@@ -268,8 +271,8 @@ fun oneRun args =
" only one is allowed.\nSpecified projects: "^
String.concatWith ", " files)
in
- case (!css, !demo, !tutorial) of
- (true, _, _) =>
+ case (!css, !demo, !tutorial, !endpoints) of
+ (true, _, _, _) =>
(case Compiler.run Compiler.toCss job of
NONE => OS.Process.failure
| SOME {Overall = ov, Classes = cl} =>
@@ -282,13 +285,24 @@ 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;
- OS.Process.success)
+ | (_, _, 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;