From 13c594758482bac0a7550bcb89cfeda8c5f0a1f3 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 7 Nov 2022 02:48:02 -0400 Subject: Added support for inline testing. --- .../library/lux/meta/compiler/default/init.lux | 16 ++++- .../language/lux/phase/extension/analysis/lux.lux | 14 ++--- .../language/lux/phase/extension/synthesis.lux | 7 ++- .../language/lux/phase/extension/synthesis/lux.lux | 63 +++++++++++++++++++ stdlib/source/library/lux/test/inline.lux | 73 ++++++++++++++++++++++ stdlib/source/library/lux/test/property.lux | 6 +- stdlib/source/library/lux/test/tally.lux | 4 ++ .../source/library/lux/world/net/http/response.lux | 70 ++++++++++++--------- stdlib/source/library/lux/world/net/uri.lux | 64 ++++++++++++++++++- .../source/library/lux/world/net/uri/encoding.lux | 3 +- 10 files changed, 274 insertions(+), 46 deletions(-) create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/synthesis/lux.lux create mode 100644 stdlib/source/library/lux/test/inline.lux (limited to 'stdlib/source/library') 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 [ ] + [(..install (let [[_ short] (symbol )] + (synthesis short)) + )] + + [.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 [ 
]
-  [(def .public 
-     (->  (Response Async))
+  [(def .public ( !)
+     (All (_ !)
+       (-> (Monad !) 
+           (Response !)))
      (|>> 
           (at utf8.codec encoded)
-          (..ok )))]
+          (..ok ! )))]
 
   [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)
-- 
cgit v1.2.3