Added routing.

1 files changed, 82 insertions, 0 deletions

diff --git a/stdlib/source/lux/world/net/http/route.lux b/stdlib/source/lux/world/net/http/route.lux
new file mode 100644
index 000000000..188508a5d
--- /dev/null
+++ b/stdlib/source/lux/world/net/http/route.lux
@@ -0,0 +1,82 @@
+(.module:
+  [lux (#- or)
+   [control
+    [monad (#+ do)]
+    [concurrency
+     ["." promise]]]
+   [data
+    ["." maybe]
+    ["." text ("text/." Equivalence<Text>)]]]
+  ["." // (#+ URI Server)
+   ["//." status]
+   ["//." response]])
+
+(do-template [<scheme> <name>]
+  [(def: #export (<name> server)
+     (-> Server Server)
+     (function (_ request)
+       (let [[identification protocol resource message] request]
+         (case (get@ #//.scheme protocol)
+           <scheme>
+           (server request)
+
+           _
+           (promise.resolved //response.not-found)))))]
+
+  [#//.HTTP  http]
+  [#//.HTTPS https]
+  )
+
+(do-template [<method> <name>]
+  [(def: #export (<name> server)
+     (-> Server Server)
+     (function (_ request)
+       (let [[identification protocol resource message] request]
+         (case (get@ #//.method resource)
+           <method>
+           (server request)
+
+           _
+           (promise.resolved //response.not-found)))))]
+
+  [#//.Get     get]
+  [#//.Post    post]
+  [#//.Put     put]
+  [#//.Patch   patch]
+  [#//.Delete  delete]
+  [#//.Head    head]
+  [#//.Connect connect]
+  [#//.Options options]
+  [#//.Trace   trace]
+  )
+
+(def: #export (uri path server)
+  (-> URI Server Server)
+  (function (_ request)
+    (let [[identification protocol resource message] request]
+      (if (text/= path (get@ #//.uri resource))
+        (server request)
+        (promise.resolved //response.not-found)))))
+
+(def: #export (sub path server)
+  (-> URI Server Server)
+  (function (_ request)
+    (let [[identification protocol resource message] request]
+      (if (text.starts-with? path (get@ #//.uri resource))
+        (server [identification
+                 protocol
+                 (update@ #//.uri
+                          (|>> (text.clip' (text.size path)) maybe.assume)
+                          resource)
+                 message])
+        (promise.resolved //response.not-found)))))
+
+(def: #export (or primary alternative)
+  (-> Server Server Server)
+  (function (_ request)
+    (do promise.Monad<Promise>
+      [response (primary request)
+       #let [[status message] response]]
+      (if (n/= //status.not-found status)
+        (alternative request)
+        (wrap response)))))