From ae4c0a4746d59b552ebeba166a43ce756dd265af Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 6 Nov 2022 20:52:21 -0400 Subject: More efficient code-generation for text composition. --- stdlib/source/library/lux.lux | 23 +- stdlib/source/library/lux/abstract/comonad.lux | 2 +- stdlib/source/library/lux/abstract/monad.lux | 2 +- .../library/lux/control/concurrency/thread.lux | 5 +- stdlib/source/library/lux/control/exception.lux | 16 +- stdlib/source/library/lux/control/remember.lux | 83 -------- stdlib/source/library/lux/control/try.lux | 5 +- stdlib/source/library/lux/data/text.lux | 6 +- .../source/library/lux/documentation/remember.lux | 83 ++++++++ stdlib/source/library/lux/math/number/frac.lux | 15 +- stdlib/source/library/lux/math/number/i64.lux | 5 +- stdlib/source/library/lux/math/number/nat.lux | 5 +- stdlib/source/library/lux/math/number/rev.lux | 5 +- .../language/lux/phase/extension/analysis/lux.lux | 13 +- .../lux/phase/extension/generation/jvm/common.lux | 79 ++++++- stdlib/source/library/lux/meta/location.lux | 13 +- stdlib/source/library/lux/world/net/http.lux | 4 +- .../source/library/lux/world/net/http/client.lux | 3 +- .../source/library/lux/world/net/http/request.lux | 234 ++++++++++----------- stdlib/source/library/lux/world/net/mime.lux | 4 + .../source/library/lux/world/net/uri/encoding.lux | 18 +- stdlib/source/library/lux/world/time/day.lux | 7 +- stdlib/source/library/lux/world/time/month.lux | 7 +- 23 files changed, 340 insertions(+), 297 deletions(-) delete mode 100644 stdlib/source/library/lux/control/remember.lux create mode 100644 stdlib/source/library/lux/documentation/remember.lux (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index d8ef5fd2f..9250c2cc6 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -1260,8 +1260,8 @@ (def' .private quantification_level Text (.text_composite# double_quote - (.text_composite# "quantification_level" - double_quote))) + "quantification_level" + double_quote)) (def' .private quantified {#Function Code Code} @@ -4295,7 +4295,7 @@ (function (again left right) (when (..text#split_by pattern right) {#Some [pre post]} - (again (all .text_composite# left pre replacement) post) + (again (.text_composite# left pre replacement) post) {#None} (.text_composite# left right)))) @@ -4303,7 +4303,7 @@ (def (alias_stand_in index) (-> Nat Text) - (all .text_composite# "[" (nat#encoded index) "]")) + (.text_composite# "[" (nat#encoded index) "]")) (def (module_alias context aliased) (-> (List Text) Text Text) @@ -4368,7 +4368,7 @@ (when (relative_ups 0 module) 0 (meta#in (if nested? - (all .text_composite# relative_root ..module_separator module) + (.text_composite# relative_root ..module_separator module) module)) relatives @@ -4385,10 +4385,9 @@ 0 prefix _ (all text#composite prefix ..module_separator clean))] (meta#in output)) - (failure (all .text_composite# - "Cannot climb the module hierarchy..." \n - "Importing module: " module \n - " Relative Root: " relative_root \n)))))) + (failure (.text_composite# "Cannot climb the module hierarchy..." \n + "Importing module: " module \n + " Relative Root: " relative_root \n)))))) (def (imports_parser nested? relative_root context imports) (-> Bit Text (List Text) (List Code) (Meta (List Importation))) @@ -5463,10 +5462,10 @@ (do meta#monad [location location .let [[module line column] location - location (all .text_composite# (text#encoded module) "," (nat#encoded line) "," (nat#encoded column)) - message (all .text_composite# "Undefined behavior at " location)]] + location (.text_composite# (text#encoded module) "," (nat#encoded line) "," (nat#encoded column)) + message (.text_composite# "Undefined behavior at " location)]] (exec - (.log!# (all .text_composite# "WARNING: " message)) + (.log!# (.text_composite# "WARNING: " message)) (in (list (` (..panic! (, (text$ message)))))))) _ diff --git a/stdlib/source/library/lux/abstract/comonad.lux b/stdlib/source/library/lux/abstract/comonad.lux index c62c42674..99f3fb425 100644 --- a/stdlib/source/library/lux/abstract/comonad.lux +++ b/stdlib/source/library/lux/abstract/comonad.lux @@ -40,7 +40,7 @@ {.#Some bindings} (let [[module short] (symbol ..be) symbol (is (-> Text Code) - (|>> (all .text_composite# module " " short " ") [""] {.#Symbol} [location.dummy])) + (|>> (.text_composite# module " " short " ") [""] {.#Symbol} [location.dummy])) g!_ (symbol "_") g!each (symbol "each") g!disjoint (symbol "disjoint") diff --git a/stdlib/source/library/lux/abstract/monad.lux b/stdlib/source/library/lux/abstract/monad.lux index 6667d75fa..9b4d74dac 100644 --- a/stdlib/source/library/lux/abstract/monad.lux +++ b/stdlib/source/library/lux/abstract/monad.lux @@ -70,7 +70,7 @@ (if (|> bindings list#size .int (.int_%# +2) (.i64_=# +0)) (let [[module short] (symbol ..do) symbol (is (-> Text Code) - (|>> (.all .text_composite# module " " short " ") [""] {.#Symbol} [location.dummy])) + (|>> (.text_composite# module " " short " ") [""] {.#Symbol} [location.dummy])) g!_ (symbol "_") g!each (symbol "each") g!conjoint (symbol "conjoint") diff --git a/stdlib/source/library/lux/control/concurrency/thread.lux b/stdlib/source/library/lux/control/concurrency/thread.lux index 81b2f04c8..b30444a54 100644 --- a/stdlib/source/library/lux/control/concurrency/thread.lux +++ b/stdlib/source/library/lux/control/concurrency/thread.lux @@ -108,9 +108,8 @@ (when (try (io.run! action)) {try.#Failure error} (exec - (debug.log! (all .text_composite# - "ERROR DURING THREAD EXECUTION:" text.new_line - error)) + (debug.log! (.text_composite# "ERROR DURING THREAD EXECUTION:" text.\n + error)) []) {try.#Success _} diff --git a/stdlib/source/library/lux/control/exception.lux b/stdlib/source/library/lux/control/exception.lux index 55ac0667d..49642bc07 100644 --- a/stdlib/source/library/lux/control/exception.lux +++ b/stdlib/source/library/lux/control/exception.lux @@ -147,19 +147,17 @@ ..report)) (.def separator - (let [gap (all .text_composite# text.new_line text.new_line) + (let [gap (.text_composite# text.new_line text.new_line) horizontal_line (|> "-" (list.repeated 64) text.together)] - (all .text_composite# - gap - horizontal_line - gap))) + (.text_composite# gap + horizontal_line + gap))) (.def (decorated prelude error) (-> Text Text Text) - (all .text_composite# - prelude - ..separator - error)) + (.text_composite# prelude + ..separator + error)) (.def .public (with exception message computation) (All (_ e a) (-> (Exception e) e (Try a) (Try a))) diff --git a/stdlib/source/library/lux/control/remember.lux b/stdlib/source/library/lux/control/remember.lux deleted file mode 100644 index be344f2ef..000000000 --- a/stdlib/source/library/lux/control/remember.lux +++ /dev/null @@ -1,83 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [monad (.only do)]] - [control - ["<>" parser (.use "[1]#[0]" functor)] - ["[0]" io] - ["[0]" try] - ["[0]" exception (.only Exception)]] - [data - ["[0]" text - ["%" \\format (.only format)]]] - ["[0]" meta (.only) - ["[0]" code (.only) - ["<[1]>" \\parser (.only Parser)]] - [macro - [syntax (.only syntax)] - ["[0]" template]]] - [world - [time - ["[0]" instant] - ["[0]" date (.only Date) (.use "[1]#[0]" order)]]]]]) - -(exception.def .public (must_remember [deadline today message focus]) - (Exception [Date Date Text (Maybe Code)]) - (exception.report - (list ["Deadline" (%.date deadline)] - ["Today" (%.date today)] - ["Message" message] - ["Code" (when focus - {.#Some focus} - (%.code focus) - - {.#None} - "")]))) - -(def deadline - (Parser Date) - (all <>.either - (<>#each (|>> instant.of_millis instant.date) - .int) - (do <>.monad - [raw .text] - (when (at date.codec decoded raw) - {try.#Success date} - (in date) - - {try.#Failure message} - (<>.failure message))))) - -(def .public remember - (syntax (_ [deadline ..deadline - message .text - focus (<>.maybe .any)]) - (let [now (io.run! instant.now) - today (instant.date now)] - (if (date#< deadline today) - (in (when focus - {.#Some focus} - (list focus) - - {.#None} - (list))) - (meta.failure (exception.error ..must_remember [deadline today message focus])))))) - -(with_template [ ] - [(`` (def .public - (syntax (_ [deadline ..deadline - message .text - focus (<>.maybe .any)]) - (in (list (` (..remember (, (code.text (%.date deadline))) - (, (code.text (format " " message))) - (,* (when focus - {.#Some focus} - (list focus) - - {.#None} - (list))))))))))] - - [to_do "TODO"] - [fix_me "FIXME"] - ) diff --git a/stdlib/source/library/lux/control/try.lux b/stdlib/source/library/lux/control/try.lux index 1a1fae856..70a35df76 100644 --- a/stdlib/source/library/lux/control/try.lux +++ b/stdlib/source/library/lux/control/try.lux @@ -169,6 +169,5 @@ [(if {..#Failure (let [symbol#encoded (`` (.in_module# (,, (static .prelude)) .symbol#encoded))] - (all .text_composite# - "[" (symbol#encoded (symbol ..when)) "]" - " " "Invalid condition!"))})])) + (.text_composite# "[" (symbol#encoded (symbol ..when)) "]" + " " "Invalid condition!"))})])) diff --git a/stdlib/source/library/lux/data/text.lux b/stdlib/source/library/lux/data/text.lux index c66e10c61..6efb9eb0d 100644 --- a/stdlib/source/library/lux/data/text.lux +++ b/stdlib/source/library/lux/data/text.lux @@ -121,7 +121,7 @@ (def .public (enclosed [left right] content) (-> [Text Text] Text Text) - (all .text_composite# left content right)) + (.text_composite# left content right)) (def .public (enclosed' boundary content) (-> Text Text Text) @@ -181,7 +181,7 @@ (<| (maybe.else template) (do maybe.monad [[pre post] (..split_by pattern template)] - (in (all .text_composite# pre replacement post))))) + (in (.text_composite# pre replacement post))))) (for @.js (these (def defined? (macro (_ tokens lux) @@ -217,7 +217,7 @@ right template]) (when (..split_by pattern right) {.#Some [pre post]} - (again (all .text_composite# left pre replacement) post) + (again (.text_composite# left pre replacement) post) {.#None} (.text_composite# left right)))] diff --git a/stdlib/source/library/lux/documentation/remember.lux b/stdlib/source/library/lux/documentation/remember.lux new file mode 100644 index 000000000..be344f2ef --- /dev/null +++ b/stdlib/source/library/lux/documentation/remember.lux @@ -0,0 +1,83 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + ["<>" parser (.use "[1]#[0]" functor)] + ["[0]" io] + ["[0]" try] + ["[0]" exception (.only Exception)]] + [data + ["[0]" text + ["%" \\format (.only format)]]] + ["[0]" meta (.only) + ["[0]" code (.only) + ["<[1]>" \\parser (.only Parser)]] + [macro + [syntax (.only syntax)] + ["[0]" template]]] + [world + [time + ["[0]" instant] + ["[0]" date (.only Date) (.use "[1]#[0]" order)]]]]]) + +(exception.def .public (must_remember [deadline today message focus]) + (Exception [Date Date Text (Maybe Code)]) + (exception.report + (list ["Deadline" (%.date deadline)] + ["Today" (%.date today)] + ["Message" message] + ["Code" (when focus + {.#Some focus} + (%.code focus) + + {.#None} + "")]))) + +(def deadline + (Parser Date) + (all <>.either + (<>#each (|>> instant.of_millis instant.date) + .int) + (do <>.monad + [raw .text] + (when (at date.codec decoded raw) + {try.#Success date} + (in date) + + {try.#Failure message} + (<>.failure message))))) + +(def .public remember + (syntax (_ [deadline ..deadline + message .text + focus (<>.maybe .any)]) + (let [now (io.run! instant.now) + today (instant.date now)] + (if (date#< deadline today) + (in (when focus + {.#Some focus} + (list focus) + + {.#None} + (list))) + (meta.failure (exception.error ..must_remember [deadline today message focus])))))) + +(with_template [ ] + [(`` (def .public + (syntax (_ [deadline ..deadline + message .text + focus (<>.maybe .any)]) + (in (list (` (..remember (, (code.text (%.date deadline))) + (, (code.text (format " " message))) + (,* (when focus + {.#Some focus} + (list focus) + + {.#None} + (list))))))))))] + + [to_do "TODO"] + [fix_me "FIXME"] + ) diff --git a/stdlib/source/library/lux/math/number/frac.lux b/stdlib/source/library/lux/math/number/frac.lux index a25106d63..13c54f28b 100644 --- a/stdlib/source/library/lux/math/number/frac.lux +++ b/stdlib/source/library/lux/math/number/frac.lux @@ -785,14 +785,13 @@ mantissa (..mantissa bits) exponent (//int.- (.int ..double_bias) (..exponent bits)) sign (..sign bits)] - (all .text_composite# - (when (.nat sign) - 1 "-" - 0 "+" - _ (undefined)) - (at encoded (.nat mantissa)) - ".0E" - (at encoded exponent)))) + (.text_composite# (when (.nat sign) + 1 "-" + 0 "+" + _ (undefined)) + (at encoded (.nat mantissa)) + ".0E" + (at encoded exponent)))) (def (decoded representation) (let [negative? (text.starts_with? "-" representation) diff --git a/stdlib/source/library/lux/math/number/i64.lux b/stdlib/source/library/lux/math/number/i64.lux index 8baa67ee5..b7922e45d 100644 --- a/stdlib/source/library/lux/math/number/i64.lux +++ b/stdlib/source/library/lux/math/number/i64.lux @@ -155,9 +155,8 @@ (.text_composite# char output)) output)))) pattern (repetitions (n./ (n.+ size size) ..width) - (.text_composite# - (repetitions size "1") - (repetitions size "0"))) + (.text_composite# (repetitions size "1") + (repetitions size "0"))) high (try.trusted (at n.binary decoded pattern)) low (..right_rotated size high)] diff --git a/stdlib/source/library/lux/math/number/nat.lux b/stdlib/source/library/lux/math/number/nat.lux index 4b8366218..66c29f167 100644 --- a/stdlib/source/library/lux/math/number/nat.lux +++ b/stdlib/source/library/lux/math/number/nat.lux @@ -301,9 +301,8 @@ (function (_ value) (loop (again [input value output ""]) - (let [output' (.text_composite# - ( (.i64_and# mask input)) - output)] + (let [output' (.text_composite# ( (.i64_and# mask input)) + output)] (when (is Nat (.i64_right# input)) 0 output' diff --git a/stdlib/source/library/lux/math/number/rev.lux b/stdlib/source/library/lux/math/number/rev.lux index 4704d7c8a..47b3f52db 100644 --- a/stdlib/source/library/lux/math/number/rev.lux +++ b/stdlib/source/library/lux/math/number/rev.lux @@ -331,9 +331,8 @@ (again (-- idx) true output) (again (-- idx) false - (.text_composite# - (at //nat.decimal encoded digit) - output))))))) + (.text_composite# (at //nat.decimal encoded digit) + output))))))) (def (digits#+! param subject) (-> Digits Digits Digits) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux index 3daa22bc1..3dab02980 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux @@ -97,6 +97,17 @@ (-> Type Type Type Type (-> Text Handler)) (simple (list subjectT param0T param1T) outputT)) +(def .public (variadic input output extension_name) + (-> Type Type (-> Text Handler)) + (function (_ analyse archive args) + (do [! phase.monad] + [_ (typeA.inference output) + argsA (monad.each ! + (|>> (analyse archive) + (typeA.expecting input)) + args)] + (in {analysis.#Extension [.prelude (format extension_name "|generation")] argsA})))) + ... TODO: Get rid of this ASAP (these (exception.def .public (char_text_must_be_size_1 text) @@ -342,7 +353,7 @@ (-> Bundle Bundle) (|>> (install "text_=#" (binary Text Text Bit)) (install "text_<#" (binary Text Text Bit)) - (install "text_composite#" (binary Text Text Text)) + (install "text_composite#" (variadic Text Text)) (install "text_index#" (trinary Nat Text Text (type_literal (Maybe Nat)))) (install "text_size#" (unary Text Nat)) (install "text_char#" (binary Nat Text Nat)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/common.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/common.lux index 5f17ba7cc..4d8a17afa 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/common.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/common.lux @@ -4,8 +4,10 @@ [abstract ["[0]" monad (.only do)]] [control + ["|" pipe] ["<>" parser] - ["[0]" try]] + ["[0]" try] + ["[0]" function]] [data ["[0]" product] [collection @@ -295,15 +297,20 @@ (dictionary.has "f64_encoded#|generation" (unary ..f64::encode)) (dictionary.has "f64_decoded#|generation" (unary ..f64::decode)))) +(def $String::length + (_.invokevirtual ..$String "length" (type.method [(list) (list) type.int (list)]))) + (def (text::size inputG) (Unary (Bytecode Any)) (all _.composite inputG (_.checkcast $String) - (_.invokevirtual ..$String "length" (type.method [(list) (list) type.int (list)])) + $String::length ..lux_int)) -(def no_op (Bytecode Any) (_#in [])) +(def no_op + (Bytecode Any) + (_#in [])) (with_template [ ] [(def ( [paramG subjectG]) @@ -324,12 +331,64 @@ ..lux_int] ) -(def (text::concat [leftG rightG]) - (Binary (Bytecode Any)) - (all _.composite - leftG (_.checkcast $String) - rightG (_.checkcast $String) - (_.invokevirtual ..$String "concat" (type.method [(list) (list ..$String) ..$String (list)])))) +(def text::composite + (Variadic (Bytecode Any)) + (let [$StringBuilder (type.class "java.lang.StringBuilder" (list)) + add_part! (is (-> (Bytecode Any) + (Bytecode Any)) + (function (_ it) + (all _.composite + it + (_.checkcast $String) + ))) + update_size! (is (Bytecode Any) + (all _.composite + _.dup + $String::length + _.dup2_x1 + _.pop2 + _.iadd + )) + new_StringBuilder (is (Bytecode Any) + (all _.composite + (_.new $StringBuilder) + _.dup_x1 + _.swap + (_.invokespecial $StringBuilder "" (type.method [(list) (list type.int) type.void (list)])) + )) + compose_part! (is (Bytecode Any) + (all _.composite + _.swap + (_.invokevirtual $StringBuilder "append" (type.method [(list) (list ..$String) $StringBuilder (list)])) + ))] + (|>> (|.when (list) + (_.string "") + + (list single) + single + + (list left right) + (all _.composite + left (_.checkcast $String) + right (_.checkcast $String) + (_.invokevirtual ..$String "concat" (type.method [(list) (list ..$String) ..$String (list)]))) + + parts + (do [! _.monad] + [_ (_.int (.i64 +0)) + _ (monad.each ! (is (-> (Bytecode Any) + (Bytecode Any)) + (function (_ it) + (all _.composite + (add_part! it) + update_size! + ))) + (list.reversed parts)) + _ new_StringBuilder + _ (monad.each ! (function.constant compose_part!) + parts)] + (_.invokevirtual $StringBuilder "toString" (type.method [(list) (list) ..$String (list)]))) + )))) (def (text::clip [offset! length! subject!]) (Trinary (Bytecode Any)) @@ -367,7 +426,7 @@ (-> Bundle Bundle) (|>> (dictionary.has "text_=#|generation" (binary ..text::=)) (dictionary.has "text_<#|generation" (binary ..text::<)) - (dictionary.has "text_composite#|generation" (binary ..text::concat)) + (dictionary.has "text_composite#|generation" (variadic ..text::composite)) (dictionary.has "text_index#|generation" (trinary ..text::index)) (dictionary.has "text_size#|generation" (unary ..text::size)) (dictionary.has "text_char#|generation" (binary ..text::char)) diff --git a/stdlib/source/library/lux/meta/location.lux b/stdlib/source/library/lux/meta/location.lux index 56eafe44b..cd5bfdd4c 100644 --- a/stdlib/source/library/lux/meta/location.lux +++ b/stdlib/source/library/lux/meta/location.lux @@ -36,16 +36,15 @@ (-> Location Text) (let [separator "," [file line column] it] - (all .text_composite# - "@" - (`` ((.in_module# (,, (static .prelude)) .text#encoded) file)) separator - (`` ((.in_module# (,, (static .prelude)) .nat#encoded) line)) separator - (`` ((.in_module# (,, (static .prelude)) .nat#encoded) column))))) + (.text_composite# "@" + (`` ((.in_module# (,, (static .prelude)) .text#encoded) file)) separator + (`` ((.in_module# (,, (static .prelude)) .nat#encoded) line)) separator + (`` ((.in_module# (,, (static .prelude)) .nat#encoded) column))))) (def \n (.int_char# +10)) (def .public (with location error) (-> Location Text Text) - (all .text_composite# (..format location) \n - error)) + (.text_composite# (..format location) \n + error)) diff --git a/stdlib/source/library/lux/world/net/http.lux b/stdlib/source/library/lux/world/net/http.lux index 05cf85509..d03a8d398 100644 --- a/stdlib/source/library/lux/world/net/http.lux +++ b/stdlib/source/library/lux/world/net/http.lux @@ -2,9 +2,7 @@ [library [lux (.except #version #host) [control - [try (.only Try)] - [concurrency - [frp (.only Channel)]]] + [try (.only Try)]] [data [binary (.only Binary)]]]] [/ diff --git a/stdlib/source/library/lux/world/net/http/client.lux b/stdlib/source/library/lux/world/net/http/client.lux index f3851016a..8ba9a1694 100644 --- a/stdlib/source/library/lux/world/net/http/client.lux +++ b/stdlib/source/library/lux/world/net/http/client.lux @@ -227,7 +227,8 @@ (these))) (def .public (async client) - (-> (Client IO) (Client Async)) + (-> (Client IO) + (Client Async)) (implementation (def (request method url headers data) (|> (at client request method url headers data) diff --git a/stdlib/source/library/lux/world/net/http/request.lux b/stdlib/source/library/lux/world/net/http/request.lux index 477fbf2e3..05b55332a 100644 --- a/stdlib/source/library/lux/world/net/http/request.lux +++ b/stdlib/source/library/lux/world/net/http/request.lux @@ -1,143 +1,127 @@ (.require [library [lux (.except) + [abstract + [monad (.only Monad)]] [control - pipe - ["[0]" monad (.only do)] - ["[0]" maybe] - ["[0]" try (.only Try)] - [concurrency - ["[0]" async (.only Async)] - ["[0]" frp]]] + ["[0]" try]] [data - ["[0]" number - ["n" nat]] - ["[0]" text - ["[0]" encoding]] + ["[0]" binary (.only Binary)] + [text + [encoding + ["[0]" utf8 (.use "[1]#[0]" codec)]]] [format - ["[0]" context (.only Context Property)] - ["[0]" json (.only JSON) - ["<[1]>" \\parser]]] - [collection - ["[0]" list (.use "[1]#[0]" functor mix)] - ["[0]" dictionary]]] - [meta - [macro - ["^" pattern]]] - [world - ["[0]" binary (.only Binary)]]]] - ["[0]" // (.only Body Response Server) - ["[1][0]" response] - ["[1][0]" query] - ["[1][0]" cookie]]) + ["[0]" json (.only JSON) (.use "[1]#[0]" codec)]]]]] + ["[0]" // (.only Body) + ["[0]" version] + ["[0]" header (.only Header)] + ["/[1]" // (.only) + ["[0]" mime] + [uri (.only URI) + ["[0]" scheme] + ["[0]" query (.only Query) (.use "[1]#[0]" codec)]]]]) (type .public (Request !) - [Identification Protocol Resource (Message !)]) + (Record + [#identification //.Identification + #protocol //.Protocol + #resource //.Resource + #message (//.Message !)])) -(type .public (Server !) - (-> (Request !) - (! (Response !)))) +(def (body ! it) + (All (_ !) + (-> (Monad !) Binary + (//.Body !))) + (function (_ _) + (at ! in {try.#Success [(binary.size it) it]}))) -(def .public (static response) - (-> Response Server) - (function (_ request) - (async.resolved response))) +(def .public (utf8 ! it) + (All (_ !) + (-> (Monad !) Text + (Request !))) + [#identification [//.#local [///.#host "" + ///.#port 0] + //.#remote [///.#host "" + ///.#port 0]] + #protocol [//.#version version.v1_1 + //.#scheme scheme.http] + #resource [//.#method {//.#Post} + //.#uri ""] + #message [//.#headers (|> header.empty + (header.has header.content_type mime.utf_8)) + //.#body (body ! (utf8#encoded it))]]) -(def (merge inputs) - (-> (List Binary) Binary) - (let [[_ output] (try.trusted - (monad.mix try.monad - (function (_ input [offset output]) - (let [amount (binary.size input)] - (at try.functor each (|>> [(n.+ amount offset)]) - (binary.copy amount 0 input offset output)))) - [0 (|> inputs - (list#each binary.size) - (list#mix n.+ 0) - binary.empty)] - inputs))] - output)) +(def .public text ..utf8) -(def (read_text_body body) - (-> Body (Async (Try Text))) - (do async.monad - [blobs (frp.list body)] - (in (at encoding.utf8 decoded (merge blobs))))) +(def .public (json ! it) + (All (_ !) + (-> (Monad !) JSON + (Request !))) + [#identification [//.#local [///.#host "" + ///.#port 0] + //.#remote [///.#host "" + ///.#port 0]] + #protocol [//.#version version.v1_1 + //.#scheme scheme.http] + #resource [//.#method {//.#Post} + //.#uri ""] + #message [//.#headers (|> header.empty + (header.has header.content_type mime.json)) + //.#body (body ! (utf8#encoded (json#encoded it)))]]) -(def failure - (//response.bad_request "")) +(def .public (form ! it) + (All (_ !) + (-> (Monad !) Query + (Request !))) + [#identification [//.#local [///.#host "" + ///.#port 0] + //.#remote [///.#host "" + ///.#port 0]] + #protocol [//.#version version.v1_1 + //.#scheme scheme.http] + #resource [//.#method {//.#Post} + //.#uri ""] + #message [//.#headers (|> header.empty + (header.has header.content_type mime.form)) + //.#body (body ! (utf8#encoded (query#encoded it)))]]) -(def .public (json reader server) - (All (_ a) (-> (.Reader a) (-> a Server) Server)) - (function (_ (^.let request [identification protocol resource message])) - (do async.monad - [?raw (read_text_body (the //.#body message))] - (when (do try.monad - [raw ?raw - content (at json.codec decoded raw)] - (json.result content reader)) - {try.#Success input} - (server input request) - - {try.#Failure error} - (async.resolved ..failure))))) +(with_template [ ] + [(def .public + (All (_ !) + (-> (Request !) + (Request !))) + (|>> (has [#protocol //.#scheme] )))] -(def .public (text server) - (-> (-> Text Server) Server) - (function (_ (^.let request [identification protocol resource message])) - (do async.monad - [?raw (read_text_body (the //.#body message))] - (when ?raw - {try.#Success content} - (server content request) - - {try.#Failure error} - (async.resolved ..failure))))) + [http scheme.http] + [https scheme.https] + ) -(def .public (query property server) - (All (_ a) (-> (Property a) (-> a Server) Server)) - (function (_ [identification protocol resource message]) - (let [full (the //.#uri resource) - [uri query] (|> full - (text.split_by "?") - (maybe.else [full ""]))] - (when (do try.monad - [query (//query.parameters query) - input (context.result query property)] - (in [[identification protocol (has //.#uri uri resource) message] - input])) - {try.#Success [request input]} - (server input request) - - {try.#Failure error} - (async.resolved ..failure))))) +(with_template [ ] + [(def .public + (All (_ !) + (-> (Request !) + (Request !))) + (has [#resource //.#method] {}))] -(def .public (form property server) - (All (_ a) (-> (Property a) (-> a Server) Server)) - (function (_ (^.let request [identification protocol resource message])) - (do async.monad - [?body (read_text_body (the //.#body message))] - (when (do try.monad - [body ?body - form (//query.parameters body)] - (context.result form property)) - {try.#Success input} - (server input request) - - {try.#Failure error} - (async.resolved ..failure))))) + [post //.#Post] + [get //.#Get] + [put //.#Put] + [patch //.#Patch] + [delete //.#Delete] + [head //.#Head] + [connect //.#Connect] + [options //.#Options] + [trace //.#Trace] + ) -(def .public (cookies property server) - (All (_ a) (-> (Property a) (-> a Server) Server)) - (function (_ (^.let request [identification protocol resource message])) - (when (do try.monad - [cookies (|> (the //.#headers message) - (dictionary.value "Cookie") - (maybe.else "") - //cookie.get)] - (context.result cookies property)) - {try.#Success input} - (server input request) - - {try.#Failure error} - (async.resolved ..failure)))) +(def .public (uri it) + (All (_ !) + (-> URI (Request !) + (Request !))) + (|>> (has [#resource //.#uri] it))) + +(def .public (with_header it value) + (All (_ ! of) + (-> (Header of) of (Request !) + (Request !))) + (|>> (revised [#message //.#headers] (header.has it value)))) diff --git a/stdlib/source/library/lux/world/net/mime.lux b/stdlib/source/library/lux/world/net/mime.lux index 8e3919836..409e13080 100644 --- a/stdlib/source/library/lux/world/net/mime.lux +++ b/stdlib/source/library/lux/world/net/mime.lux @@ -104,6 +104,10 @@ [audio_3gpp2 "audio/3gpp2"] [video_3gpp2 "video/3gpp2"] [compressed_7z "application/x-7z-compressed"] + + ... https://developer.mozilla.org/en-US/docs/Web/HTTP/Methods/POST + [form "application/x-www-form-urlencoded"] + [multi_part_form "multipart/form-data"] ) (def .public (text encoding) diff --git a/stdlib/source/library/lux/world/net/uri/encoding.lux b/stdlib/source/library/lux/world/net/uri/encoding.lux index 91a5c2020..085d80744 100644 --- a/stdlib/source/library/lux/world/net/uri/encoding.lux +++ b/stdlib/source/library/lux/world/net/uri/encoding.lux @@ -60,10 +60,9 @@ (let [index' (++ index)] (again index' index' - (all .text_composite# - output - (.text_clip# slice_start (nat.- slice_start index) input) - )))] + (.text_composite# output + (.text_clip# slice_start (nat.- slice_start index) input) + )))] )) @@ -71,9 +70,8 @@ (again (++ index) slice_start output))) - (all .text_composite# - output - (.text_clip# slice_start (nat.- slice_start index) input)))))) + (.text_composite# output + (.text_clip# slice_start (nat.- slice_start index) input)))))) ) (def escape (char "%")) @@ -102,9 +100,9 @@ .let [index' (++ encoding_end)]] (again index' index' - (all .text_composite# output - (.text_clip# slice_start (nat.- slice_start index) input) - (text.of_char value)))) + (.text_composite# output + (.text_clip# slice_start (nat.- slice_start index) input) + (text.of_char value)))) (exception.except ..invalid [input]))) _ diff --git a/stdlib/source/library/lux/world/time/day.lux b/stdlib/source/library/lux/world/time/day.lux index 60c30a816..cda78a83f 100644 --- a/stdlib/source/library/lux/world/time/day.lux +++ b/stdlib/source/library/lux/world/time/day.lux @@ -158,10 +158,9 @@ (Exception Nat) (exception.report (list ["Number" (at n.decimal encoded number)] - ["Valid range" (all .text_composite# - (at n.decimal encoded (..number {#Sunday})) - " ~ " - (at n.decimal encoded (..number {#Saturday})))]))) + ["Valid range" (.text_composite# (at n.decimal encoded (..number {#Sunday})) + " ~ " + (at n.decimal encoded (..number {#Saturday})))]))) (def .public (by_number number) (-> Nat (Try Day)) diff --git a/stdlib/source/library/lux/world/time/month.lux b/stdlib/source/library/lux/world/time/month.lux index 93625a2c2..b6fc1f8fa 100644 --- a/stdlib/source/library/lux/world/time/month.lux +++ b/stdlib/source/library/lux/world/time/month.lux @@ -83,10 +83,9 @@ (Exception Nat) (exception.report (list ["Number" (at n.decimal encoded number)] - ["Valid range" (all .text_composite# - (at n.decimal encoded (..number {#January})) - " ~ " - (at n.decimal encoded (..number {#December})))]))) + ["Valid range" (.text_composite# (at n.decimal encoded (..number {#January})) + " ~ " + (at n.decimal encoded (..number {#December})))]))) (def .public (by_number number) (-> Nat (Try Month)) -- cgit v1.2.3