diff options
Diffstat (limited to 'stdlib/source/library')
-rw-r--r-- | stdlib/source/library/lux/control/aspect.lux | 8 | ||||
-rw-r--r-- | stdlib/source/library/lux/documentation.lux | 81 | ||||
-rw-r--r-- | stdlib/source/library/lux/meta.lux | 14 | ||||
-rw-r--r-- | stdlib/source/library/lux/test/unit.lux | 2 | ||||
-rw-r--r-- | stdlib/source/library/lux/world/net/http/route.lux | 77 | ||||
-rw-r--r-- | stdlib/source/library/lux/world/net/http/server.lux | 193 |
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 !)))))) |