From 736521eb56a45122eb0a545b677d3ffca1451080 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 28 Oct 2022 23:11:52 -0400 Subject: Eliminated the .alias# extension. Now detecting aliases in .def#. --- stdlib/source/library/lux.lux | 47 ++--- stdlib/source/library/lux/control/aspect.lux | 46 ++--- stdlib/source/library/lux/data/format/css.lux | 6 +- stdlib/source/library/lux/data/format/css/font.lux | 2 +- .../library/lux/data/format/css/property.lux | 7 +- .../source/library/lux/data/format/css/query.lux | 4 +- .../library/lux/data/format/css/selector.lux | 7 +- .../source/library/lux/data/format/css/style.lux | 2 +- .../source/library/lux/data/format/css/value.lux | 4 +- stdlib/source/library/lux/data/format/html.lux | 28 +-- stdlib/source/library/lux/documentation.lux | 2 +- stdlib/source/library/lux/meta.lux | 127 ++++++++------ .../library/lux/meta/compiler/default/init.lux | 6 +- .../library/lux/meta/compiler/default/platform.lux | 8 +- .../library/lux/meta/compiler/language/lux.lux | 7 +- .../meta/compiler/language/lux/analysis/module.lux | 17 +- .../meta/compiler/language/lux/phase/extension.lux | 12 +- .../language/lux/phase/extension/analysis/lux.lux | 56 +++--- .../lux/phase/extension/declaration/lux.lux | 91 +++++----- .../library/lux/meta/compiler/meta/io/archive.lux | 11 +- stdlib/source/library/lux/meta/global.lux | 2 +- stdlib/source/library/lux/meta/macro/context.lux | 22 +-- stdlib/source/library/lux/meta/macro/local.lux | 8 +- .../source/library/lux/meta/macro/vocabulary.lux | 2 +- stdlib/source/library/lux/meta/type/implicit.lux | 8 +- stdlib/source/library/lux/world/net/http.lux | 10 -- .../source/library/lux/world/net/http/client.lux | 7 +- .../source/library/lux/world/net/http/request.lux | 12 ++ .../source/library/lux/world/net/http/response.lux | 88 +++++----- stdlib/source/test/lux/data/color/named.lux | 9 + stdlib/source/test/lux/meta/type/resource.lux | 2 +- stdlib/source/test/lux/meta/type/row.lux | 56 ++++-- stdlib/source/test/lux/world/net.lux | 4 +- stdlib/source/test/lux/world/net/http/client.lux | 3 +- stdlib/source/test/lux/world/net/http/response.lux | 189 +++++++++++++++++++++ stdlib/source/test/lux/world/net/http/status.lux | 21 ++- 36 files changed, 609 insertions(+), 324 deletions(-) create mode 100644 stdlib/source/test/lux/world/net/http/response.lux (limited to 'stdlib/source') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 0be0527c4..d8ef5fd2f 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -489,11 +489,11 @@ #0) ... (type .public Definition -... [Bit Type Any]) +... [Type Any]) (.def# Definition (.is# Type {#Named [..prelude "Definition"] - {#Product Bit {#Product Type Any}}}) + {#Product Type Any}}) .public) ... (type .public Default @@ -692,7 +692,7 @@ ... (Record ... [#module_hash Nat ... #module_aliases (List [Text Text]) -... #definitions (List [Text Global]) +... #definitions (List [Text [Bit Global]]) ... #imports (List Text) ... #module_state Module_State])) (.def# Module @@ -706,7 +706,7 @@ {#Apply {#Product Text Text} List} {#Product ... definitions - {#Apply {#Product Text Global} List} + {#Apply {#Product Text {#Product Bit Global}} List} {#Product ... imports {#Apply Text List} @@ -1841,7 +1841,7 @@ ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] state] ({{#Some [..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _]} - ({{#Some constant} + ({{#Some [_ constant]} ({{#Definition _} {#Right [state full_name]} @@ -1972,11 +1972,11 @@ ({{#None} {#Left (text#composite "Unknown definition: " (symbol#encoded name))} - {#Some definition} + {#Some [exported? definition]} ({{#Alias real_name} (definition_value real_name state) - {#Definition [exported? def_type def_value]} + {#Definition [def_type def_value]} (if (available? expected_module current_module exported?) {#Right [state [def_type def_value]]} {#Left (text#composite "Unavailable definition: " (symbol#encoded name))}) @@ -2637,12 +2637,13 @@ ($ Maybe Macro)) (do maybe#monad [$module (property#value module modules) - gdef (let' [[..#module_hash _ ..#module_aliases _ ..#definitions bindings ..#imports _ ..#module_state _] (.is# Module $module)] - (property#value name bindings))] + exported?,gdef (let' [[..#module_hash _ ..#module_aliases _ ..#definitions bindings ..#imports _ ..#module_state _] (.is# Module $module)] + (property#value name bindings)) + .let' [[exported? gdef] exported?,gdef]] ({{#Alias [r_module r_name]} (named_macro' modules current_module r_module r_name) - {#Definition [exported? def_type def_value]} + {#Definition [def_type def_value]} (if (macro_type? def_type) (if exported? {#Some (.as# Macro def_value)} @@ -3889,7 +3890,7 @@ ..#imports _ ..#module_state _] =module]] (when (property#value name definitions) - {#Some {#Definition [exported type value]}} + {#Some [exported {#Definition [type value]}]} (meta#in [exported (as Label value)]) _ @@ -3905,13 +3906,13 @@ ..#definitions definitions ..#imports _ ..#module_state _] module]] - (in ((is (-> (List [Text Global]) + (in ((is (-> (List [Text [Bit Global]]) (Maybe (List Symbol))) (function (again remaining) (when remaining {#Item [slot head] tail} (when head - {#Definition [exported? type value]} + [exported? {#Definition [type value]}] (if (and (type#= Slot type) (or exported? (text#= expected_module actual_module))) @@ -3954,7 +3955,7 @@ ..#imports _ ..#module_state _] =module]] (when (property#value name definitions) - {#Some {#Definition [exported? type value]}} + {#Some [exported? {#Definition [type value]}]} (if (type#= Type type) (do meta#monad [slots (slot_family module (as Type value))] @@ -4470,14 +4471,16 @@ [current_module modules])] (when (property#value module modules) {#Some =module} - (let [to_alias (list#each (is (-> [Text Global] + (let [to_alias (list#each (is (-> [Text [Bit Global]] (List Text)) - (function (_ [name definition]) + (function (_ [name [exported? definition]]) (when definition {#Alias _} - (list) + (if exported? + (list name) + (list)) - {#Definition [exported? def_type def_value]} + {#Definition [def_type def_value]} (if exported? (list name) (list)) @@ -4537,7 +4540,9 @@ (def (alias_definition imported_module def) (-> Text Text Code) - (` (.alias# (, (local$ def)) (, (symbol$ [imported_module def]))))) + (` (.def# (, (local$ def)) + (, (symbol$ [imported_module def])) + .private))) (def .public only (macro (_ tokens) @@ -4609,12 +4614,12 @@ {#None} {#None} - {#Some definition} + {#Some [exported? definition]} (when definition {#Alias real_name} (definition_type real_name state) - {#Definition [exported? def_type def_value]} + {#Definition [def_type def_value]} {#Some def_type} {#Default _} diff --git a/stdlib/source/library/lux/control/aspect.lux b/stdlib/source/library/lux/control/aspect.lux index ae08932e3..eda6a78c7 100644 --- a/stdlib/source/library/lux/control/aspect.lux +++ b/stdlib/source/library/lux/control/aspect.lux @@ -109,7 +109,7 @@ (def (without_global [module short]) (-> Symbol (analysis.Operation Any)) (function (_ lux) - (let [without_global (is (-> (property.List .Global) (property.List .Global)) + (let [without_global (is (-> (property.List [Bit .Global]) (property.List [Bit .Global])) (property.lacks short)) without_global (is (-> .Module .Module) (revised .#definitions without_global)) @@ -121,30 +121,30 @@ []]}))) (def (global_reference name) - (-> Symbol (Meta .Global)) + (-> Symbol (Meta [Bit .Global])) (do meta.monad [name (meta.normal name) current_module_name meta.current_module_name lux meta.compiler_state] (loop (again [[normal_module normal_short] name]) - (when (is (Maybe .Global) + (when (is (Maybe [Bit .Global]) (do maybe.monad [(open "/[0]") (|> lux (the .#modules) (property.value normal_module))] (property.value normal_short /#definitions))) - {.#Some it} + {.#Some [exported? it]} (when it - {.#Definition [exported? type value]} + {.#Definition [type value]} (if (or exported? (text#= current_module_name normal_module)) - (in it) + (in [exported? it]) (meta.failure (%.format "Global is not an export: " (%.symbol name)))) - {.#Default [exported? type value]} + {.#Default [type value]} (if (or exported? (text#= current_module_name normal_module)) - (in it) + (in [exported? it]) (meta.failure (%.format "Global is not an export: " (%.symbol name)))) {.#Alias de_aliased} @@ -159,9 +159,9 @@ (analysis.Operation of))) (do phase.monad [g!cache (macro.symbol "g!cache") - global (global_reference name) + [exported? global] (global_reference name) .let [cache_name (%.code g!cache)] - _ (module.define cache_name global) + _ (module.define cache_name [exported? global]) it (then [g!cache global]) current_module_name meta.current_module_name _ (without_global [current_module_name cache_name])] @@ -174,11 +174,11 @@ (do phase.monad [g!cache (declaration.lifted_analysis (macro.symbol "g!cache")) - global (declaration.lifted_analysis - (global_reference name)) + [exported? global] (declaration.lifted_analysis + (global_reference name)) .let [cache_name (%.code g!cache)] _ (declaration.lifted_analysis - (module.define cache_name global)) + (module.define cache_name [exported? global])) it (then [g!cache global]) current_module_name (declaration.lifted_analysis meta.current_module_name) @@ -191,10 +191,10 @@ (-> [Symbol .Global] (analysis.Operation of) (analysis.Operation of))) (do phase.monad - [old (global_reference name) - _ (module.override_definition name new) + [[exported? old] (global_reference name) + _ (module.override_definition name [exported? new]) it then - _ (module.override_definition name old)] + _ (module.override_definition name [exported? old])] (in it))) (def (with_temporary_global' [name new] then) @@ -202,13 +202,13 @@ (-> [Symbol .Global] (declaration.Operation anchor expression declaration of) (declaration.Operation anchor expression declaration of))) (do phase.monad - [old (declaration.lifted_analysis - (global_reference name)) + [[exported? old] (declaration.lifted_analysis + (global_reference name)) _ (declaration.lifted_analysis - (module.override_definition name new)) + (module.override_definition name [exported? new])) it then _ (declaration.lifted_analysis - (module.override_definition name old))] + (module.override_definition name [exported? old]))] (in it))) (def (expression type term) @@ -226,7 +226,7 @@ (do phase.monad [g!cache (macro.symbol "g!cache") .let [cache_name (%.code g!cache)] - _ (module.define cache_name {.#Definition [false Analysis (expression type term)]}) + _ (module.define cache_name [false {.#Definition [Analysis (expression type term)]}]) it (then g!cache) current_module_name meta.current_module_name _ (without_global [current_module_name cache_name])] @@ -279,7 +279,7 @@ (list#mix (function (_ [original value] then) (<| (with_cached_analysis original) (function (_ [g!original original_global])) - (with_temporary_global [original {.#Definition [true Analysis (value g!original aspect)]}]) + (with_temporary_global [original {.#Definition [Analysis (value g!original aspect)]}]) then)) (phase archive body) (list [(symbol .local#) ..local] @@ -296,7 +296,7 @@ (list#mix (function (_ [original value] then) (<| (with_cached_analysis' original) (function (_ [g!original original_global])) - (with_temporary_global' [original {.#Definition [true Analysis (value g!original aspect)]}]) + (with_temporary_global' [original {.#Definition [Analysis (value g!original aspect)]}]) then)) (phase archive body) (list [(symbol .local#) ..local] diff --git a/stdlib/source/library/lux/data/format/css.lux b/stdlib/source/library/lux/data/format/css.lux index c754a7d6d..53b9238ec 100644 --- a/stdlib/source/library/lux/data/format/css.lux +++ b/stdlib/source/library/lux/data/format/css.lux @@ -14,7 +14,7 @@ ["[0]" nat]]] [meta [type - ["[0]" primitive (.except Frame def pattern)]]] + ["[0]" primitive (.except Frame def)]]] [world [net (.only URL)]]]] ["[0]" / @@ -40,7 +40,9 @@ (abstraction "")) (type .public Style - (List (Ex (_ brand) [(Property brand) (Value brand)]))) + (List (Ex (_ brand) + [(Property brand) + (Value brand)]))) (def .public (rule selector style) (-> (Selector Any) Style (CSS Common)) diff --git a/stdlib/source/library/lux/data/format/css/font.lux b/stdlib/source/library/lux/data/format/css/font.lux index 5d97d5382..f69a8f602 100644 --- a/stdlib/source/library/lux/data/format/css/font.lux +++ b/stdlib/source/library/lux/data/format/css/font.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except) + [lux (.except #source) [meta [code ["s" \\parser]]] diff --git a/stdlib/source/library/lux/data/format/css/property.lux b/stdlib/source/library/lux/data/format/css/property.lux index 4b4197940..e34b27b1d 100644 --- a/stdlib/source/library/lux/data/format/css/property.lux +++ b/stdlib/source/library/lux/data/format/css/property.lux @@ -1,15 +1,14 @@ (.require [library - [lux (.except All Location) + [lux (.except All Location all left right) [data ["[0]" text]] [meta - [code + ["[0]" code (.only) ["s" \\parser]] [macro [syntax (.only syntax)] - ["[0]" template] - ["[0]" code]] + ["[0]" template]] [type ["[0]" primitive (.except def)]]]]] [// diff --git a/stdlib/source/library/lux/data/format/css/query.lux b/stdlib/source/library/lux/data/format/css/query.lux index 6f35f5e43..095d12b40 100644 --- a/stdlib/source/library/lux/data/format/css/query.lux +++ b/stdlib/source/library/lux/data/format/css/query.lux @@ -1,11 +1,11 @@ (.require [library - [lux (.except and or not) + [lux (.except and or not all only except) [data ["[0]" text (.only) ["%" \\format (.only format)]]] [meta - ["[0]" code (.only syntax) + ["[0]" code (.only) ["s" \\parser]] [macro [syntax (.only syntax)] diff --git a/stdlib/source/library/lux/data/format/css/selector.lux b/stdlib/source/library/lux/data/format/css/selector.lux index df2df8fbf..a76428c86 100644 --- a/stdlib/source/library/lux/data/format/css/selector.lux +++ b/stdlib/source/library/lux/data/format/css/selector.lux @@ -1,7 +1,6 @@ (.require [library - [lux (.except Label or and for same? not) - ["[0]" locale (.only Locale)] + [lux (.except Label Tag or and for same? not at) [data ["[0]" text (.only) ["%" \\format (.only format)]]] @@ -12,7 +11,9 @@ [macro ["[0]" template]] [type - ["[0]" primitive (.except def)]]]]] + ["[0]" primitive (.except def)]]] + [world + ["[0]" locale (.only Locale)]]]] ["[0]" // ["[1][0]" id (.only ID)] ["[1][0]" class (.only Class)]]) diff --git a/stdlib/source/library/lux/data/format/css/style.lux b/stdlib/source/library/lux/data/format/css/style.lux index 0d278d714..ddcbbc291 100644 --- a/stdlib/source/library/lux/data/format/css/style.lux +++ b/stdlib/source/library/lux/data/format/css/style.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except) + [lux (.except with) [data [text ["%" \\format (.only format)]] diff --git a/stdlib/source/library/lux/data/format/css/value.lux b/stdlib/source/library/lux/data/format/css/value.lux index 4fa9266ae..a05cabdf5 100644 --- a/stdlib/source/library/lux/data/format/css/value.lux +++ b/stdlib/source/library/lux/data/format/css/value.lux @@ -1,12 +1,12 @@ (.require [library - [lux (.except Label All Location and static false true) + [lux (.except Label All Location and static false true all) [control ["[0]" maybe]] [data ["[0]" color] ["[0]" product] - ["[0]" text + ["[0]" text (.only) ["%" \\format (.only Format format)]] [collection ["[0]" list (.use "[1]#[0]" functor)]]] diff --git a/stdlib/source/library/lux/data/format/html.lux b/stdlib/source/library/lux/data/format/html.lux index e92858dce..0dc8a42b5 100644 --- a/stdlib/source/library/lux/data/format/html.lux +++ b/stdlib/source/library/lux/data/format/html.lux @@ -1,12 +1,12 @@ (.require [library - [lux (.except Meta Source comment and template) + [lux (.except Tag Meta Source comment and template open parameter) [control ["[0]" function] ["[0]" maybe (.use "[1]#[0]" functor)]] [data ["[0]" product] - ["[0]" text + ["[0]" text (.only) ["%" \\format (.only Format format)]] [collection ["[0]" list (.use "[1]#[0]" functor mix)]]] @@ -21,18 +21,24 @@ [net (.only URL)]]]] [// ["[0]" xml (.only XML)] - [css + ["[0]" css ["[0]" selector] - ["[0]" style (.only Style)]]]) + ["[0]" style (.only Style)] + ["[1]/[0]" id] + ["[1]/[0]" class]]]) (type .public Tag selector.Tag) -(type .public ID selector.ID) -(type .public Class selector.Class) +(type .public ID css/id.ID) +(type .public Class css/class.Class) ... Attributes for an HTML tag. (type .public Attributes (List [Text Text])) +(def .public empty + Attributes + (list)) + (type .public Script js.Statement) @@ -134,7 +140,7 @@ (format (text.enclosed [""] content) (representation node)))) - (def (empty name attributes) + (def (empty_tag name attributes) (-> Tag Attributes HTML) (abstraction (format (..open name attributes) @@ -302,7 +308,7 @@ for (when (list#each (product.uncurried ..area) areas) {.#End} - (..empty "map" attributes) + (..empty_tag "map" attributes) {.#Item head tail} (..tag "map" attributes @@ -311,7 +317,7 @@ (.with_template [ ] [(def .public (-> Attributes ) - (..empty ))] + (..empty_tag ))] [canvas "canvas" Element] [progress "progress" Element] @@ -342,7 +348,7 @@ (def .public label (-> ID Input) - (|>> ["for"] list (..empty "label"))) + (|>> css/id.id ["for"] list (..empty_tag "label"))) (.with_template [ ] [(def .public ( description attributes content) @@ -468,7 +474,7 @@ (..description description))) descriptions) {.#End} - (..empty "dl" attributes) + (..empty_tag "dl" attributes) {.#Item head tail} (..tag "dl" attributes diff --git a/stdlib/source/library/lux/documentation.lux b/stdlib/source/library/lux/documentation.lux index 2d71738d0..da27d4a1a 100644 --- a/stdlib/source/library/lux/documentation.lux +++ b/stdlib/source/library/lux/documentation.lux @@ -492,7 +492,7 @@ (syntax (_ [[name parameters] ..declaration]) (do meta.monad [.let [g!module (code.text (product.left name))] - [[_ def_type def_value]] (meta.export name) + [def_type def_value] (meta.export name) tags (meta.tags_of name)] (macro.with_symbols [g!type] (in (list (` (all md.then diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index 131e88b0d..cade6f127 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -173,16 +173,16 @@ name name]) (do maybe.monad [$module (property.value module modules) - definition (is (Maybe Global) - (|> $module - (is Module) - (the .#definitions) - (property.value name)))] + [exported? definition] (is (Maybe [Bit Global]) + (|> $module + (is Module) + (the .#definitions) + (property.value name)))] (when definition {.#Alias [r_module r_name]} (again r_module r_name) - {.#Definition [exported? def_type def_value]} + {.#Definition [def_type def_value]} (if (macro_type? def_type) {.#Some (as Macro def_value)} {.#None}) @@ -291,19 +291,19 @@ (with_template [ ] [(def .public ( name) - (-> Symbol (Meta Global)) + (-> Symbol (Meta [Bit Global])) (do ..monad [name (..normal name) .let [[normal_module normal_short] name]] (function (_ lux) - (when (is (Maybe Global) + (when (is (Maybe [Bit Global]) (do maybe.monad [(open "[0]") (|> lux (the .#modules) (property.value normal_module))] (property.value normal_short #definitions))) - {.#Some definition} - {try.#Success [lux definition]} + {.#Some exported?,definition} + {try.#Success [lux exported?,definition]} _ (let [current_module (|> lux (the .#current_module) (maybe.else "???")) @@ -321,9 +321,9 @@ (list#each (function (_ [module_name module]) (|> module (the .#definitions) - (list.all (function (_ [def_name global]) + (list.all (function (_ [def_name [exported? global]]) (`` (when global - { [exported? _]} + { _} (if (and exported? (text#= normal_short def_name)) {.#Some (symbol#encoded [module_name def_name])} @@ -362,23 +362,21 @@ (-> Symbol (Meta Definition)) (do [! ..monad] [name (..normal name) - definition (..definition name)] + .let [[expected _] name] + [exported? definition] (..definition name) + actual ..current_module_name] (when definition {.#Definition it} - (let [[exported? def_type def_value] it] - (if exported? - (in it) - (do ! - [.let [[expected _] name] - actual ..current_module_name] - (if (text#= expected actual) - (in it) - (failure (all text#composite "Definition is not an export: " (symbol#encoded name))))))) + (if (or exported? + (text#= expected actual)) + (in it) + (failure (all text#composite "Definition is not an export: " (symbol#encoded name)))) - {.#Alias de_aliased} - (failure (all text#composite - "Aliases are not considered exports: " - (symbol#encoded name))) + {.#Alias it} + (if (or exported? + (text#= expected actual)) + (export it) + (failure (all text#composite "Alias is not an export: " (symbol#encoded name)))) {.#Default _} (failure (all text#composite @@ -389,7 +387,7 @@ (-> Symbol (Meta Default)) (do [! ..monad] [name (..normal name) - definition (..default' name)] + [exported? definition] (..default' name)] (when definition {.#Definition _} (failure (all text#composite @@ -402,15 +400,14 @@ (symbol#encoded name))) {.#Default it} - (let [[exported? def_type def_value] it] - (if exported? - (in it) - (do ! - [.let [[expected _] name] - actual ..current_module_name] - (if (text#= expected actual) - (in it) - (failure (all text#composite "Default is not an export: " (symbol#encoded name)))))))))) + (if exported? + (in it) + (do ! + [.let [[expected _] name] + actual ..current_module_name] + (if (text#= expected actual) + (in it) + (failure (all text#composite "Default is not an export: " (symbol#encoded name))))))))) (with_template [ ] [(def .public @@ -430,12 +427,12 @@ (def .public (definition_type name) (-> Symbol (Meta Type)) (do ..monad - [definition (definition name)] + [[exported? definition] (definition name)] (when definition {.#Alias de_aliased} (definition_type de_aliased) - {.#Definition [exported? def_type def_value]} + {.#Definition [def_type def_value]} (clean_type def_type) {.#Default _} @@ -456,12 +453,12 @@ (def .public (type_definition name) (-> Symbol (Meta Type)) (do ..monad - [definition (definition name)] + [[exported? definition] (definition name)] (when definition {.#Alias de_aliased} (type_definition de_aliased) - {.#Definition [exported? def_type def_value]} + {.#Definition [def_type def_value]} (let [type_code (`` (.in_module# (,, (static .prelude)) .type_code))] (if (or (same? .Type def_type) (at code.equivalence = @@ -474,7 +471,7 @@ (..failure (all text#composite "Default is not a type: " (symbol#encoded name)))))) (def .public (globals module) - (-> Text (Meta (List [Text Global]))) + (-> Text (Meta (List [Text [Bit Global]]))) (function (_ lux) (when (property.value module (the .#modules lux)) {.#Some module} @@ -484,28 +481,54 @@ {try.#Failure (all text#composite "Unknown module: " module)}))) (def .public (definitions module) - (-> Text (Meta (List [Text Definition]))) + (-> Text (Meta (List [Text [Bit Definition]]))) (at ..monad each - (list.all (function (_ [name global]) + (list.all (function (_ [name [exported? global]]) (when global {.#Alias de_aliased} {.#None} {.#Definition definition} - {.#Some [name definition]} + {.#Some [name [exported? definition]]} {.#Default _} {.#None}))) (..globals module))) +(def .public (resolved_globals module) + (-> Text (Meta (List [Text [Bit Definition]]))) + (do [! ..monad] + [it (..globals module) + .let [it (list.all (function (_ [name [exported? global]]) + (when global + {.#Alias de_aliased} + {.#Some [name exported? {.#Left de_aliased}]} + + {.#Definition definition} + {.#Some [name exported? {.#Right definition}]} + + {.#Default _} + {.#None})) + it)]] + (monad.each ! (function (_ [name exported? it]) + (when it + {.#Left de_aliased} + (do ! + [de_aliased (export de_aliased)] + (in [name [exported? de_aliased]])) + + {.#Right definition} + (in [name [exported? definition]]))) + it))) + (def .public (exports module_name) (-> Text (Meta (List [Text Definition]))) (do ..monad [constants (..definitions module_name)] (in (do list.monad - [[name [exported? def_type def_value]] constants] + [[name [exported? [def_type def_value]]] constants] (if exported? - (in [name [exported? def_type def_value]]) + (in [name [def_type def_value]]) (list)))))) (def .public modules @@ -527,9 +550,9 @@ (do ..monad [.let [[module_name name] type_name] module (..module module_name)] - (in (list.one (function (_ [short global]) + (in (list.one (function (_ [short [exported? global]]) (when global - {.#Definition [exported? type value]} + {.#Definition [type value]} (if (type#= Slot type) (let [[label type] (as Label value)] (when type @@ -592,7 +615,7 @@ =module (..module module) this_module_name ..current_module_name] (when (property.value name (the .#definitions =module)) - {.#Some {.#Definition [exported? def_type def_value]}} + {.#Some [exported? {.#Definition [def_type def_value]}]} (if (or (text#= this_module_name module) exported?) (if (type#= def_type) @@ -614,9 +637,9 @@ [=module (..module module) this_module_name ..current_module_name] (in (property.values - (list#mix (function (_ [short global] output) + (list#mix (function (_ [short [exported? global]] output) (when global - {.#Definition [exported? type value]} + {.#Definition [type value]} (if (and (type#= Slot type) (or exported? (text#= this_module_name module))) @@ -657,7 +680,7 @@ (def .public (de_aliased def_name) (-> Symbol (Meta Symbol)) (do ..monad - [constant (..definition def_name)] + [[exported? constant] (..definition def_name)] (in (when constant {.#Alias real_def_name} real_def_name diff --git a/stdlib/source/library/lux/meta/compiler/default/init.lux b/stdlib/source/library/lux/meta/compiler/default/init.lux index 0daa166c6..ac2f31861 100644 --- a/stdlib/source/library/lux/meta/compiler/default/init.lux +++ b/stdlib/source/library/lux/meta/compiler/default/init.lux @@ -108,7 +108,7 @@ (monad.each ! (function (_ [name handler]) (///declaration.lifted_analysis - (moduleA.override_definition [.prelude name] {.#Default [true .Analysis handler]})))))] + (moduleA.override_definition [.prelude name] [true {.#Default [.Analysis handler]}])))))] (in []))) (def (with_generation_defaults bundle) @@ -121,7 +121,7 @@ (monad.each ! (function (_ [name handler]) (///declaration.lifted_analysis - (moduleA.override_definition [.prelude name] {.#Default [true .Generation handler]})))))] + (moduleA.override_definition [.prelude name] [true {.#Default [.Generation handler]}])))))] (in []))) (def (with_declaration_defaults bundle) @@ -135,7 +135,7 @@ (function (_ [name handler]) (do ! [_ (///declaration.lifted_analysis - (moduleA.override_definition [.prelude name] {.#Default [true .Declaration handler]}))] + (moduleA.override_definition [.prelude name] [true {.#Default [.Declaration handler]}]))] (in [])))))] (in []))) diff --git a/stdlib/source/library/lux/meta/compiler/default/platform.lux b/stdlib/source/library/lux/meta/compiler/default/platform.lux index 6d1974ab8..c6f7c892f 100644 --- a/stdlib/source/library/lux/meta/compiler/default/platform.lux +++ b/stdlib/source/library/lux/meta/compiler/default/platform.lux @@ -780,10 +780,10 @@ meta_state (the [///declaration.#analysis ///declaration.#state] state)] - [_ /#type /#value] (|> /#definition - meta.export - (meta.result meta_state) - async#in)] + [/#type /#value] (|> /#definition + meta.export + (meta.result meta_state) + async#in)] (async#in (if (check.subsumes? ..Custom /#type) {try.#Success [context (the compiler.#parameters it) /#value]} (exception.except ..invalid_custom_compiler [/#definition /#type])))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux.lux index d8fd8a22e..58b2833b9 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux.lux @@ -23,7 +23,7 @@ (def .public format (Format .Module) (let [definition (is (Format Definition) - (all _.and _.bit _.type _.any)) + (all _.and _.type _.any)) alias (is (Format Alias) (_.and _.text _.text)) global (is (Format Global) @@ -37,7 +37,7 @@ ... #module_aliases (_.list alias) ... #definitions - (_.list (_.and _.text global)) + (_.list (_.and _.text (_.and _.bit global))) ... #imports (_.list _.text) ... #module_state @@ -47,7 +47,6 @@ (Parser .Module) (let [definition (is (Parser Definition) (all <>.and - .bit .type .any)) alias (is (Parser Alias) @@ -65,7 +64,7 @@ ... #module_aliases (.list alias) ... #definitions - (.list (<>.and .text global)) + (.list (<>.and .text (<>.and .bit global))) ... #imports (.list .text) ... #module_state diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux index 6fa95812d..8a47ab3b6 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux @@ -95,8 +95,8 @@ [state] {try.#Success}))) -(def .public (define name definition) - (-> Text Global (Operation Any)) +(def .public (define name exported?,definition) + (-> Text [Bit Global] (Operation Any)) (do ///.monad [self_name meta.current_module_name self meta.current_module] @@ -106,23 +106,24 @@ {try.#Success [(revised .#modules (property.has self_name (revised .#definitions - (is (-> (List [Text Global]) (List [Text Global])) - (|>> {.#Item [name definition]})) + (is (-> (List [Text [Bit Global]]) + (List [Text [Bit Global]])) + (|>> {.#Item [name exported?,definition]})) self)) state) []]} - {.#Some already_existing} + {.#Some [_ already_existing]} ((/.except ..cannot_define_more_than_once [[self_name name] already_existing]) state))))) -(def .public (override_definition [module short] definition) - (-> Symbol Global (Operation Any)) +(def .public (override_definition [module short] exported?,definition) + (-> Symbol [Bit Global] (Operation Any)) (function (_ state) {try.#Success [(revised .#modules (property.revised module (revised .#definitions - (property.has short definition))) + (property.has short exported?,definition))) state) []]})) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux index c0ad23cb1..0424495e0 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux @@ -83,22 +83,22 @@ current_module_name meta.current_module_name lux meta.compiler_state] (loop (again [[normal_module normal_short] name]) - (when (is (Maybe Global) + (when (is (Maybe [Bit Global]) (do maybe.monad [(open "/[0]") (|> lux (the .#modules) (property.value normal_module))] (property.value normal_short /#definitions))) - {.#Some it} + {.#Some [exported? it]} (when it - {.#Definition [exported? type value]} + {.#Definition [type value]} (if (or validated_global? exported? (text#= current_module_name normal_module)) (in it) (meta.failure (%.format "Global is not an export: " (%.symbol name)))) - {.#Default [exported? type value]} + {.#Default [type value]} (if (or validated_global? exported? (text#= current_module_name normal_module)) @@ -116,10 +116,10 @@ (do meta.monad [global (..global validated_global? name)] (when global - {.#Definition [exported? type value]} + {.#Definition [type value]} (in [type {#Normal value}]) - {.#Default [exported? type value]} + {.#Default [type value]} (in [type {#Special value}]) {.#Alias _} 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 114928b77..3daa22bc1 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 @@ -230,32 +230,38 @@ (-> Text Handler) (..custom [(<>.and .text .global) - (function (again extension_name phase archive [quoted_module def_name]) + (function (_ extension_name phase archive [quoted_module def_name]) (with_expansions [ (in (|> def_name reference.constant {analysis.#Reference}))] - (do [! phase.monad] - [constant (meta.definition def_name)] - (when constant - {.#Alias real_def_name} - (again extension_name phase archive [quoted_module real_def_name]) - - {.#Definition [exported? actualT _]} - (do ! - [_ (typeA.inference actualT) - (^.let def_name [::module ::name]) (meta.normal def_name) - current meta.current_module_name] - (if (text#= current ::module) - - (if exported? - (do ! - [imported! (meta.imported_by? ::module current)] - (if (or imported! - (text#= quoted_module ::module)) - - (analysis.except ..foreign_module_has_not_been_imported [current ::module quoted_module def_name]))) - (analysis.except ..global_has_not_been_exported [def_name])))) - - {.#Default _} - (analysis.except ..defaults_cannot_be_referenced [def_name])))))])) + (loop (again [exported_alias? false + def_name def_name]) + (do [! phase.monad] + [(^.let def_name [::module ::name]) (meta.normal def_name) + current meta.current_module_name + [exported? constant] (meta.definition def_name)] + (when constant + {.#Alias real_def_name} + (again (or exported_alias? + (text#= current ::module) + exported?) + real_def_name) + + {.#Definition [actualT _]} + (do ! + [_ (typeA.inference actualT)] + (if (or exported_alias? + (text#= current ::module)) + + (if exported? + (do ! + [imported! (meta.imported_by? ::module current)] + (if (or imported! + (text#= quoted_module ::module)) + + (analysis.except ..foreign_module_has_not_been_imported [current ::module quoted_module def_name]))) + (analysis.except ..global_has_not_been_exported [def_name])))) + + {.#Default _} + (analysis.except ..defaults_cannot_be_referenced [def_name]))))))])) (exception.def .public (unknown_local name) (Exception Text) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux index d75f24433..988395df8 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux @@ -34,7 +34,7 @@ ["[1][0]" analysis] ["/[1]" // ["/[1]" // - ["[1][0]" analysis (.only) + ["[0]" analysis (.only) [macro (.only Expander)] ["[1]/[0]" evaluation] ["[0]A" type] @@ -227,15 +227,15 @@ (Operation anchor expression declaration Any)) (do [! phase.monad] [state phase.state - .let [eval (/////analysis/evaluation.evaluator (the [/////declaration.#analysis /////declaration.#phase] state) - [(the [/////declaration.#synthesis /////declaration.#state] state) - (the [/////declaration.#synthesis /////declaration.#phase] state)] - [(the [/////declaration.#generation /////declaration.#state] state) - (the [/////declaration.#generation /////declaration.#phase] state)])] + .let [eval (analysis/evaluation.evaluator (the [/////declaration.#analysis /////declaration.#phase] state) + [(the [/////declaration.#synthesis /////declaration.#state] state) + (the [/////declaration.#synthesis /////declaration.#phase] state)] + [(the [/////declaration.#generation /////declaration.#state] state) + (the [/////declaration.#generation /////declaration.#phase] state)])] _ (/////declaration.lifted_analysis (do ! - [_ (moduleA.override_definition [.prelude "is#"] {.#Default [true .Analysis (analysisE.is#_extension eval "is#")]}) - _ (moduleA.override_definition [.prelude "as#"] {.#Default [true .Analysis (analysisE.as#_extension eval "as#")]})] + [_ (moduleA.override_definition [.prelude "is#"] [true {.#Default [.Analysis (analysisE.is#_extension eval "is#")]}]) + _ (moduleA.override_definition [.prelude "as#"] [true {.#Default [.Analysis (analysisE.as#_extension eval "as#")]}])] (in [])))] (in []))) @@ -250,16 +250,38 @@ (..custom [(all <>.and .local .any .any) (function (_ phase archive [short_name valueC exported?C]) - (do phase.monad - [_ ..refresh - current_module (/////declaration.lifted_analysis meta.current_module_name) - .let [full_name [current_module short_name]] - [type valueT value] (..definition archive full_name {.#None} valueC) - [_ _ exported?] (evaluate! archive Bit exported?C) - _ (/////declaration.lifted_analysis - (moduleA.define short_name {.#Definition [(as Bit exported?) type value]})) - _ (..announce_definition! short_name type)] - (in /////declaration.no_requirements)))])) + (when valueC + [_ {.#Symbol original}] + (do phase.monad + [_ ..refresh + state phase.state + .let [analysis (the [/////declaration.#analysis /////declaration.#phase] state)] + [code//type codeA] (<| /////declaration.lifted_analysis + typeA.fresh + typeA.inferring + (analysis archive valueC)) + [_ _ exported?] (evaluate! archive Bit exported?C) + .let [original (when codeA + (analysis.constant original) + original + + _ + (undefined))] + _ (/////declaration.lifted_analysis + (moduleA.define short_name [(as Bit exported?) {.#Alias original}]))] + (in /////declaration.no_requirements)) + + _ + (do phase.monad + [_ ..refresh + current_module (/////declaration.lifted_analysis meta.current_module_name) + .let [full_name [current_module short_name]] + [type valueT value] (..definition archive full_name {.#None} valueC) + [_ _ exported?] (evaluate! archive Bit exported?C) + _ (/////declaration.lifted_analysis + (moduleA.define short_name [(as Bit exported?) {.#Definition [type value]}])) + _ (..announce_definition! short_name type)] + (in /////declaration.no_requirements))))])) (def imports (Parser (List Import)) @@ -284,36 +306,6 @@ (in [/////declaration.#imports imports /////declaration.#referrals (list)])))])) -(exception.def .public (cannot_alias_an_alias [local foreign target]) - (Exception [Alias Alias Symbol]) - (exception.report - (list ["Local alias" (%.symbol local)] - ["Foreign alias" (%.symbol foreign)] - ["Target definition" (%.symbol target)]))) - -(def (define_alias alias original) - (-> Text Symbol (/////analysis.Operation Any)) - (do phase.monad - [current_module meta.current_module_name - constant (meta.definition original)] - (when constant - {.#Alias de_aliased} - (phase.except ..cannot_alias_an_alias [[current_module alias] original de_aliased]) - - {.#Definition _} - (moduleA.define alias {.#Alias original})))) - -(def def_alias - Handler - (..custom - [(all <>.and .local .symbol) - (function (_ phase archive [alias def_name]) - (do phase.monad - [_ (phase.sub [(the [/////declaration.#analysis /////declaration.#state]) - (has [/////declaration.#analysis /////declaration.#state])] - (define_alias alias def_name))] - (in /////declaration.no_requirements)))])) - ... TODO: Stop requiring these types and the "swapped" function below to make types line-up. (with_template [ ] [(def @@ -362,5 +354,4 @@ Bundle (|> ///.empty (dictionary.has "def#" lux::def) - (dictionary.has "module#" def_module) - (dictionary.has "alias#" def_alias))) + (dictionary.has "module#" def_module))) diff --git a/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux b/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux index e419e99aa..ae2df0fda 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux @@ -219,21 +219,22 @@ {.#End} {try.#Success [definitions bundles output]})))) content (document.content $.key document) - definitions (monad.each ! (function (_ [def_name def_global]) + definitions (monad.each ! (function (_ [def_name [exported? def_global]]) (when def_global {.#Alias payload} - (in (list [def_name def_global])) + (in (list [def_name [exported? def_global]])) - {.#Definition [exported? type _]} + {.#Definition [type _]} (|> definitions (dictionary.value def_name) try.of_maybe - (at ! each (|>> [exported? type] + (at ! each (|>> [type] {.#Definition} + [exported?] [def_name] (list)))) - {.#Default [exported? type _]} + {.#Default [type _]} (in (list)))) (the .#definitions content))] (in [(document.document $.key (has .#definitions (list#conjoint definitions) content)) diff --git a/stdlib/source/library/lux/meta/global.lux b/stdlib/source/library/lux/meta/global.lux index e26d50afd..4f86381a7 100644 --- a/stdlib/source/library/lux/meta/global.lux +++ b/stdlib/source/library/lux/meta/global.lux @@ -34,7 +34,7 @@ (|> (do maybe.monad [global (property.value short (the .#definitions module))] (in (revised .#definitions - (|>> (property.has short {.#Alias [here local]}) + (|>> (property.has short [false {.#Alias [here local]}]) (property.has hidden global)) module))) (maybe.else module)))))) diff --git a/stdlib/source/library/lux/meta/macro/context.lux b/stdlib/source/library/lux/meta/macro/context.lux index ed4c54849..c39bbd539 100644 --- a/stdlib/source/library/lux/meta/macro/context.lux +++ b/stdlib/source/library/lux/meta/macro/context.lux @@ -48,7 +48,7 @@ (do meta.monad [.let [[@ expected_name] it] defs (meta.definitions @)] - (when (list.one (function (_ [actual_name [exported? type value]]) + (when (list.one (function (_ [actual_name [exported? [type value]]]) (if (text#= expected_name actual_name) {.#Some value} {.#None})) @@ -110,12 +110,12 @@ _ (exception.except ..not_a_definition [definition])))) - on_globals (is (-> (property.List Global) (Try (property.List Global))) + on_globals (is (-> (property.List [Bit Global]) (Try (property.List [Bit Global]))) (function (_ globals) (when (property.value context globals) - {.#Some global} + {.#Some [exported? global]} (try#each (function (_ global) - (property.has context global globals)) + (property.has context [exported? global] globals)) (on_global global)) {.#None} @@ -146,12 +146,12 @@ (All (_ value) (-> value (Stack' value) (Meta Any))) - (alter (function (_ _ [exported? type stack]) + (alter (function (_ _ [type stack]) (|> stack (as (Stack Any)) {.#Item top} (is (Stack Any)) - [exported? type] + [type] {try.#Success})))) (.def .public push @@ -163,7 +163,7 @@ (All (_ value) (-> (Maybe (Predicate value)) (-> value value) (Stack' value) (Meta Any))) - (alter (function (_ @ [exported? type stack]) + (alter (function (_ @ [type stack]) (let [stack (sharing [value] (is (-> value value) !) @@ -183,7 +183,7 @@ _ (exception.except ..no_example [@])))] - (in [exported? type stack])) + (in [type stack])) {.#None} (when stack @@ -191,7 +191,7 @@ (|> stack' (list.partial (! top)) (is (Stack Any)) - [exported? type] + [type] {try.#Success}) _ @@ -207,10 +207,10 @@ (.def .public pop'' (All (_ value) (-> (Stack' value) (Meta Any))) - (alter (function (_ _ [exported? type value]) + (alter (function (_ _ [type value]) (|> (let [value (as (Stack Any) value)] (maybe.else value (list.tail value))) - [exported? type] + [type] {try.#Success})))) (.def .public pop' diff --git a/stdlib/source/library/lux/meta/macro/local.lux b/stdlib/source/library/lux/meta/macro/local.lux index d1e9c9475..b2367fee8 100644 --- a/stdlib/source/library/lux/meta/macro/local.lux +++ b/stdlib/source/library/lux/meta/macro/local.lux @@ -55,9 +55,9 @@ (-> [Symbol Macro] (Meta Any)) (do meta.monad [[module_name definition_name] (meta.normal name) - .let [definition (is Global {.#Definition [false .Macro macro]}) - add_macro! (is (-> (property.List Global) (property.List Global)) - (property.has definition_name definition))]] + .let [definition (is Global {.#Definition [.Macro macro]}) + add_macro! (is (-> (property.List [Bit Global]) (property.List [Bit Global])) + (property.has definition_name [false definition]))]] (..with_module module_name (function (_ module) (when (|> module (the .#definitions) (property.value definition_name)) @@ -72,7 +72,7 @@ (-> Symbol (Meta Any)) (do meta.monad [[module_name definition_name] (meta.normal name) - .let [lacks_macro! (is (-> (property.List Global) (property.List Global)) + .let [lacks_macro! (is (-> (property.List [Bit Global]) (property.List [Bit Global])) (property.lacks definition_name))]] (..with_module module_name (function (_ module) diff --git a/stdlib/source/library/lux/meta/macro/vocabulary.lux b/stdlib/source/library/lux/meta/macro/vocabulary.lux index 2e9297eee..31e0dc1d9 100644 --- a/stdlib/source/library/lux/meta/macro/vocabulary.lux +++ b/stdlib/source/library/lux/meta/macro/vocabulary.lux @@ -47,7 +47,7 @@ (` (.def (, public|private@by_name) ((, by_name) (, g!_)) (-> Symbol (Meta Macro)) (do ///.monad - [[(, g!_) (, g!type) (, g!value)] (///.export (, g!_))] + [[(, g!type) (, g!value)] (///.export (, g!_))] (if (at type.equivalence (,' =) (, type) (, g!type)) ((,' in) ((, macro) (as (, type) (, g!value)))) (///.failure (exception.error ..invalid_type [(, type) (, g!type)]))))))))))) diff --git a/stdlib/source/library/lux/meta/type/implicit.lux b/stdlib/source/library/lux/meta/type/implicit.lux index f265ac780..1e1a93c0d 100644 --- a/stdlib/source/library/lux/meta/type/implicit.lux +++ b/stdlib/source/library/lux/meta/type/implicit.lux @@ -143,8 +143,8 @@ ))) (def (available_definitions sig_type source_module target_module constants aggregate) - (-> Type Text Text (List [Text Definition]) (-> (List [Symbol Type]) (List [Symbol Type]))) - (list#mix (function (_ [name [exported? def_type def_value]] aggregate) + (-> Type Text Text (List [Text [Bit Definition]]) (-> (List [Symbol Type]) (List [Symbol Type]))) + (list#mix (function (_ [name [exported? [def_type def_value]]] aggregate) (if (and (or (text#= target_module source_module) exported?) (compatible_type? sig_type def_type)) @@ -173,7 +173,7 @@ (-> Type (Meta (List [Symbol Type]))) (do [! ///.monad] [this_module_name ///.current_module_name - definitions (///.definitions this_module_name)] + definitions (///.resolved_globals this_module_name)] (in (available_definitions sig_type this_module_name this_module_name definitions {.#End})))) (def (imported_structs sig_type) @@ -181,7 +181,7 @@ (do [! ///.monad] [this_module_name ///.current_module_name imported_modules (///.imported_modules this_module_name) - accessible_definitions (monad.each ! ///.definitions imported_modules)] + accessible_definitions (monad.each ! ///.resolved_globals imported_modules)] (in (list#mix (function (_ [imported_module definitions] tail) (available_definitions sig_type imported_module this_module_name definitions tail)) {.#End} diff --git a/stdlib/source/library/lux/world/net/http.lux b/stdlib/source/library/lux/world/net/http.lux index 37d9c0fd4..05cf85509 100644 --- a/stdlib/source/library/lux/world/net/http.lux +++ b/stdlib/source/library/lux/world/net/http.lux @@ -50,13 +50,3 @@ (Record [#headers Headers #body (Body !)])) - -(type .public (Request !) - [Identification Protocol Resource (Message !)]) - -(type .public (Response !) - [Status (Message !)]) - -(type .public (Server !) - (-> (Request !) - (! (Response !)))) diff --git a/stdlib/source/library/lux/world/net/http/client.lux b/stdlib/source/library/lux/world/net/http/client.lux index 49b376ee3..f3851016a 100644 --- a/stdlib/source/library/lux/world/net/http/client.lux +++ b/stdlib/source/library/lux/world/net/http/client.lux @@ -28,13 +28,14 @@ [syntax (.only syntax)] ["[0]" template]]]]] ["[0]" // (.only) + [response (.only Response)] ["[0]" header (.only Headers)] [// (.only URL)]]) (type .public (Client !) (Interface (is (-> //.Method URL Headers (Maybe Binary) - (! (Try (//.Response !)))) + (! (Try (Response !)))) request))) (def method_function @@ -46,7 +47,7 @@ (def .public ( url headers data client) (All (_ !) (-> URL Headers (Maybe Binary) (Client !) - (! (Try (//.Response !))))) + (! (Try (Response !))))) (at client request {} url headers data)))] [//.#Post] @@ -193,7 +194,7 @@ (Client IO) (implementation (def (request method url headers data) - (is (IO (Try (//.Response IO))) + (is (IO (Try (Response IO))) (do [! (try.with io.monad)] [connection (|> url ffi.as_string java/net/URL::new java/net/URL::openConnection) .let [connection (as java/net/HttpURLConnection connection)] diff --git a/stdlib/source/library/lux/world/net/http/request.lux b/stdlib/source/library/lux/world/net/http/request.lux index 26005abe2..477fbf2e3 100644 --- a/stdlib/source/library/lux/world/net/http/request.lux +++ b/stdlib/source/library/lux/world/net/http/request.lux @@ -31,6 +31,18 @@ ["[1][0]" query] ["[1][0]" cookie]]) +(type .public (Request !) + [Identification Protocol Resource (Message !)]) + +(type .public (Server !) + (-> (Request !) + (! (Response !)))) + +(def .public (static response) + (-> Response Server) + (function (_ request) + (async.resolved response))) + (def (merge inputs) (-> (List Binary) Binary) (let [[_ output] (try.trusted diff --git a/stdlib/source/library/lux/world/net/http/response.lux b/stdlib/source/library/lux/world/net/http/response.lux index 7b223efed..9c280d019 100644 --- a/stdlib/source/library/lux/world/net/http/response.lux +++ b/stdlib/source/library/lux/world/net/http/response.lux @@ -1,74 +1,80 @@ (.require [library - [lux (.except static) + [lux (.except) [control - ["[0]" io] + ["[0]" try] [concurrency - ["[0]" async] - ["[0]" frp (.use "[1]#[0]" monad)]]] + ["[0]" async (.only Async)]]] [data - ["[0]" text - ["[0]" encoding]] + ["[0]" binary (.only Binary)] + [text + [encoding + ["[0]" utf8]]] [format ["[0]" html] ["[0]" css (.only CSS)] - ["[0]" context] - ["[0]" json (.only JSON) (.use "[1]#[0]" codec)]]] - [world - ["[0]" binary (.only Binary)]]]] - ["[0]" // (.only Status Body Response Server) - ["[0]" status] - ["[0]" mime (.only MIME)] + ["[0]" json (.only JSON) (.use "[1]#[0]" codec)]]]]] + ["[0]" // (.only Body Message) + ["[0]" status (.only Status)] ["[0]" header] - [// (.only URL)]]) + [// (.only URL) + ["[0]" mime (.only MIME)]]]) -(def .public (static response) - (-> Response Server) - (function (_ request) - (async.resolved response))) +(type .public (Response !) + (Record + [#status Status + #message (Message !)])) (def .public empty - (-> Status Response) - (let [body (frp#in (at encoding.utf8 encoded ""))] + (-> Status (Response Async)) + (let [body (is (Body Async) + (function (_ _) + (async.resolved {try.#Success [0 (at utf8.codec encoded "")]})))] (function (_ status) - [status - [//.#headers (|> context.empty - (header.content_length 0) - (header.content_type mime.utf_8)) - //.#body body]]))) + [#status status + #message [//.#headers (|> header.empty + (header.has header.content_length 0) + (header.has header.content_type mime.utf_8)) + //.#body body]]))) (def .public (temporary_redirect to) - (-> URL Response) - (let [[status message] (..empty status.temporary_redirect)] - [status (revised //.#headers (header.location to) message)])) + (-> URL (Response Async)) + (|> status.temporary_redirect + ..empty + (revised [#message //.#headers] (header.has header.location to)))) (def .public not_found - Response + (Response Async) (..empty status.not_found)) (def .public (content status type data) - (-> Status MIME Binary Response) - [status - [//.#headers (|> context.empty - (header.content_length (binary.size data)) - (header.content_type type)) - //.#body (frp#in data)]]) + (-> Status MIME Binary (Response Async)) + (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]}))]])) (def .public bad_request - (-> Text Response) - (|>> (at encoding.utf8 encoded) (content status.bad_request mime.utf_8))) + (-> Text (Response Async)) + (|>> (at utf8.codec encoded) + (content status.bad_request mime.utf_8))) (def .public ok - (-> MIME Binary Response) + (-> MIME Binary (Response Async)) (content status.ok)) (with_template [ 
]
   [(def .public 
-     (->  Response)
-     (|>> 
 (at encoding.utf8 encoded) (..ok )))]
