diff options
author | Eduardo Julian | 2022-11-07 02:48:02 -0400 |
---|---|---|
committer | Eduardo Julian | 2022-11-07 02:48:02 -0400 |
commit | 13c594758482bac0a7550bcb89cfeda8c5f0a1f3 (patch) | |
tree | 251236c17f3fe0fbd7b302d4f143e51a85539cf3 | |
parent | ae4c0a4746d59b552ebeba166a43ce756dd265af (diff) |
Added support for inline testing.
23 files changed, 452 insertions, 79 deletions
diff --git a/documentation/bookmark/game/storytelling.md b/documentation/bookmark/game/storytelling.md index 28613b8b1..b814fd72c 100644 --- a/documentation/bookmark/game/storytelling.md +++ b/documentation/bookmark/game/storytelling.md @@ -1,6 +1,6 @@ # Reference -0. []() +0. [Hook Your Players Fast (Episode 288)](https://www.youtube.com/watch?v=oUFk2ZGYLs8) 0. [Sparking Curiosity-Driven Exploration Through Narrative in 'Outer Wilds'](https://www.youtube.com/watch?v=QaGu9tGCNbI) 0. [Approaching a Pedagogy of Game Writing](https://www.youtube.com/watch?v=24HHIKOA1ZA) 0. [I Beg You, Please Cripple Your Characters](https://www.youtube.com/watch?v=DGe6ehr0dxs) diff --git a/documentation/bookmark/testing/inline.md b/documentation/bookmark/testing/inline.md new file mode 100644 index 000000000..a8d6ce364 --- /dev/null +++ b/documentation/bookmark/testing/inline.md @@ -0,0 +1,4 @@ +# Reference + +0. [Inline Tests](https://arxiv.org/abs/2209.06315) + diff --git a/lux-bootstrapper/src/lux/compiler/cache.clj b/lux-bootstrapper/src/lux/compiler/cache.clj index 301ddb7ef..dd8fb1188 100644 --- a/lux-bootstrapper/src/lux/compiler/cache.clj +++ b/lux-bootstrapper/src/lux/compiler/cache.clj @@ -74,9 +74,9 @@ (defn ^:private process-def-entry [load-def-value module ^String _def-entry] (let [parts (.split _def-entry &&core/datum-separator)] (case (first parts) - "A" (let [[_ _name ^String _alias] parts + "A" (let [[_ _name _exported? ^String _alias] parts [__module __name] (.split _alias &/+name-separator+)] - (&a-module/define-alias module _name (&/T [__module __name]))) + (&a-module/define-alias module _name (= "1" _exported?) (&/T [__module __name]))) "D" (let [[_ _name _exported? _type] parts [def-type _] (&&&type/deserialize-type _type)] (|do [def-value (load-def-value module _name)] diff --git a/lux-bootstrapper/src/lux/compiler/core.clj b/lux-bootstrapper/src/lux/compiler/core.clj index 07cd8c759..f6f5c043f 100644 --- a/lux-bootstrapper/src/lux/compiler/core.clj +++ b/lux-bootstrapper/src/lux/compiler/core.clj @@ -51,6 +51,7 @@ (&/$AliasG [_dmodule _dname]) (str "A" datum-separator ?name + datum-separator (if exported? "1" "0") datum-separator _dmodule &/+name-separator+ _dname ;; Next entry-separator def-entries) diff --git a/stdlib/source/library/lux/meta/compiler/default/init.lux b/stdlib/source/library/lux/meta/compiler/default/init.lux index ac2f31861..18d962303 100644 --- a/stdlib/source/library/lux/meta/compiler/default/init.lux +++ b/stdlib/source/library/lux/meta/compiler/default/init.lux @@ -111,6 +111,18 @@ (moduleA.override_definition [.prelude name] [true {.#Default [.Analysis handler]}])))))] (in []))) +(def (with_synthesis_defaults bundle) + (-> ///synthesis.Bundle + (Operation Any)) + (do [! ///phase.monad] + [_ (|> bundle + dictionary.entries + (monad.each ! + (function (_ [name handler]) + (///declaration.lifted_analysis + (moduleA.override_definition [.prelude name] [true {.#Default [.Synthesis handler]}])))))] + (in []))) + (def (with_generation_defaults bundle) (All (_ anchor expression declaration) (-> (///generation.Bundle anchor expression declaration) @@ -141,10 +153,11 @@ (type .public (Extensions anchor expression declaration) [///analysis.Bundle + ///synthesis.Bundle (///generation.Bundle anchor expression declaration) (///declaration.Bundle anchor expression declaration)]) -(def .public (with_defaults module [analysis_bundle generation_bundle host_declaration_bundle]) +(def .public (with_defaults module [analysis_bundle synthesis_bundle generation_bundle host_declaration_bundle]) (All (_ anchor expression declaration) (-> Text (Extensions anchor expression declaration) (///declaration.Operation anchor expression declaration Any))) @@ -152,6 +165,7 @@ .prelude (do ///phase.monad [_ (with_analysis_defaults analysis_bundle) + _ (with_synthesis_defaults synthesis_bundle) _ (with_generation_defaults generation_bundle)] (with_declaration_defaults (dictionary.composite host_declaration_bundle luxD.bundle))) 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 3dab02980..4b9e57fda 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 @@ -26,15 +26,14 @@ [type ["[0]" check]]]]] ["[0]" /// (.only) + ["[0]" synthesis + ["[1]" lux]] ["/[1]" // [// ["[0]" analysis (.only Analysis Operation Phase Handler Bundle) [evaluation (.only Eval)] ["[0]A" type] ["[0]" scope]] - ["[0]" synthesis] - ["[0]" generation] - ["[0]" declaration] [/// ["[0]" reference] ["[0]" phase] @@ -97,8 +96,9 @@ (-> Type Type Type Type (-> Text Handler)) (simple (list subjectT param0T param1T) outputT)) -(def .public (variadic input output extension_name) - (-> Type Type (-> Text Handler)) +(def .public (variadic input output next extension_name) + (-> Type Type (-> Text Text) + (-> Text Handler)) (function (_ analyse archive args) (do [! phase.monad] [_ (typeA.inference output) @@ -106,7 +106,7 @@ (|>> (analyse archive) (typeA.expecting input)) args)] - (in {analysis.#Extension [.prelude (format extension_name "|generation")] argsA})))) + (in {analysis.#Extension [.prelude (next extension_name)] argsA})))) ... TODO: Get rid of this ASAP (these @@ -353,7 +353,7 @@ (-> Bundle Bundle) (|>> (install "text_=#" (binary Text Text Bit)) (install "text_<#" (binary Text Text Bit)) - (install "text_composite#" (variadic Text Text)) + (install "text_composite#" (variadic Text Text synthesis.synthesis)) (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/synthesis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/synthesis.lux index 54b8a874b..71a57c526 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/synthesis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/synthesis.lux @@ -1,11 +1,12 @@ (.require [library [lux (.except)]] - [// - ["[0]" bundle] + ["[0]" / + ["[1][0]" lux]] + ["[0]" // (.only) [/// [synthesis (.only Bundle)]]]) (def .public bundle Bundle - bundle.empty) + /lux.bundle) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/synthesis/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/synthesis/lux.lux new file mode 100644 index 000000000..c266d6999 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/synthesis/lux.lux @@ -0,0 +1,63 @@ +(.require + [library + [lux (.except Synthesis) + [abstract + ["[0]" monad (.only do)]] + [data + ["[0]" text] + [collection + ["[0]" list (.use "[1]#[0]" monad)] + ["[0]" dictionary]]] + [meta + ["[0]" symbol (.use "[1]#[0]" equivalence)] + [compiler + ["[0]" phase]]]]] + ["[0]" /// (.only) + [/// + ["[0]" synthesis (.only Synthesis Handler Bundle)]]]) + +(def .public synthesis + (-> Text Text) + (|>> (text.suffix "|synthesis"))) + +(def generation + (-> Text Text) + (text.replaced (synthesis "") "|generation")) + +(def .public (install name anonymous) + (-> Text (-> Text Handler) + (-> Bundle Bundle)) + (dictionary.has name (anonymous name))) + +(def (flat_text_composite expected) + (-> Symbol (List Synthesis) + (List Synthesis)) + (|>> (list#each (function (_ it) + (when it + {synthesis.#Extension actual parameters} + (if (symbol#= expected actual) + parameters + (list it)) + + _ + (list it)))) + list#conjoint)) + +(def (text::composite self) + (-> Text Handler) + (let [generation [.prelude (generation self)]] + (function (_ synthesis archive parts) + (do [! phase.monad] + [parts (monad.each ! (synthesis archive) parts)] + (in {synthesis.#Extension generation (flat_text_composite generation parts)}))))) + +(def .public bundle + Bundle + (`` (|> ///.empty + (,, (with_template [<default> <handler>] + [(..install (let [[_ short] (symbol <default>)] + (synthesis short)) + <handler>)] + + [.text_composite# ..text::composite] + ))))) diff --git a/stdlib/source/library/lux/test/inline.lux b/stdlib/source/library/lux/test/inline.lux new file mode 100644 index 000000000..191a798cb --- /dev/null +++ b/stdlib/source/library/lux/test/inline.lux @@ -0,0 +1,73 @@ +(.require + [library + [lux (.except static) + [abstract + [monad (.only do)]] + [control + ["?" parser] + ["[0]" try] + ["[0]" exception (.only Exception)]] + [data + ["[0]" text (.only) + ["%" \\format]]] + [math + [number (.only hex)] + ["[0]" random (.only Random)]] + ["[0]" meta (.only) + ["[0]" code (.only) + ["?[1]" \\parser (.only Parser)]] + [macro + [syntax (.only syntax)]]]]]) + +(exception.def .public (failure test) + (Exception Code) + (exception.report + (list ["Test" (%.code test)]))) + +(type .public Test + (Random Bit)) + +(def pcg_32_magic_inc + Nat + (hex "FEDCBA9876543210")) + +(def ?static + (Parser [(Maybe Nat) + Code]) + (?.either (do ?.monad + [seed ?code.nat + term ?code.any] + (in [{.#Some seed} term])) + (do ?.monad + [term ?code.any] + (in [{.#None} term])))) + +(def .public static + (syntax (_ [[seed term] ?static]) + (do [! meta.monad] + [test (meta.eval Test term) + seed (when seed + {.#Some seed} + (in seed) + + _ + meta.seed) + .let [[_ success?] (random.result (random.pcg_32 [..pcg_32_magic_inc seed]) + (as Test test))]] + (if success? + (in (list)) + (meta.failure (exception.error ..failure [term])))))) + +(def .public dynamic + (syntax (_ [test ?code.any]) + (do [! meta.monad] + [error_message (meta.try (meta.failure (exception.error ..failure [test])))] + (in (list (` (is Any + (if (is Bit (, test)) + [] + (panic! (, (code.text (when error_message + {try.#Failure error} + error + + {try.#Success _} + "")))))))))))) diff --git a/stdlib/source/library/lux/test/property.lux b/stdlib/source/library/lux/test/property.lux index db3adfb11..3223d7c06 100644 --- a/stdlib/source/library/lux/test/property.lux +++ b/stdlib/source/library/lux/test/property.lux @@ -94,10 +94,6 @@ test)] [prng result]))) -(def failed? - (-> Tally Bit) - (|>> (the tally.#failures) (n.> 0))) - (def separator text.new_line) @@ -129,7 +125,7 @@ (let [[prng' instance] (random.result (random.pcg_32 [..pcg_32_magic_inc seed]) test)] [prng' (do [! async.monad] [[tally documentation] instance] - (if (..failed? tally) + (if (tally.failed? tally) (in [tally (times_failure seed documentation)]) (exec (if announce_success? diff --git a/stdlib/source/library/lux/test/tally.lux b/stdlib/source/library/lux/test/tally.lux index 7c587d688..1ee172fae 100644 --- a/stdlib/source/library/lux/test/tally.lux +++ b/stdlib/source/library/lux/test/tally.lux @@ -19,6 +19,10 @@ #expected Coverage #actual Coverage])) +(def .public failed? + (-> Tally Bit) + (|>> (the #failures) (n.> 0))) + (def .public (and parameter subject) (-> Tally Tally Tally) [#successes (n.+ (the #successes parameter) (the #successes subject)) diff --git a/stdlib/source/library/lux/world/net/http/response.lux b/stdlib/source/library/lux/world/net/http/response.lux index 9c280d019..246e63723 100644 --- a/stdlib/source/library/lux/world/net/http/response.lux +++ b/stdlib/source/library/lux/world/net/http/response.lux @@ -1,6 +1,8 @@ (.require [library [lux (.except) + [abstract + [monad (.only Monad)]] [control ["[0]" try] [concurrency @@ -26,52 +28,64 @@ #message (Message !)])) (def .public empty - (-> Status (Response Async)) - (let [body (is (Body Async) - (function (_ _) - (async.resolved {try.#Success [0 (at utf8.codec encoded "")]})))] - (function (_ status) - [#status status - #message [//.#headers (|> header.empty - (header.has header.content_length 0) - (header.has header.content_type mime.utf_8)) - //.#body body]]))) + (All (_ !) + (-> (Monad !) Status + (Response !))) + (function (_ ! status) + [#status status + #message [//.#headers (|> header.empty + (header.has header.content_length 0) + (header.has header.content_type mime.utf_8)) + //.#body (function (_ _) + (at ! in {try.#Success [0 (at utf8.codec encoded "")]}))]])) -(def .public (temporary_redirect to) - (-> URL (Response Async)) +(def .public (temporary_redirect ! to) + (All (_ !) + (-> (Monad !) URL + (Response !))) (|> status.temporary_redirect - ..empty + (..empty !) (revised [#message //.#headers] (header.has header.location to)))) -(def .public not_found - (Response Async) - (..empty status.not_found)) +(def .public (not_found !) + (All (_ !) + (-> (Monad !) + (Response !))) + (..empty ! status.not_found)) -(def .public (content status type data) - (-> Status MIME Binary (Response Async)) +(def .public (content ! status type data) + (All (_ !) + (-> (Monad !) Status MIME Binary + (Response !))) (let [length (binary.size data)] [#status status #message [//.#headers (|> header.empty (header.has header.content_length length) (header.has header.content_type type)) //.#body (function (_ _) - (async.resolved {try.#Success [length data]}))]])) + (at ! in {try.#Success [length data]}))]])) -(def .public bad_request - (-> Text (Response Async)) +(def .public (bad_request !) + (All (_ !) + (-> (Monad !) Text + (Response !))) (|>> (at utf8.codec encoded) - (content status.bad_request mime.utf_8))) + (content ! status.bad_request mime.utf_8))) -(def .public ok - (-> MIME Binary (Response Async)) - (content status.ok)) +(def .public (ok !) + (All (_ !) + (-> (Monad !) MIME Binary + (Response !))) + (content ! status.ok)) (with_template [<name> <type> <mime> <pre>] - [(def .public <name> - (-> <type> (Response Async)) + [(def .public (<name> !) + (All (_ !) + (-> (Monad !) <type> + (Response !))) (|>> <pre> (at utf8.codec encoded) - (..ok <mime>)))] + (..ok ! <mime>)))] [text Text mime.utf_8 (<|)] [html html.Document mime.html html.html] diff --git a/stdlib/source/library/lux/world/net/uri.lux b/stdlib/source/library/lux/world/net/uri.lux index c05a9e4d5..868810c15 100644 --- a/stdlib/source/library/lux/world/net/uri.lux +++ b/stdlib/source/library/lux/world/net/uri.lux @@ -1,7 +1,69 @@ (.require [library - [lux (.except)]]) + [lux (.except #host) + [data + [text + ["%" \\format]]]]] + [/ + [port (.only Port)] + [path (.only Path)] + ["[0]" scheme (.only Scheme)] + ["[0]" query (.only Query) (.use "[1]#[0]" codec)]] + ["[0]" // (.only Host)]) + +(def .public (user_info name password) + (-> Text Text Text) + (%.format name ":" password)) + +(type .public Authority + (Record + [#user (Maybe Text) + #host Host + #port (Maybe Port)])) + +(def (authority it) + (-> Authority Text) + (%.format (when (the #user it) + {.#Some it} + (%.format it "@") + + {.#None} + "") + (the #host it) + (when (the #port it) + {.#Some it} + (%.format ":" (%.nat it)) + + {.#None} + ""))) + +(type .public Fragment + Text) ... https://en.wikipedia.org/wiki/Uniform_Resource_Identifier (type .public URI Text) + +(def .public (uri scheme authority path query fragment) + (-> Scheme (Maybe Authority) Path (Maybe Query) (Maybe Fragment) + URI) + (%.format (scheme.name scheme) ":" + (when authority + {.#Some authority} + (%.format "//" (..authority authority)) + + {.#None} + "") + path + (when query + {.#Some query} + (%.format "?" (query#encoded query)) + + {.#None} + "") + (when fragment + {.#Some fragment} + (%.format "#" fragment) + + {.#None} + ""))) diff --git a/stdlib/source/library/lux/world/net/uri/encoding.lux b/stdlib/source/library/lux/world/net/uri/encoding.lux index 085d80744..0c58f165d 100644 --- a/stdlib/source/library/lux/world/net/uri/encoding.lux +++ b/stdlib/source/library/lux/world/net/uri/encoding.lux @@ -74,7 +74,8 @@ (.text_clip# slice_start (nat.- slice_start index) input)))))) ) -(def escape (char "%")) +(def escape + (char "%")) (exception.def (invalid it) (Exception URI_Encoded) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 77802d3cc..99a4faa4a 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -34,7 +34,8 @@ [macro (.only Expander)]] [phase [extension (.only Extender) - ["[0]E" analysis]]]]] + ["[0]E" analysis] + ["[0]E" synthesis]]]]] [meta [packager (.only Packager)] [context (.only Context)] @@ -159,6 +160,7 @@ (do (try.with async.monad) [import (import.import (the platform.#file_system platform) (the cli.#libraries compilation)) .let [all_extensions [(analysisE.bundle host_analysis) + synthesisE.bundle generation_bundle host_declaration_bundle]] [state archive phase_wrapper] (sharing [<parameters>] diff --git a/stdlib/source/specification/lux/abstract/equivalence.lux b/stdlib/source/specification/lux/abstract/equivalence.lux index cc760886f..439b33093 100644 --- a/stdlib/source/specification/lux/abstract/equivalence.lux +++ b/stdlib/source/specification/lux/abstract/equivalence.lux @@ -18,8 +18,13 @@ [left random right random] (<| (_.for [/.Equivalence]) - (all _.and - (_.test "Reflexivity" - (/#= left left)) - (_.test "Symmetry" - (bit#= (/#= left right) (/#= right left))))))) + (_.coverage [/.=] + (let [reflexivity! + (/#= left left) + + symmetry! + (bit#= (/#= left right) + (/#= right left))] + (and reflexivity! + symmetry! + )))))) diff --git a/stdlib/source/test/lux/test.lux b/stdlib/source/test/lux/test.lux index 8d9be9f39..34891bf65 100644 --- a/stdlib/source/test/lux/test.lux +++ b/stdlib/source/test/lux/test.lux @@ -7,7 +7,8 @@ ["[1][0]" coverage] ["[1][0]" tally] ["[1][0]" unit] - ["[1][0]" property]]) + ["[1][0]" property] + ["[1][0]" inline]]) (def .public test Test @@ -16,4 +17,5 @@ /tally.test /unit.test /property.test + /inline.test )) diff --git a/stdlib/source/test/lux/test/inline.lux b/stdlib/source/test/lux/test/inline.lux new file mode 100644 index 000000000..e5cf9cfd6 --- /dev/null +++ b/stdlib/source/test/lux/test/inline.lux @@ -0,0 +1,50 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + ["[0]" try] + ["[0]" exception]] + [data + ["[0]" text]] + [math + ["[0]" random (.only Random) (.use "[1]#[0]" monad)]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(/.static (random#in true)) +(/.static 123,456,789 (random#in true)) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + []) + (all _.and + (_.coverage [/.Test /.static] + true) + (_.coverage [/.dynamic] + (and (when (try (/.dynamic true)) + {try.#Success _} + true + + {try.#Failure _} + false) + (when (try (/.dynamic false)) + {try.#Success _} + false + + {try.#Failure _} + true))) + (_.coverage [/.failure] + (when (try (/.dynamic false)) + {try.#Success _} + false + + {try.#Failure error} + (text.contains? (the exception.#label /.failure) + error))) + ))) diff --git a/stdlib/source/test/lux/test/tally.lux b/stdlib/source/test/lux/test/tally.lux index a0c511680..3ac26f403 100644 --- a/stdlib/source/test/lux/test/tally.lux +++ b/stdlib/source/test/lux/test/tally.lux @@ -45,6 +45,9 @@ (n.= 1 (the /.#failures /.failure)) (n.= 0 (set.size (the /.#expected /.failure))) (n.= 0 (set.size (the /.#actual /.failure))))) + (_.coverage [/.failed?] + (and (/.failed? /.failure) + (not (/.failed? /.success)))) (_.coverage [/.and /.#expected /.#actual] (and (let [it (/.and /.success /.success)] (and (n.= 2 (the /.#successes it)) diff --git a/stdlib/source/test/lux/world/net.lux b/stdlib/source/test/lux/world/net.lux index ad3a3fa1e..ea22fbca4 100644 --- a/stdlib/source/test/lux/world/net.lux +++ b/stdlib/source/test/lux/world/net.lux @@ -11,6 +11,7 @@ ["[0]" /]] ["[0]" / ["[1][0]" mime] + ["[1][0]" uri] ["[1][0]" http ["[1]/[0]" client] ["[1]/[0]" cookie] @@ -18,13 +19,7 @@ ["[1]/[0]" status] ["[1]/[0]" version] ["[1]/[0]" response] - ["[1]/[0]" request]] - ["[1][0]" uri - ["[1]/[0]" encoding] - ["[1]/[0]" scheme] - ["[1]/[0]" port] - ["[1]/[0]" path] - ["[1]/[0]" query]]]) + ["[1]/[0]" request]]]) (def .public test Test @@ -49,9 +44,5 @@ /http/response.test /http/request.test - /uri/encoding.test - /uri/scheme.test - /uri/port.test - /uri/path.test - /uri/query.test + /uri.test ))) diff --git a/stdlib/source/test/lux/world/net/http/response.lux b/stdlib/source/test/lux/world/net/http/response.lux index 28d726a1f..bdefd87c2 100644 --- a/stdlib/source/test/lux/world/net/http/response.lux +++ b/stdlib/source/test/lux/world/net/http/response.lux @@ -65,7 +65,8 @@ .let [expected_css (css.rule selector.any (list [property.text_color (value.rgb color)]))]]) - (_.for [/.Response]) + (_.for [/.Response + /.#message /.#status]) (`` (all _.and (,, (with_template [<coverage> <response> <status> @@ -84,14 +85,14 @@ (try#each (mime#= <content_type>)) (try.else false)))))] - [/.empty (/.empty expected_status) expected_status 0 mime.utf_8] - [/.not_found /.not_found status.not_found 0 mime.utf_8] - [/.content (/.content expected_status expected_mime utf8_data) expected_status utf8_length expected_mime] - [/.bad_request (/.bad_request utf8) status.bad_request utf8_length mime.utf_8] - [/.ok (/.ok expected_mime utf8_data) status.ok utf8_length expected_mime] + [/.empty (/.empty async.monad expected_status) expected_status 0 mime.utf_8] + [/.not_found (/.not_found async.monad) status.not_found 0 mime.utf_8] + [/.content (/.content async.monad expected_status expected_mime utf8_data) expected_status utf8_length expected_mime] + [/.bad_request (/.bad_request async.monad utf8) status.bad_request utf8_length mime.utf_8] + [/.ok (/.ok async.monad expected_mime utf8_data) status.ok utf8_length expected_mime] )) (_.coverage [/.temporary_redirect] - (let [response (/.temporary_redirect expected_url)] + (let [response (/.temporary_redirect async.monad expected_url)] (and (same? status.temporary_redirect (the /.#status response)) (|> response (the [/.#message //.#headers]) @@ -99,7 +100,7 @@ (try#each (text#= expected_url)) (try.else false))))) (in (do async.monad - [.let [response (/.text utf8)] + [.let [response (/.text async.monad utf8)] body ((the [/.#message //.#body] response) {.#None})] (unit.coverage [/.text] (and (same? status.ok (the /.#status response)) @@ -118,7 +119,7 @@ (binary#= utf8_data))) (try.else false)))))) (in (do async.monad - [.let [response (/.html expected_html) + [.let [response (/.html async.monad expected_html) data (|> expected_html html.html utf8#encoded) @@ -141,7 +142,7 @@ (binary#= data))) (try.else false)))))) (in (do async.monad - [.let [response (/.json expected_json) + [.let [response (/.json async.monad expected_json) data (|> expected_json json#encoded utf8#encoded) @@ -164,7 +165,7 @@ (binary#= data))) (try.else false)))))) (in (do async.monad - [.let [response (/.css expected_css) + [.let [response (/.css async.monad expected_css) data (|> expected_css css.css utf8#encoded) diff --git a/stdlib/source/test/lux/world/net/uri.lux b/stdlib/source/test/lux/world/net/uri.lux new file mode 100644 index 000000000..ef8d33f2d --- /dev/null +++ b/stdlib/source/test/lux/world/net/uri.lux @@ -0,0 +1,85 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [data + ["[0]" text (.only) + ["%" \\format]]] + [math + ["[0]" random (.only Random)]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" / (.only) + ["[0]" scheme] + ["[0]" query (.use "[1]#[0]" codec)]]] + ["[0]" / + ["[1][0]" encoding] + ["[1][0]" scheme] + ["[1][0]" port] + ["[1][0]" path] + ["[1][0]" query]]) + +(def user_info + (Random Text) + (do random.monad + [name (random.upper_cased 1) + password (random.upper_cased 2)] + (in (/.user_info name password)))) + +(def authority + (Random /.Authority) + (all random.and + (random.maybe ..user_info) + (random.lower_cased 3) + (random.maybe /port.random) + )) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [scheme /scheme.random + authority ..authority + path (random.lower_cased 4) + query (/query.random 5) + fragment (random.lower_cased 6)]) + (_.for [/.URI]) + (all _.and + (_.coverage [/.uri] + (let [it (/.uri scheme {.#None} path {.#Some query} {.#None})] + (and (text.contains? (scheme.name scheme) it) + (text.contains? path it) + (text.contains? (query#encoded query) it)))) + (_.coverage [/.Authority + /.#user /.#host /.#port + /.user_info] + (let [it (/.uri scheme {.#Some authority} path {.#None} {.#None})] + (and (text.contains? (scheme.name scheme) it) + (text.contains? path it) + (when (the /.#user authority) + {.#Some user} + (text.contains? user it) + + {.#None} + true) + (text.contains? (the /.#host authority) it) + (when (the /.#port authority) + {.#Some port} + (text.contains? (%.nat port) it) + + {.#None} + true)))) + (_.coverage [/.Fragment] + (let [it (/.uri scheme {.#None} path {.#None} {.#Some fragment})] + (and (text.contains? (scheme.name scheme) it) + (text.contains? path it) + (text.contains? fragment it)))) + + /encoding.test + /scheme.test + /port.test + /path.test + /query.test + ))) diff --git a/stdlib/source/test/lux/world/net/uri/port.lux b/stdlib/source/test/lux/world/net/uri/port.lux index d91dc1d5d..73ee68337 100644 --- a/stdlib/source/test/lux/world/net/uri/port.lux +++ b/stdlib/source/test/lux/world/net/uri/port.lux @@ -109,6 +109,7 @@ (<| (_.covering /._) (do [! random.monad] []) + (_.for [/.Port]) (`` (all _.and (_.coverage [(,, (with_template [<port>] [<port>] |