aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/library')
-rw-r--r--stdlib/source/library/lux/control/aspect.lux8
-rw-r--r--stdlib/source/library/lux/documentation.lux81
-rw-r--r--stdlib/source/library/lux/meta.lux14
-rw-r--r--stdlib/source/library/lux/test/unit.lux2
-rw-r--r--stdlib/source/library/lux/world/net/http/route.lux77
-rw-r--r--stdlib/source/library/lux/world/net/http/server.lux193
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 !))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 00:10:03 +0000