-endpoints switch to view all endpoints defined in JSON format

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;