+     (->  (Response Async))
+     (|>> 
+          (at utf8.codec encoded)
+          (..ok )))]
 
   [text Text          mime.utf_8 (<|)]
   [html html.Document mime.html  html.html]
-  [css  CSS           mime.css   css.css]
+  [css  (CSS Any)     mime.css   css.css]
   [json JSON          mime.json  json#encoded]
   )
diff --git a/stdlib/source/test/lux/data/color/named.lux b/stdlib/source/test/lux/data/color/named.lux
index 34a5a5a3d..4a9a633c9 100644
--- a/stdlib/source/test/lux/data/color/named.lux
+++ b/stdlib/source/test/lux/data/color/named.lux
@@ -3,6 +3,8 @@
   [lux (.except)
    [abstract
     [monad (.only do)]]
+   [control
+    ["[0]" maybe]]
    [data
     [collection
      ["[0]" list]
@@ -214,6 +216,13 @@
   (def unique_colors
     (set.of_list //.hash ..all_colors))
 
+  (def .public random
+    (Random //.Color)
+    (do [! random.monad]
+      [choice (at ! each (n.% (set.size ..unique_colors))
+                  random.nat)]
+      (in (maybe.trusted (list.item choice ..all_colors)))))
+
   (def verdict
     (n.= (list.size ..all_colors)
          (set.size ..unique_colors)))
diff --git a/stdlib/source/test/lux/meta/type/resource.lux b/stdlib/source/test/lux/meta/type/resource.lux
index 33859dd4e..4b134ebbe 100644
--- a/stdlib/source/test/lux/meta/type/resource.lux
+++ b/stdlib/source/test/lux/meta/type/resource.lux
@@ -161,7 +161,7 @@
   (syntax (_ [exception .symbol
               to_expand .any])
     (monad.do meta.monad
-      [[_ _ exception] (meta.export exception)]
+      [[_ exception] (meta.export exception)]
       (function (_ compiler)
         {.#Right [compiler
                   (list (code.bit (when ((expansion.single to_expand) compiler)
diff --git a/stdlib/source/test/lux/meta/type/row.lux b/stdlib/source/test/lux/meta/type/row.lux
index fb2abf4de..b74441df1 100644
--- a/stdlib/source/test/lux/meta/type/row.lux
+++ b/stdlib/source/test/lux/meta/type/row.lux
@@ -112,7 +112,7 @@
                        (_.coverage [/.the]
                          (and (|> (/.row [@birth expected_birth
                                           @life_span expected_life_span])
-                                  (is Mortal)
+                                  (is (Mortal Any))
                                   (/.the @birth)
                                   (same? expected_birth))
                               (|> (/.row [@name expected_name
@@ -129,18 +129,48 @@
                                   (/.the @id)
                                   (same? expected_id))))
                        (_.coverage [/.has]
-                         (|> (/.row [@birth dummy_birth
-                                     @life_span expected_life_span])
-                             (is Mortal)
-                             (/.has @birth expected_birth)
-                             (/.the @birth)
-                             (same? expected_birth)))
+                         (and (|> (/.row [@birth dummy_birth
+                                          @life_span expected_life_span])
+                                  (is (Mortal Any))
+                                  (/.has @birth expected_birth)
+                                  (/.the @birth)
+                                  (same? expected_birth))
+                              (|> (/.row [@name dummy_name
+                                          @birth expected_birth
+                                          @life_span expected_life_span])
+                                  (is (Human Any))
+                                  (/.has @name expected_name)
+                                  (/.the @name)
+                                  (same? expected_name))
+                              (|> (/.row [@id dummy_id
+                                          @name expected_name
+                                          @birth expected_birth
+                                          @life_span expected_life_span])
+                                  (is (TransHuman Nat Any))
+                                  (/.has @id expected_id)
+                                  (/.the @id)
+                                  (same? expected_id))))
                        (_.coverage [/.revised]
-                         (|> (/.row [@birth dummy_birth
-                                     @life_span expected_life_span])
-                             (is Mortal)
-                             (/.revised @birth (function (_ _) expected_birth))
-                             (/.the @birth)
-                             (same? expected_birth)))
+                         (and (|> (/.row [@birth dummy_birth
+                                          @life_span expected_life_span])
+                                  (is (Mortal Any))
+                                  (/.revised @birth (function (_ _) expected_birth))
+                                  (/.the @birth)
+                                  (same? expected_birth))
+                              (|> (/.row [@name dummy_name
+                                          @birth expected_birth
+                                          @life_span expected_life_span])
+                                  (is (Human Any))
+                                  (/.revised @name (function (_ _) expected_name))
+                                  (/.the @name)
+                                  (same? expected_name))
+                              (|> (/.row [@id dummy_id
+                                          @name expected_name
+                                          @birth expected_birth
+                                          @life_span expected_life_span])
+                                  (is (TransHuman Nat Any))
+                                  (/.revised @id (function (_ _) expected_id))
+                                  (/.the @id)
+                                  (same? expected_id))))
                        ))
            )))
diff --git a/stdlib/source/test/lux/world/net.lux b/stdlib/source/test/lux/world/net.lux
index b2c286fc0..08c56fa4b 100644
--- a/stdlib/source/test/lux/world/net.lux
+++ b/stdlib/source/test/lux/world/net.lux
@@ -16,7 +16,8 @@
    ["[1]/[0]" cookie]
    ["[1]/[0]" header]
    ["[1]/[0]" status]
-   ["[1]/[0]" version]]
+   ["[1]/[0]" version]
+   ["[1]/[0]" response]]
   ["[1][0]" uri
    ["[1]/[0]" encoding]
    ["[1]/[0]" scheme]
@@ -45,6 +46,7 @@
            /http/header.test
            /http/status.test
            /http/version.test
+           /http/response.test
 
            /uri/encoding.test
            /uri/scheme.test
diff --git a/stdlib/source/test/lux/world/net/http/client.lux b/stdlib/source/test/lux/world/net/http/client.lux
index ed3eb915c..3eee7b77a 100644
--- a/stdlib/source/test/lux/world/net/http/client.lux
+++ b/stdlib/source/test/lux/world/net/http/client.lux
@@ -29,12 +29,13 @@
  [\\library
   ["[0]" / (.only)
    ["/[1]" // (.only)
+    [response (.only Response)]
     ["[0]" header]
     ["[1][0]" status]]]])
 
 (def (verification ! expected response)
   (All (_ !)
-    (-> (Monad !) Nat (! (Try (//.Response !)))
+    (-> (Monad !) Nat (! (Try (Response !)))
         (! Bit)))
   (do !
     [response response]
diff --git a/stdlib/source/test/lux/world/net/http/response.lux b/stdlib/source/test/lux/world/net/http/response.lux
new file mode 100644
index 000000000..28d726a1f
--- /dev/null
+++ b/stdlib/source/test/lux/world/net/http/response.lux
@@ -0,0 +1,189 @@
+(.require
+ [library
+  [lux (.except)
+   [abstract
+    [monad (.only do)]]
+   [control
+    ["[0]" try (.use "[1]#[0]" functor)]
+    [concurrency
+     ["[0]" async]]]
+   [data
+    ["[0]" product]
+    ["[0]" binary (.use "[1]#[0]" equivalence)]
+    ["[0]" color
+     [named
+      ["[1]T" \\test]]]
+    ["[0]" text (.use "[1]#[0]" equivalence)
+     [encoding
+      ["[0]" utf8 (.use "[1]#[0]" codec)]]]
+    [format
+     ["[0]" html]
+     ["[0]" css (.only)
+      ["[0]" selector]
+      ["[0]" property]
+      ["[0]" value]]
+     ["[0]" json (.use "[1]#[0]" codec)
+      ["[1]T" \\test]]]]
+   [math
+    ["[0]" random (.only Random)]
+    [number
+     ["n" nat]]]
+   [test
+    ["_" property (.only Test)]
+    ["[0]" unit]]]]
+ [\\library
+  ["[0]" / (.only)
+   ["/[1]" // (.only)
+    ["[0]" header]
+    ["[0]" status]
+    [//
+     ["[0]" mime (.use "[1]#[0]" equivalence)]]]]]
+ [//
+  ["[0]T" status]
+  [//
+   ["[0]T" mime]]])
+
+(def .public test
+  Test
+  (<| (_.covering /._)
+      (do [! random.monad]
+        [expected_status statusT.random
+         expected_mime mimeT.random
+         
+         utf8_length (at ! each (n.% 10) random.nat)
+         utf8 (random.upper_cased utf8_length)
+         .let [utf8_data (utf8#encoded utf8)]
+
+         expected_url (at ! each (text.prefix "http://www.example.com/")
+                          (random.upper_cased 1))
+
+         .let [expected_html (html.html/5
+                              (html.head (html.title (html.text utf8)))
+                              (html.body (html.paragraph (list) (html.text utf8))))]
+         expected_json jsonT.random
+         color colorT.random
+         .let [expected_css (css.rule selector.any
+                                      (list [property.text_color
+                                             (value.rgb color)]))]])
+      (_.for [/.Response])
+      (`` (all _.and
+               (,, (with_template [ 
+                                   
+                                    ]
+                     [(_.coverage []
+                        (let [response ]
+                          (and (same?  (the /.#status response))
+                               (|> response
+                                   (the [/.#message //.#headers])
+                                   (header.one header.content_length)
+                                   (try#each (n.= ))
+                                   (try.else false))
+                               (|> response
+                                   (the [/.#message //.#headers])
+                                   (header.one header.content_type)
+                                   (try#each (mime#= ))
+                                   (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]
+                     ))
+               (_.coverage [/.temporary_redirect]
+                 (let [response (/.temporary_redirect expected_url)]
+                   (and (same? status.temporary_redirect (the /.#status response))
+                        (|> response
+                            (the [/.#message //.#headers])
+                            (header.one header.location)
+                            (try#each (text#= expected_url))
+                            (try.else false)))))
+               (in (do async.monad
+                     [.let [response (/.text utf8)]
+                      body ((the [/.#message //.#body] response) {.#None})]
+                     (unit.coverage [/.text]
+                       (and (same? status.ok (the /.#status response))
+                            (|> response
+                                (the [/.#message //.#headers])
+                                (header.one header.content_length)
+                                (try#each (n.= utf8_length))
+                                (try.else false))
+                            (|> response
+                                (the [/.#message //.#headers])
+                                (header.one header.content_type)
+                                (try#each (mime#= mime.utf_8))
+                                (try.else false))
+                            (|> body
+                                (try#each (|>> product.right
+                                               (binary#= utf8_data)))
+                                (try.else false))))))
+               (in (do async.monad
+                     [.let [response (/.html expected_html)
+                            data (|> expected_html
+                                     html.html
+                                     utf8#encoded)
+                            length (binary.size data)]
+                      body ((the [/.#message //.#body] response) {.#None})]
+                     (unit.coverage [/.html]
+                       (and (same? status.ok (the /.#status response))
+                            (|> response
+                                (the [/.#message //.#headers])
+                                (header.one header.content_length)
+                                (try#each (n.= length))
+                                (try.else false))
+                            (|> response
+                                (the [/.#message //.#headers])
+                                (header.one header.content_type)
+                                (try#each (mime#= mime.html))
+                                (try.else false))
+                            (|> body
+                                (try#each (|>> product.right
+                                               (binary#= data)))
+                                (try.else false))))))
+               (in (do async.monad
+                     [.let [response (/.json expected_json)
+                            data (|> expected_json
+                                     json#encoded
+                                     utf8#encoded)
+                            length (binary.size data)]
+                      body ((the [/.#message //.#body] response) {.#None})]
+                     (unit.coverage [/.json]
+                       (and (same? status.ok (the /.#status response))
+                            (|> response
+                                (the [/.#message //.#headers])
+                                (header.one header.content_length)
+                                (try#each (n.= length))
+                                (try.else false))
+                            (|> response
+                                (the [/.#message //.#headers])
+                                (header.one header.content_type)
+                                (try#each (mime#= mime.json))
+                                (try.else false))
+                            (|> body
+                                (try#each (|>> product.right
+                                               (binary#= data)))
+                                (try.else false))))))
+               (in (do async.monad
+                     [.let [response (/.css expected_css)
+                            data (|> expected_css
+                                     css.css
+                                     utf8#encoded)
+                            length (binary.size data)]
+                      body ((the [/.#message //.#body] response) {.#None})]
+                     (unit.coverage [/.css]
+                       (and (same? status.ok (the /.#status response))
+                            (|> response
+                                (the [/.#message //.#headers])
+                                (header.one header.content_length)
+                                (try#each (n.= length))
+                                (try.else false))
+                            (|> response
+                                (the [/.#message //.#headers])
+                                (header.one header.content_type)
+                                (try#each (mime#= mime.css))
+                                (try.else false))
+                            (|> body
+                                (try#each (|>> product.right
+                                               (binary#= data)))
+                                (try.else false))))))
+               ))))
diff --git a/stdlib/source/test/lux/world/net/http/status.lux b/stdlib/source/test/lux/world/net/http/status.lux
index f2522222a..a7cb40039 100644
--- a/stdlib/source/test/lux/world/net/http/status.lux
+++ b/stdlib/source/test/lux/world/net/http/status.lux
@@ -1,11 +1,16 @@
 (.require
  [library
   [lux (.except all)
+   [abstract
+    [monad (.only do)]]
+   [control
+    ["[0]" maybe]]
    [data
     [collection
      ["[0]" list]
      ["[0]" set (.only Set)]]]
    [math
+    ["[0]" random (.only Random)]
     [number
      ["n" nat]]]
    [meta
@@ -14,8 +19,7 @@
    [test
     ["_" property (.only Test)]]]]
  [\\library
-  ["[0]" / (.only)
-   ["/[1]" //]]])
+  ["[0]" /]])
 
 (with_expansions [ (these [informational
                                        [/.continue
@@ -85,9 +89,9 @@
                                         /.not_extended
                                         /.network_authentication_required]])]
   (def all
-    (List //.Status)
+    (List /.Status)
     (list.together (`` (list (,, (with_template [ ]
-                                   [((is (-> Any (List //.Status))
+                                   [((is (-> Any (List /.Status))
                                          (function (_ _)
                                            (`` (list (,, (template.spliced ))))))
                                      123)]
@@ -95,9 +99,16 @@
                                    ))))))
   
   (def unique
-    (Set //.Status)
+    (Set /.Status)
     (set.of_list n.hash ..all))
 
+  (def .public random
+    (Random /.Status)
+    (do [! random.monad]
+      [choice (at ! each (n.% (set.size ..unique))
+                  random.nat)]
+      (in (maybe.trusted (list.item choice all)))))
+
   (def verdict
     (n.= (list.size ..all)
          (set.size ..unique)))
-- 
cgit v1.2.3