Can now mark definitions as deprecated in their documentation.

6 files changed, 240 insertions, 135 deletions

diff --git a/stdlib/source/library/lux/control/aspect.lux b/stdlib/source/library/lux/control/aspect.lux
index eda6a78c7..df37fce28 100644
--- a/stdlib/source/library/lux/control/aspect.lux
+++ b/stdlib/source/library/lux/control/aspect.lux
@@ -35,16 +35,10 @@
 (type .public (Advice value)
   (-> value value))
 
-(type .public After
-  Advice)
-
-(type .public (Around input output)
-  (Advice (-> input output)))
-
 (def .public (before pre)
   (All (_ input output)
     (-> (-> input input)
-        (Around input output)))
+        (Advice (-> input output))))
   (function (_ it input)
     (it (pre input))))
 
diff --git a/stdlib/source/library/lux/documentation.lux b/stdlib/source/library/lux/documentation.lux
index da27d4a1a..200daa9eb 100644
--- a/stdlib/source/library/lux/documentation.lux
+++ b/stdlib/source/library/lux/documentation.lux
@@ -1,6 +1,7 @@
 (.require
  [library
-  [lux (.except Definition Module Declaration #Definition #module)
+  [lux (.except Definition Module Declaration #Definition #module comment)
+   ["[0]" debug]
    [abstract
     [monad (.only do)]
     ["[0]" enum]]
@@ -133,22 +134,30 @@
      [syntax.open_tuple   syntax.close_tuple   .#Tuple])
     ))
 
-(def blank_line
-  Text
-  (format \n \n))
-
-(def (fragment_documentation module fragment)
-  (-> Text Fragment Text)
-  (when fragment
-    {#Comment comment}
-    (format "... " comment)
-
-    {#Code example}
-    (let [reference_column (..reference_column example)
-          [location _] example]
-      (|> example
-          (..code_documentation module (has .#column reference_column location) reference_column)
-          product.right))))
+(def .public (comment it module)
+  (-> Text
+      (-> Text (Markdown Block)))
+  (<| (md.code "clojure")
+      (format "... " it)))
+
+(def (example' it module)
+  (-> Code
+      (-> Text (Markdown Block)))
+  (<| (md.code "clojure")
+      (let [reference_column (..reference_column it)
+            [location _] it]
+        (|> it
+            (..code_documentation module (has .#column reference_column location) reference_column)
+            product.right))))
+
+(def .public example
+  (template (_ it)
+    [((debug.private ..example') (' it))]))
+
+(def .public (deprecated when module)
+  (-> Text
+      (-> Text (Markdown Block)))
+  (md.paragraph (md.text (format "Deprecated: " when))))
 
 (def parameter_type_name
   (-> Nat Text)
@@ -455,30 +464,6 @@
       _
       (in name))))
 
-(def example_separator
-  Code
-  (let [c/01 "...."
-        c/04 (format c/01 c/01 c/01 c/01)
-        c_16 (format c/04 c/04 c/04 c/04)]
-    (code.text (format blank_line
-                       c_16 \n c_16
-                       blank_line))))
-
-(.type Example
-  (List Fragment))
-
-(def example
-  (Parser Example)
-  (<code>.tuple (<>.many ..fragment)))
-
-(def (example_documentation module example)
-  (-> Text Example Code)
-  (|> example
-      (list#each (..fragment_documentation module))
-      (list.interposed ..blank_line)
-      (text.interposed "")
-      code.text))
-
 (.type Declaration
   [Symbol (List Text)])
 
@@ -527,9 +512,10 @@
 (def definition_documentation
   (syntax (_ [[name parameters] ..declaration
               description ..description
-              examples (<>.some ..example)])
+              examples (<>.some <code>.any)])
     (do meta.monad
-      [minimal (expansion.single (` (..minimal_definition_documentation
+      [.let [module (product.left name)]
+       minimal (expansion.single (` (..minimal_definition_documentation
                                      ((, (code.symbol name))
                                       (,* (list#each code.local parameters))))))]
       (in (list (` (all md.then
@@ -549,10 +535,11 @@
                               (list)
                               
                               _
-                              (list (` (<| (md.code "clojure")
-                                           (%.format (,* (|> examples
-                                                             (list#each (..example_documentation (product.left name)))
-                                                             (list.interposed ..example_separator))))))))))
+                              (list (` (all md.then
+                                            (,* (list#each (function (_ example)
+                                                             (` ((, example) (, (code.text module)))))
+                                                           examples))
+                                            ))))))
                    ))))))
 
 (.type .public Definition
diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux
index cade6f127..21a2db376 100644
--- a/stdlib/source/library/lux/meta.lux
+++ b/stdlib/source/library/lux/meta.lux
@@ -510,12 +510,20 @@
                             {.#Default _}
                             {.#None}))
                         it)]]
-    (monad.each ! (function (_ [name exported? it])
+    (monad.each ! (function (again [name [exported? it]])
                     (when it
                       {.#Left de_aliased}
                       (do !
-                        [de_aliased (export de_aliased)]
-                        (in [name [exported? de_aliased]]))
+                        [[_ definition] (..definition de_aliased)]
+                        (when definition
+                          {.#Alias de_aliased}
+                          (again [name [exported? {.#Left de_aliased}]])
+                          
+                          {.#Definition definition}
+                          (in [name [exported? definition]])
+
+                          {.#Default _}
+                          (undefined)))
                       
                       {.#Right definition}
                       (in [name [exported? definition]])))
diff --git a/stdlib/source/library/lux/test/unit.lux b/stdlib/source/library/lux/test/unit.lux
index 14b09f014..86df9efd0 100644
--- a/stdlib/source/library/lux/test/unit.lux
+++ b/stdlib/source/library/lux/test/unit.lux
@@ -152,7 +152,7 @@
               test <code>.any])
     (do meta.monad
       [.let [module (symbol.module module)]
-       definitions (meta.definitions module)
+       definitions (meta.resolved_globals module)
        .let [coverage (|> definitions
                           (list#mix (function (_ [short [exported? _]] aggregate)
                                       (if exported?
diff --git a/stdlib/source/library/lux/world/net/http/route.lux b/stdlib/source/library/lux/world/net/http/route.lux
deleted file mode 100644
index bcb7aa4a8..000000000
--- a/stdlib/source/library/lux/world/net/http/route.lux
+++ /dev/null
@@ -1,77 +0,0 @@
-(.require
- [library
-  [lux (.except or)
-   [control
-    [monad (.only do)]
-    ["[0]" maybe]
-    [concurrency
-     ["[0]" async]]]
-   [data
-    ["[0]" text]
-    [number
-     ["n" nat]]]
-   [meta
-    [macro
-     ["^" pattern]]]]]
- ["[0]" // (.only URI Server)
-  ["[1][0]" status]
-  ["[1][0]" response]])
-
-(with_template [<scheme> <name>]
-  [(def .public (<name> server)
-     (-> Server Server)
-     (function (_ (^.let request [identification protocol resource message]))
-       (when (the //.#scheme protocol)
-         {<scheme>}
-         (server request)
-
-         _
-         (async.resolved //response.not_found))))]
-
-  [//.#HTTP  http]
-  [//.#HTTPS https]
-  )
-
-(with_template [<method> <name>]
-  [(def .public (<name> server)
-     (-> Server Server)
-     (function (_ (^.let request [identification protocol resource message]))
-       (when (the //.#method resource)
-         {<method>}
-         (server request)
-
-         _
-         (async.resolved //response.not_found))))]
-
-  [//.#Get     get]
-  [//.#Post    post]
-  [//.#Put     put]
-  [//.#Patch   patch]
-  [//.#Delete  delete]
-  [//.#Head    head]
-  [//.#Connect connect]
-  [//.#Options options]
-  [//.#Trace   trace]
-  )
-
-(def .public (uri path server)
-  (-> URI Server Server)
-  (function (_ [identification protocol resource message])
-    (if (text.starts_with? path (the //.#uri resource))
-      (server [identification
-               protocol
-               (revised //.#uri
-                        (|>> (text.clip_since (text.size path)) maybe.trusted)
-                        resource)
-               message])
-      (async.resolved //response.not_found))))
-
-(def .public (or primary alternative)
-  (-> Server Server Server)
-  (function (_ request)
-    (do async.monad
-      [response (primary request)
-       .let [[status message] response]]
-      (if (n.= //status.not_found status)
-        (alternative request)
-        (in response)))))
diff --git a/stdlib/source/library/lux/world/net/http/server.lux b/stdlib/source/library/lux/world/net/http/server.lux
new file mode 100644
index 000000000..43c2b7816
--- /dev/null
+++ b/stdlib/source/library/lux/world/net/http/server.lux
@@ -0,0 +1,193 @@
+(.require
+ [library
+  [lux (.except or static)
+   [abstract
+    ["[0]" monad (.only Monad do)]]
+   [control
+    ["[0]" maybe]
+    ["[0]" try (.only Try)]]
+   [data
+    ["[0]" text (.only)
+     [encoding
+      ["[0]" utf8 (.use "[1]#[0]" codec)]]]
+    [collection
+     ["[0]" list (.use "[1]#[0]" functor mix)]
+     ["[0]" dictionary]]
+    [format
+     ["[0]" json (.only JSON) (.use "[1]#[0]" codec)
+      ["?[1]" \\parser]]]]
+   [math
+    [number
+     ["n" nat]]]
+   [meta
+    [macro
+     ["^" pattern]]]
+   [world
+    ["[0]" environment
+     ["?[1]" \\parser]]]]]
+ ["[0]" // (.only Body)
+  ["[0]" status]
+  ["[0]" cookie]
+  ["[0]" request (.only Request)]
+  ["[0]" response (.only Response)]
+  [//
+   [uri (.only URI)
+    ["[0]" scheme (.use "[1]#[0]" equivalence)]
+    ["[0]" query (.use "[1]#[0]" codec)]]]])
+
+(type .public (Server !)
+  (-> (Monad !) (Request !)
+      (! (Response !))))
+
+(with_template [<scheme> <name>]
+  [(def .public (<name> server)
+     (All (_ !)
+       (-> (Server !)
+           (Server !)))
+     (function (_ ! request)
+       (if (scheme#= <scheme> (the [request.#protocol //.#scheme] request))
+         (server ! request)
+         (at ! in (response.not_found !)))))]
+
+  [scheme.http  http]
+  [scheme.https https]
+  )
+
+(with_template [<method> <name>]
+  [(def .public (<name> server)
+     (All (_ !)
+       (-> (Server !)
+           (Server !)))
+     (function (_ ! request)
+       (when (the [request.#resource //.#method] request)
+         {<method>}
+         (server ! request)
+
+         _
+         (at ! in (response.not_found !)))))]
+
+  [//.#Get     get]
+  [//.#Post    post]
+  [//.#Put     put]
+  [//.#Patch   patch]
+  [//.#Delete  delete]
+  [//.#Head    head]
+  [//.#Connect connect]
+  [//.#Options options]
+  [//.#Trace   trace]
+  )
+
+(def .public (uri path server)
+  (All (_ !)
+    (-> URI (Server !)
+        (Server !)))
+  (function (_ ! request)
+    (if (text.starts_with? path (the [request.#resource //.#uri] request))
+      (server ! (revised [request.#resource //.#uri]
+                         (|>> (text.clip_since (text.size path))
+                              maybe.trusted)
+                         request))
+      (at ! in (response.not_found !)))))
+
+(def .public (or primary alternative)
+  (All (_ !)
+    (-> (Server !) (Server !)
+        (Server !)))
+  (function (_ ! request)
+    (do !
+      [response (primary ! request)
+       .let [[status message] response]]
+      (if (n.= status.not_found status)
+        (alternative ! request)
+        (in response)))))
+
+(def .public (static response)
+  (All (_ !)
+    (-> (Response !)
+        (Server !)))
+  (function (_ ! request)
+    (at ! in response)))
+
+(def (body_text ! body)
+  (All (_ !)
+    (-> (Monad !) (Body !)
+        (! (Try Text))))
+  (do !
+    [blob (body {.#None})]
+    (in (do try.monad
+          [[_ blob] blob]
+          (utf8#decoded blob)))))
+
+(def (failure !)
+  (All (_ !)
+    (-> (Monad !)
+        (Response !)))
+  (response.bad_request ! ""))
+
+(def .public (query parser server)
+  (All (_ ! of)
+    (-> (?environment.Parser of) (-> of (Server !))
+        (Server !)))
+  (function (_ ! request)
+    (let [full (the [request.#resource //.#uri] request)
+          [uri query] (|> full
+                          (text.split_by "?")
+                          (maybe.else [full ""]))]
+      (when (do try.monad
+              [query (query#decoded query)
+               input (?environment.result parser query)]
+              (in [(has [request.#resource //.#uri] uri request)
+                   input]))
+        {try.#Success [request input]}
+        (server input ! request)
+        
+        {try.#Failure error}
+        (at ! in (..failure !))))))
+
+(def .public (text server)
+  (All (_ !)
+    (-> (-> Text (Server !))
+        (Server !)))
+  (function (_ ! request)
+    (do !
+      [?raw (body_text ! (the [request.#message //.#body] request))]
+      (when ?raw
+        {try.#Success content}
+        (server content ! request)
+        
+        {try.#Failure error}
+        (at ! in (..failure !))))))
+
+(def .public (form parser server)
+  (All (_ ! of)
+    (-> (?environment.Parser of) (-> of (Server !))
+        (Server !)))
+  (function (_ ! request)
+    (do !
+      [?body (body_text ! (the [request.#message //.#body] request))]
+      (when (do try.monad
+              [body ?body
+               form (query#decoded body)]
+              (?environment.result parser form))
+        {try.#Success input}
+        (server input ! request)
+        
+        {try.#Failure error}
+        (at ! in (..failure !))))))
+
+(def .public (json parser server)
+  (All (_ ! of)
+    (-> (?json.Parser of) (-> of (Server !))
+        (Server !)))
+  (function (_ ! request)
+    (do !
+      [?raw (body_text ! (the [request.#message //.#body] request))]
+      (when (do try.monad
+              [raw ?raw
+               content (json#decoded raw)]
+              (?json.result parser content))
+        {try.#Success input}
+        (server input ! request)
+        
+        {try.#Failure error}
+        (at ! in (..failure !))))))