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/format/lux/data/text.lux | 2 +- 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 +- stdlib/source/specification/lux/abstract/enum.lux | 20 +- stdlib/source/test/lux/control.lux | 2 - stdlib/source/test/lux/control/remember.lux | 130 -------- stdlib/source/test/lux/data/text.lux | 2 +- stdlib/source/test/lux/documentation.lux | 6 +- stdlib/source/test/lux/documentation/remember.lux | 130 ++++++++ stdlib/source/test/lux/world/net.lux | 4 +- stdlib/source/test/lux/world/net/http/request.lux | 226 ++++++++++++++ stdlib/source/test/lux/world/net/mime.lux | 3 + stdlib/source/test/lux/world/net/uri/port.lux | 327 +++++++++++---------- 34 files changed, 891 insertions(+), 598 deletions(-) delete mode 100644 stdlib/source/library/lux/control/remember.lux create mode 100644 stdlib/source/library/lux/documentation/remember.lux delete mode 100644 stdlib/source/test/lux/control/remember.lux create mode 100644 stdlib/source/test/lux/documentation/remember.lux create mode 100644 stdlib/source/test/lux/world/net/http/request.lux (limited to 'stdlib/source') diff --git a/stdlib/source/format/lux/data/text.lux b/stdlib/source/format/lux/data/text.lux index 0b475e609..db6aa5d7a 100644 --- a/stdlib/source/format/lux/data/text.lux +++ b/stdlib/source/format/lux/data/text.lux @@ -51,7 +51,7 @@ (def .public format (syntax (_ [fragments (<>.many .any)]) - (in (.list (` (all .text_composite# (,* fragments))))))) + (in (.list (` (.text_composite# (,* fragments))))))) (with_template [ ] [(def .public 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)) diff --git a/stdlib/source/specification/lux/abstract/enum.lux b/stdlib/source/specification/lux/abstract/enum.lux index f510a345e..569e67181 100644 --- a/stdlib/source/specification/lux/abstract/enum.lux +++ b/stdlib/source/specification/lux/abstract/enum.lux @@ -8,21 +8,25 @@ [test ["_" property (.only Test)]]]] [\\library - ["[0]" /]]) + ["[0]" /]] + [// + ["[0]S" order]]) -(def .public (spec (open "_#[0]") gen_sample) +(def .public (spec (open "/#[0]") random) (All (_ a) (-> (/.Enum a) (Random a) Test)) (do random.monad - [sample gen_sample] + [sample random] (<| (_.for [/.Enum]) (all _.and - (_.test "Successor and predecessor are inverse functions." - (and (_#= (|> sample _#succ _#pred) + (_.for [/.order] + (orderS.spec /#order random)) + (_.coverage [/.succ /.pred] + (and (/#= (|> sample /#succ /#pred) sample) - (_#= (|> sample _#pred _#succ) + (/#= (|> sample /#pred /#succ) sample) - (not (_#= (_#succ sample) + (not (/#= (/#succ sample) sample)) - (not (_#= (_#pred sample) + (not (/#= (/#pred sample) sample)))) )))) diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 67903a051..1643a541d 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -30,7 +30,6 @@ ["[1][0]" pipe] ["[1][0]" reader] ["[1][0]" region] - ["[1][0]" remember] [security ["[1][0]" policy] ["[1][0]" capability]] @@ -80,7 +79,6 @@ /pipe.test /reader.test /region.test - /remember.test ..security /state.test /thread.test diff --git a/stdlib/source/test/lux/control/remember.lux b/stdlib/source/test/lux/control/remember.lux deleted file mode 100644 index 963b3fbc1..000000000 --- a/stdlib/source/test/lux/control/remember.lux +++ /dev/null @@ -1,130 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - ["[0]" monad (.only do)]] - [control - ["[0]" io] - ["[0]" try (.only Try)] - ["[0]" exception]] - [data - ["[0]" product] - ["[0]" text (.only) - ["%" \\format (.only format)]]] - [math - [number (.only hex)] - ["[0]" random (.only Random) (.use "[1]#[0]" monad)]] - ["[0]" meta (.only) - ["[0]" code (.only) - ["<[1]>" \\parser]] - [macro - ["[0]" syntax (.only syntax)] - ["[0]" expansion]]] - [world - [time - ["[0]" date (.only Date)] - ["[0]" instant] - ["[0]" duration]]] - [test - ["_" property (.only Test)]]]] - [\\library - ["[0]" /]]) - -(def deadline (Random Date) random.date) -(def message (Random Text) (random#each %.bit random.bit)) -(def focus (Random Code) (random#each code.bit random.bit)) - -(def (memory macro deadline message focus) - (-> Symbol Date Text (Maybe Code) Code) - (` ((, (code.symbol macro)) - (, (code.text (%.date deadline))) - (, (code.text message)) - (,* (when focus - {.#None} (list) - {.#Some focus} (list focus)))))) - -(def (attempt computation) - (All (_ a) (-> (Meta a) (Meta (Try a)))) - (function (_ compiler) - (when (computation compiler) - {try.#Success [compiler output]} - {try.#Success [compiler {try.#Success output}]} - - {try.#Failure error} - {try.#Success [compiler {try.#Failure error}]}))) - -(def (test_failure deadline message focus failure) - (-> Date Text (Maybe Code) Text Bit) - (and (text.contains? (%.date deadline) failure) - (text.contains? message failure) - (when focus - {.#None} - true - - {.#Some focus} - (text.contains? (%.code focus) failure)))) - -(def test_macro - (syntax (_ [macro .symbol - extra .text]) - (let [now (io.run! instant.now) - today (instant.date now) - yesterday (instant.date (instant.after (duration.inverse duration.week) now)) - tomorrow (instant.date (instant.after duration.week now)) - prng (random.pcg_32 [(hex "0123456789ABCDEF") - (instant.millis now)]) - message (product.right (random.result prng ..message)) - expected (product.right (random.result prng ..focus))] - (do meta.monad - [should_fail0 (..attempt (expansion.complete (..memory macro yesterday message {.#None}))) - should_fail1 (..attempt (expansion.complete (..memory macro yesterday message {.#Some expected}))) - should_succeed0 (..attempt (expansion.complete (..memory macro tomorrow message {.#None}))) - should_succeed1 (..attempt (expansion.complete (..memory macro tomorrow message {.#Some expected})))] - (in (list (code.bit (and (when should_fail0 - {try.#Failure error} - (and (test_failure yesterday message {.#None} error) - (text.contains? extra error)) - - _ - false) - (when should_fail1 - {try.#Failure error} - (and (test_failure yesterday message {.#Some expected} error) - (text.contains? extra error)) - - _ - false) - (when should_succeed0 - {try.#Success (list)} - true - - _ - false) - (when should_succeed1 - {try.#Success (list actual)} - (same? expected actual) - - _ - false) - )))))))) - -(def .public test - Test - (<| (_.covering /._) - (do random.monad - [deadline ..deadline - message ..message - focus ..focus] - (all _.and - (_.coverage [/.must_remember] - (and (test_failure deadline message {.#None} - (exception.error /.must_remember [deadline deadline message {.#None}])) - (test_failure deadline message {.#Some focus} - (exception.error /.must_remember [deadline deadline message {.#Some focus}])))) - (_.coverage [/.remember] - (..test_macro /.remember "")) - (_.coverage [/.to_do] - (..test_macro /.to_do "TODO")) - (_.coverage [/.fix_me] - (..test_macro /.fix_me "FIXME")) - )))) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index d192289cf..1ee5a2bf0 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -166,7 +166,7 @@ right (random.unicode 5)] (_.coverage [\\format.format] (/#= (\\format.format left mid right) - (all .text_composite# left mid right)))) + (.text_composite# left mid right)))) ..codec (,, (with_template [ ] [(do random.monad diff --git a/stdlib/source/test/lux/documentation.lux b/stdlib/source/test/lux/documentation.lux index 6308232c7..83fe198e3 100644 --- a/stdlib/source/test/lux/documentation.lux +++ b/stdlib/source/test/lux/documentation.lux @@ -20,7 +20,9 @@ [test ["_" property (.only Test)]]]] [\\library - ["[0]" /]]) + ["[0]" /]] + ["[0]" / + ["[1][0]" remember]]) (def macro_error (syntax (_ [macro .any]) @@ -81,4 +83,6 @@ [(/.definition g!default (,, (template.text ['definition_description'])))] ))))) + + /remember.test ))))) diff --git a/stdlib/source/test/lux/documentation/remember.lux b/stdlib/source/test/lux/documentation/remember.lux new file mode 100644 index 000000000..963b3fbc1 --- /dev/null +++ b/stdlib/source/test/lux/documentation/remember.lux @@ -0,0 +1,130 @@ +(.require + [library + [lux (.except) + [abstract + ["[0]" monad (.only do)]] + [control + ["[0]" io] + ["[0]" try (.only Try)] + ["[0]" exception]] + [data + ["[0]" product] + ["[0]" text (.only) + ["%" \\format (.only format)]]] + [math + [number (.only hex)] + ["[0]" random (.only Random) (.use "[1]#[0]" monad)]] + ["[0]" meta (.only) + ["[0]" code (.only) + ["<[1]>" \\parser]] + [macro + ["[0]" syntax (.only syntax)] + ["[0]" expansion]]] + [world + [time + ["[0]" date (.only Date)] + ["[0]" instant] + ["[0]" duration]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(def deadline (Random Date) random.date) +(def message (Random Text) (random#each %.bit random.bit)) +(def focus (Random Code) (random#each code.bit random.bit)) + +(def (memory macro deadline message focus) + (-> Symbol Date Text (Maybe Code) Code) + (` ((, (code.symbol macro)) + (, (code.text (%.date deadline))) + (, (code.text message)) + (,* (when focus + {.#None} (list) + {.#Some focus} (list focus)))))) + +(def (attempt computation) + (All (_ a) (-> (Meta a) (Meta (Try a)))) + (function (_ compiler) + (when (computation compiler) + {try.#Success [compiler output]} + {try.#Success [compiler {try.#Success output}]} + + {try.#Failure error} + {try.#Success [compiler {try.#Failure error}]}))) + +(def (test_failure deadline message focus failure) + (-> Date Text (Maybe Code) Text Bit) + (and (text.contains? (%.date deadline) failure) + (text.contains? message failure) + (when focus + {.#None} + true + + {.#Some focus} + (text.contains? (%.code focus) failure)))) + +(def test_macro + (syntax (_ [macro .symbol + extra .text]) + (let [now (io.run! instant.now) + today (instant.date now) + yesterday (instant.date (instant.after (duration.inverse duration.week) now)) + tomorrow (instant.date (instant.after duration.week now)) + prng (random.pcg_32 [(hex "0123456789ABCDEF") + (instant.millis now)]) + message (product.right (random.result prng ..message)) + expected (product.right (random.result prng ..focus))] + (do meta.monad + [should_fail0 (..attempt (expansion.complete (..memory macro yesterday message {.#None}))) + should_fail1 (..attempt (expansion.complete (..memory macro yesterday message {.#Some expected}))) + should_succeed0 (..attempt (expansion.complete (..memory macro tomorrow message {.#None}))) + should_succeed1 (..attempt (expansion.complete (..memory macro tomorrow message {.#Some expected})))] + (in (list (code.bit (and (when should_fail0 + {try.#Failure error} + (and (test_failure yesterday message {.#None} error) + (text.contains? extra error)) + + _ + false) + (when should_fail1 + {try.#Failure error} + (and (test_failure yesterday message {.#Some expected} error) + (text.contains? extra error)) + + _ + false) + (when should_succeed0 + {try.#Success (list)} + true + + _ + false) + (when should_succeed1 + {try.#Success (list actual)} + (same? expected actual) + + _ + false) + )))))))) + +(def .public test + Test + (<| (_.covering /._) + (do random.monad + [deadline ..deadline + message ..message + focus ..focus] + (all _.and + (_.coverage [/.must_remember] + (and (test_failure deadline message {.#None} + (exception.error /.must_remember [deadline deadline message {.#None}])) + (test_failure deadline message {.#Some focus} + (exception.error /.must_remember [deadline deadline message {.#Some focus}])))) + (_.coverage [/.remember] + (..test_macro /.remember "")) + (_.coverage [/.to_do] + (..test_macro /.to_do "TODO")) + (_.coverage [/.fix_me] + (..test_macro /.fix_me "FIXME")) + )))) diff --git a/stdlib/source/test/lux/world/net.lux b/stdlib/source/test/lux/world/net.lux index 885a918e7..ad3a3fa1e 100644 --- a/stdlib/source/test/lux/world/net.lux +++ b/stdlib/source/test/lux/world/net.lux @@ -17,7 +17,8 @@ ["[1]/[0]" header] ["[1]/[0]" status] ["[1]/[0]" version] - ["[1]/[0]" response]] + ["[1]/[0]" response] + ["[1]/[0]" request]] ["[1][0]" uri ["[1]/[0]" encoding] ["[1]/[0]" scheme] @@ -46,6 +47,7 @@ /http/status.test /http/version.test /http/response.test + /http/request.test /uri/encoding.test /uri/scheme.test diff --git a/stdlib/source/test/lux/world/net/http/request.lux b/stdlib/source/test/lux/world/net/http/request.lux new file mode 100644 index 000000000..0d117920f --- /dev/null +++ b/stdlib/source/test/lux/world/net/http/request.lux @@ -0,0 +1,226 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + ["|" pipe] + ["[0]" try]] + [data + ["[0]" identity (.only Identity)] + ["[0]" binary (.use "[1]#[0]" equivalence)] + [text + [encoding + ["[0]" utf8 (.use "[1]#[0]" codec)]]] + [format + ["[0]" json (.use "[1]#[0]" codec) + ["[1]T" \\test]]]] + [math + ["[0]" random (.only Random)] + [number + ["n" nat]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" / (.only) + ["/[1]" // (.only) + ["[0]" header] + [// + ["[0]" mime (.use "[1]#[0]" equivalence)] + [uri + ["[0]" scheme (.use "[1]#[0]" equivalence)] + ["[0]" query (.use "[1]#[0]" codec) + ["[1]T" \\test]]]]]]]) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [expected_text (random.upper_cased 3) + expected_json jsonT.random + expected_form (queryT.random 2) + expected_uri (random.upper_cased 4) + expected_content_length random.nat]) + (_.for [/.Request + /.#identification /.#message /.#protocol /.#resource]) + (`` (all _.and + (_.coverage [/.utf8 /.text] + (and (same? /.utf8 /.text) + (let [it (/.utf8 identity.monad expected_text)] + (and (|> it + (the [/.#message //.#headers]) + (header.one header.content_type) + (|.when + {try.#Success actual} + (mime#= mime.utf_8 actual) + + {try.#Failure error} + false)) + (when ((the [/.#message //.#body] it) {.#None}) + {try.#Success [_ actual]} + (binary#= (utf8#encoded expected_text) + actual) + + {try.#Failure error} + false) + )))) + (_.coverage [/.json] + (let [it (/.json identity.monad expected_json)] + (and (|> it + (the [/.#message //.#headers]) + (header.one header.content_type) + (|.when + {try.#Success actual} + (mime#= mime.json actual) + + {try.#Failure error} + false)) + (when ((the [/.#message //.#body] it) {.#None}) + {try.#Success [_ actual]} + (binary#= (utf8#encoded (json#encoded expected_json)) + actual) + + {try.#Failure error} + false) + ))) + (_.coverage [/.form] + (let [it (/.form identity.monad expected_form)] + (and (|> it + (the [/.#message //.#headers]) + (header.one header.content_type) + (|.when + {try.#Success actual} + (mime#= mime.form actual) + + {try.#Failure error} + false)) + (when ((the [/.#message //.#body] it) {.#None}) + {try.#Success [_ actual]} + (binary#= (utf8#encoded (query#encoded expected_form)) + actual) + + {try.#Failure error} + false) + ))) + (,, (with_template [ ] + [(_.coverage [] + (let [it (is (/.Request Identity) + ( (/.utf8 identity.monad expected_text)))] + (and (|> it + (the [/.#protocol //.#scheme]) + (scheme#= )) + (|> it + (the [/.#message //.#headers]) + (header.one header.content_type) + (|.when + {try.#Success actual} + (mime#= mime.utf_8 actual) + + {try.#Failure error} + false)) + (when ((the [/.#message //.#body] it) {.#None}) + {try.#Success [_ actual]} + (binary#= (utf8#encoded expected_text) + actual) + + {try.#Failure error} + false) + )))] + + [/.http scheme.http] + [/.https scheme.https] + )) + (,, (with_template [ ] + [(_.coverage [] + (let [it (is (/.Request Identity) + ( (/.utf8 identity.monad expected_text)))] + (and (|> it + (the [/.#resource //.#method]) + (|.when + {} + true + + _ + false)) + (|> it + (the [/.#message //.#headers]) + (header.one header.content_type) + (|.when + {try.#Success actual} + (mime#= mime.utf_8 actual) + + {try.#Failure error} + false)) + (when ((the [/.#message //.#body] it) {.#None}) + {try.#Success [_ actual]} + (binary#= (utf8#encoded expected_text) + actual) + + {try.#Failure error} + false) + )))] + + [/.post //.#Post] + [/.get //.#Get] + [/.put //.#Put] + [/.patch //.#Patch] + [/.delete //.#Delete] + [/.head //.#Head] + [/.connect //.#Connect] + [/.options //.#Options] + [/.trace //.#Trace] + )) + (_.coverage [/.uri] + (let [it (is (/.Request Identity) + (/.uri expected_uri (/.utf8 identity.monad expected_text)))] + (and (|> it + (the [/.#resource //.#uri]) + (same? expected_uri)) + (|> it + (the [/.#message //.#headers]) + (header.one header.content_type) + (|.when + {try.#Success actual} + (mime#= mime.utf_8 actual) + + {try.#Failure error} + false)) + (when ((the [/.#message //.#body] it) {.#None}) + {try.#Success [_ actual]} + (binary#= (utf8#encoded expected_text) + actual) + + {try.#Failure error} + false) + ))) + (_.coverage [/.with_header] + (let [it (is (/.Request Identity) + (|> (/.utf8 identity.monad expected_text) + (/.with_header header.content_length expected_content_length)))] + (and (|> it + (the [/.#message //.#headers]) + (header.one header.content_length) + (|.when + {try.#Success actual} + (n.= expected_content_length actual) + + {try.#Failure error} + false)) + (|> it + (the [/.#message //.#headers]) + (header.one header.content_type) + (|.when + {try.#Success actual} + (mime#= mime.utf_8 actual) + + {try.#Failure error} + false)) + (when ((the [/.#message //.#body] it) {.#None}) + {try.#Success [_ actual]} + (binary#= (utf8#encoded expected_text) + actual) + + {try.#Failure error} + false) + ))) + )))) diff --git a/stdlib/source/test/lux/world/net/mime.lux b/stdlib/source/test/lux/world/net/mime.lux index 8c5c84033..c1116ad5a 100644 --- a/stdlib/source/test/lux/world/net/mime.lux +++ b/stdlib/source/test/lux/world/net/mime.lux @@ -89,6 +89,9 @@ [/.video_3gpp2] [/.compressed_7z] + [/.form] + [/.multi_part_form] + [/.utf_8]) (with_template [] [] diff --git a/stdlib/source/test/lux/world/net/uri/port.lux b/stdlib/source/test/lux/world/net/uri/port.lux index 14ffa5059..d91dc1d5d 100644 --- a/stdlib/source/test/lux/world/net/uri/port.lux +++ b/stdlib/source/test/lux/world/net/uri/port.lux @@ -8,7 +8,7 @@ ["[0]" list] ["[0]" set]]] [math - ["[0]" random (.only Random)] + ["[0]" random (.only Random) (.use "[1]#[0]" monad)] [number ["[0]" nat]]] [test @@ -16,162 +16,175 @@ [\\library ["[0]" /]]) -(def .public test - Test - (<| (_.covering /._) - (do [! random.monad] - []) - (`` (all _.and - (with_expansions [ (these /.echo_protocol - /.discard_protocol - /.daytime_protocol - /.quote_of_the_day - /.message_send_protocol - /.character_generator_protocol - /.file_transfer_protocol_data_transfer - /.file_transfer_protocol_control - /.telnet - /.simple_mail_transfer_protocol - /.time_protocol - /.host_name_server_protocol - /.whois - /.domain_name_system - /.gopher - /.finger - /.hypertext_transfer_protocol - /.kerberos - - /.digital_imaging_and_communications_in_medicine - /.remote_user_telnet_service - /.post_office_protocol_2 - /.post_office_protocol_3 - /.open_network_computing_remote_procedure_call - /.simple_file_transfer_protocol - /.network_news_transfer_protocol - /.network_time_protocol - /.internet_message_access_protocol - /.simple_gateway_monitoring_protocol - /.structured_query_language - /.simple_network_management_protocol - /.simple_network_management_protocol_trap - /.secure_neighbor_discovery - /.x_display_manager_control_protocol - /.border_gateway_protocol - /.internet_relay_chat - /.snmp_unix_multiplexer - - /.border_gateway_multicast_protocol - - /.precision_time_protocol_event_messages - /.precision_time_protocol_general_messages - /.lightweight_directory_access_protocol - - /.uninterruptible_power_supply - /.service_location_protocol - /.hypertext_transfer_protocol_secure - /.simple_network_paging_protocol - /.kerberos_change/set_password - - /.remote_procedure_call - /.real_time_streaming_protocol - /.dynamic_host_configuration_protocol/6_client - /.dynamic_host_configuration_protocol/6_server - /.network_news_transfer_protocol_secure - - /.internet_printing_protocol - /.lightweight_directory_access_protocol_secure - /.multicast_source_discovery_protocol - /.label_distribution_protocol - /.application_configuration_access_protocol - /.optimized_link_state_routing_protocol - - /.extensible_provisioning_protocol - /.link_management_protocol - /.secure_internet_live_conferencing_protocol - /.kerberos_administration - - /.certificate_management_protocol - /.network_configuration_protocol/ssh - /.network_configuration_protocol/beep - /.network_configuration_protocol/soap/https - /.network_configuration_protocol/soap/beep - - /.file_transfer_protocol_secure_data_transfer - /.file_transfer_protocol_secure_control - /.telnet/tls - /.internet_message_access_protocol_secure - /.post_office_protocol_3_secure)] - (_.coverage [] +(with_expansions [ (these [/.echo_protocol] + [/.discard_protocol] + [/.daytime_protocol] + [/.quote_of_the_day] + [/.message_send_protocol] + [/.character_generator_protocol] + [/.file_transfer_protocol_data_transfer] + [/.file_transfer_protocol_control] + [/.telnet] + [/.simple_mail_transfer_protocol] + [/.time_protocol] + [/.host_name_server_protocol] + [/.whois] + [/.domain_name_system] + [/.gopher] + [/.finger] + [/.hypertext_transfer_protocol] + [/.kerberos] + + [/.digital_imaging_and_communications_in_medicine] + [/.remote_user_telnet_service] + [/.post_office_protocol_2] + [/.post_office_protocol_3] + [/.open_network_computing_remote_procedure_call] + [/.simple_file_transfer_protocol] + [/.network_news_transfer_protocol] + [/.network_time_protocol] + [/.internet_message_access_protocol] + [/.simple_gateway_monitoring_protocol] + [/.structured_query_language] + [/.simple_network_management_protocol] + [/.simple_network_management_protocol_trap] + [/.secure_neighbor_discovery] + [/.x_display_manager_control_protocol] + [/.border_gateway_protocol] + [/.internet_relay_chat] + [/.snmp_unix_multiplexer] + + [/.border_gateway_multicast_protocol] + + [/.precision_time_protocol_event_messages] + [/.precision_time_protocol_general_messages] + [/.lightweight_directory_access_protocol] + + [/.uninterruptible_power_supply] + [/.service_location_protocol] + [/.hypertext_transfer_protocol_secure] + [/.simple_network_paging_protocol] + [/.kerberos_change/set_password] + + [/.remote_procedure_call] + [/.real_time_streaming_protocol] + [/.dynamic_host_configuration_protocol/6_client] + [/.dynamic_host_configuration_protocol/6_server] + [/.network_news_transfer_protocol_secure] + + [/.internet_printing_protocol] + [/.lightweight_directory_access_protocol_secure] + [/.multicast_source_discovery_protocol] + [/.label_distribution_protocol] + [/.application_configuration_access_protocol] + [/.optimized_link_state_routing_protocol] + + [/.extensible_provisioning_protocol] + [/.link_management_protocol] + [/.secure_internet_live_conferencing_protocol] + [/.kerberos_administration] + + [/.certificate_management_protocol] + [/.network_configuration_protocol/ssh] + [/.network_configuration_protocol/beep] + [/.network_configuration_protocol/soap/https] + [/.network_configuration_protocol/soap/beep] + + [/.file_transfer_protocol_secure_data_transfer] + [/.file_transfer_protocol_secure_control] + [/.telnet/tls] + [/.internet_message_access_protocol_secure] + [/.post_office_protocol_3_secure])] + (def .public random + (Random /.Port) + (`` (all random.either + (,, (with_template [] + [(random#in )] + + + ))))) + + (def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + []) + (`` (all _.and + (_.coverage [(,, (with_template [] + [] + + + ))] (let [options (list ) uniques (set.of_list nat.hash options)] (nat.= (list.size options) - (set.size uniques))))) - (,, (with_template [ ] - [(_.coverage [] - (same? ))] - - [/.file_transfer_protocol_data_transfer /.ftp_data_transfer] - [/.file_transfer_protocol_control /.ftp_control] - [/.simple_mail_transfer_protocol /.smtp] - [/.domain_name_system /.dns] - [/.hypertext_transfer_protocol /.http] - - [/.digital_imaging_and_communications_in_medicine /.dicom] - [/.remote_user_telnet_service /.rtelnet] - [/.post_office_protocol_2 /.pop2] - [/.post_office_protocol_3 /.pop3] - [/.open_network_computing_remote_procedure_call /.onc_rpc] - [/.simple_file_transfer_protocol /.simple_ftp] - [/.network_news_transfer_protocol /.nntp] - [/.network_time_protocol /.ntp] - [/.internet_message_access_protocol /.imap] - [/.simple_gateway_monitoring_protocol /.sgmp] - [/.structured_query_language /.sql] - [/.simple_network_management_protocol /.snmp] - [/.simple_network_management_protocol_trap /.snmp_trap] - [/.secure_neighbor_discovery /.send] - [/.x_display_manager_control_protocol /.xdmcp] - [/.border_gateway_protocol /.bgp] - [/.internet_relay_chat /.irc] - [/.snmp_unix_multiplexer /.smux] - - [/.border_gateway_multicast_protocol /.bgmp] - - [/.precision_time_protocol_event_messages /.ptp_event_messages] - [/.precision_time_protocol_general_messages /.ptp_general_messages] - [/.lightweight_directory_access_protocol /.ldap] - - [/.uninterruptible_power_supply /.ups] - [/.service_location_protocol /.slp] - [/.hypertext_transfer_protocol_secure /.https] - [/.simple_network_paging_protocol /.snpp] - - [/.remote_procedure_call /.rpc] - [/.real_time_streaming_protocol /.rtsp] - [/.dynamic_host_configuration_protocol/6_client /.dhcp/6_client] - [/.dynamic_host_configuration_protocol/6_server /.dhcp/6_server] - [/.network_news_transfer_protocol_secure /.nntps] - - [/.internet_printing_protocol /.ipp] - [/.lightweight_directory_access_protocol_secure /.ldaps] - [/.multicast_source_discovery_protocol /.msdp] - [/.label_distribution_protocol /.ldp] - [/.application_configuration_access_protocol /.acap] - [/.optimized_link_state_routing_protocol /.olsr] - - [/.extensible_provisioning_protocol /.epp] - [/.link_management_protocol /.lmp] - [/.secure_internet_live_conferencing_protocol /.silc] - - [/.certificate_management_protocol /.cmp] - [/.network_configuration_protocol/ssh /.netconf/ssh] - [/.network_configuration_protocol/beep /.netconf/beep] - [/.network_configuration_protocol/soap/https /.netconf/soap/https] - [/.network_configuration_protocol/soap/beep /.netconf/soap/beep] - - [/.file_transfer_protocol_secure_data_transfer /.ftps_data_transfer] - [/.file_transfer_protocol_secure_control /.ftps_control] - [/.internet_message_access_protocol_secure /.imaps] - [/.post_office_protocol_3_secure /.pop3s] - )) - )))) + (set.size uniques)))) + (,, (with_template [ ] + [(_.coverage [] + (same? ))] + + [/.file_transfer_protocol_data_transfer /.ftp_data_transfer] + [/.file_transfer_protocol_control /.ftp_control] + [/.simple_mail_transfer_protocol /.smtp] + [/.domain_name_system /.dns] + [/.hypertext_transfer_protocol /.http] + + [/.digital_imaging_and_communications_in_medicine /.dicom] + [/.remote_user_telnet_service /.rtelnet] + [/.post_office_protocol_2 /.pop2] + [/.post_office_protocol_3 /.pop3] + [/.open_network_computing_remote_procedure_call /.onc_rpc] + [/.simple_file_transfer_protocol /.simple_ftp] + [/.network_news_transfer_protocol /.nntp] + [/.network_time_protocol /.ntp] + [/.internet_message_access_protocol /.imap] + [/.simple_gateway_monitoring_protocol /.sgmp] + [/.structured_query_language /.sql] + [/.simple_network_management_protocol /.snmp] + [/.simple_network_management_protocol_trap /.snmp_trap] + [/.secure_neighbor_discovery /.send] + [/.x_display_manager_control_protocol /.xdmcp] + [/.border_gateway_protocol /.bgp] + [/.internet_relay_chat /.irc] + [/.snmp_unix_multiplexer /.smux] + + [/.border_gateway_multicast_protocol /.bgmp] + + [/.precision_time_protocol_event_messages /.ptp_event_messages] + [/.precision_time_protocol_general_messages /.ptp_general_messages] + [/.lightweight_directory_access_protocol /.ldap] + + [/.uninterruptible_power_supply /.ups] + [/.service_location_protocol /.slp] + [/.hypertext_transfer_protocol_secure /.https] + [/.simple_network_paging_protocol /.snpp] + + [/.remote_procedure_call /.rpc] + [/.real_time_streaming_protocol /.rtsp] + [/.dynamic_host_configuration_protocol/6_client /.dhcp/6_client] + [/.dynamic_host_configuration_protocol/6_server /.dhcp/6_server] + [/.network_news_transfer_protocol_secure /.nntps] + + [/.internet_printing_protocol /.ipp] + [/.lightweight_directory_access_protocol_secure /.ldaps] + [/.multicast_source_discovery_protocol /.msdp] + [/.label_distribution_protocol /.ldp] + [/.application_configuration_access_protocol /.acap] + [/.optimized_link_state_routing_protocol /.olsr] + + [/.extensible_provisioning_protocol /.epp] + [/.link_management_protocol /.lmp] + [/.secure_internet_live_conferencing_protocol /.silc] + + [/.certificate_management_protocol /.cmp] + [/.network_configuration_protocol/ssh /.netconf/ssh] + [/.network_configuration_protocol/beep /.netconf/beep] + [/.network_configuration_protocol/soap/https /.netconf/soap/https] + [/.network_configuration_protocol/soap/beep /.netconf/soap/beep] + + [/.file_transfer_protocol_secure_data_transfer /.ftps_data_transfer] + [/.file_transfer_protocol_secure_control /.ftps_control] + [/.internet_message_access_protocol_secure /.imaps] + [/.post_office_protocol_3_secure /.pop3s] + )) + ))))) -- cgit v1.2.3