From de1d6adc6657feb81332db8620094dd8de150b96 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 14 Jul 2020 03:55:43 -0400 Subject: Mo' fixes, less problems. --- lux-js/source/program.lux | 22 +++-- stdlib/source/lux/data/binary.lux | 7 +- stdlib/source/lux/data/collection/list.lux | 31 +++++-- stdlib/source/lux/data/format/tar.lux | 28 +++--- stdlib/source/lux/data/text/encoding.lux | 44 +++++++-- stdlib/source/lux/debug.lux | 4 +- stdlib/source/lux/host.js.lux | 58 +++++++++--- stdlib/source/lux/tool/compiler/default/init.lux | 6 +- .../source/lux/tool/compiler/default/platform.lux | 5 +- .../language/lux/phase/extension/directive/lux.lux | 51 +++++++---- .../language/lux/phase/generation/js/runtime.lux | 4 +- stdlib/source/lux/world/file.lux | 2 +- stdlib/source/program/compositor.lux | 5 +- stdlib/source/test/lux/extension.lux | 18 ++-- stdlib/source/test/lux/host.js.lux | 102 ++++++++++++++++----- 15 files changed, 276 insertions(+), 111 deletions(-) diff --git a/lux-js/source/program.lux b/lux-js/source/program.lux index bd7dded23..18b31c415 100644 --- a/lux-js/source/program.lux +++ b/lux-js/source/program.lux @@ -501,16 +501,17 @@ (do try.monad [handler (try.from-maybe (..ensure-macro (:coerce Macro handler))) #let [to-js (: (-> Any java/lang/Object) - (|>> (:coerce (Array java/lang/Object)) js-structure (:coerce java/lang/Object)))]] - (jdk/nashorn/api/scripting/JSObject::call #.None - (|> (array.new 2) - (: (Array java/lang/Object)) - (array.write 0 (to-js name)) - (array.write 1 (to-js phase)) - (array.write 2 (to-js archive)) - (array.write 3 (to-js parameters)) - (array.write 4 (to-js state))) - (:coerce jdk/nashorn/api/scripting/JSObject handler))))) + (|>> (:coerce (Array java/lang/Object)) js-structure (:coerce java/lang/Object)))] + output (jdk/nashorn/api/scripting/JSObject::call #.None + (|> (array.new 5) + (: (Array java/lang/Object)) + (array.write 0 name) + (array.write 1 (to-js phase)) + (array.write 2 (to-js archive)) + (array.write 3 (to-js parameters)) + (array.write 4 (to-js state))) + (:coerce jdk/nashorn/api/scripting/JSObject handler))] + (lux-object (:coerce java/lang/Object output))))) (def: (declare-success! _) (-> Any (Promise Any)) @@ -528,6 +529,7 @@ generation.bundle extension/bundle.empty (..program reference.artifact) + [(& Register Text) _.Expression _.Statement] ..extender service [(packager.package _.use-strict _.code _.then) diff --git a/stdlib/source/lux/data/binary.lux b/stdlib/source/lux/data/binary.lux index 30c2bc193..ed038a709 100644 --- a/stdlib/source/lux/data/binary.lux +++ b/stdlib/source/lux/data/binary.lux @@ -75,7 +75,8 @@ (new [ArrayBuffer]) (length host.Number)) - (type: #export Binary Uint8Array))})) + (type: #export Binary + Uint8Array))})) (template: (!size binary) (for {@.old @@ -267,9 +268,9 @@ ## Default (let [source-input (n.- source-offset (!size source)) target-output (n.- target-offset (!size target))] - (if (n.<= target-output source-input) + (if (n.<= source-input target-output) (loop [idx 0] - (if (n.< source-input idx) + (if (n.< target-output idx) (exec (!write (n.+ target-offset idx) (!read (n.+ source-offset idx) source) target) diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux index ce0d8f031..e694a6161 100644 --- a/stdlib/source/lux/data/collection/list.lux +++ b/stdlib/source/lux/data/collection/list.lux @@ -219,17 +219,28 @@ (def: #export (search-all check xs) (All [a b] (-> (-> a (Maybe b)) (List a) (List b))) - (case xs - #.Nil - #.Nil + (for {## TODO: Stop relying on this ASAP. + @.js + (fold (function (_ head tail) + (case (check head) + (#.Some head) + (#.Cons head tail) + + #.None + tail)) + #.Nil + (reverse xs))} + (case xs + #.Nil + #.Nil - (#.Cons x xs') - (case (check x) - (#.Some output) - (#.Cons output (search-all check xs')) - - #.None - (search-all check xs')))) + (#.Cons x xs') + (case (check x) + (#.Some output) + (#.Cons output (search-all check xs')) + + #.None + (search-all check xs'))))) (def: #export (interpose sep xs) {#.doc "Puts a value between every two elements in the list."} diff --git a/stdlib/source/lux/data/format/tar.lux b/stdlib/source/lux/data/format/tar.lux index b803e6453..544540418 100644 --- a/stdlib/source/lux/data/format/tar.lux +++ b/stdlib/source/lux/data/format/tar.lux @@ -172,7 +172,10 @@ (binary.fold n.+ 0)) (def: checksum-checksum - (|> ..dummy-checksum :representation encoding.to-utf8 ..checksum)) + (|> ..dummy-checksum + :representation + encoding.to-utf8 + ..checksum)) (def: checksum-code (-> Binary Checksum) @@ -727,17 +730,15 @@ (def: end-of-archive-size Size (n.* 2 ..block-size)) -(def: end-of-archive - Binary - (binary.create ..end-of-archive-size)) - -(def: #export (writer tar) +(def: #export writer (Writer Tar) - (format@compose (row@fold (function (_ next total) - (format@compose total (..entry-writer next))) - format@identity - tar) - (format.segment ..end-of-archive-size ..end-of-archive))) + (let [end-of-archive (binary.create ..end-of-archive-size)] + (function (_ tar) + (format@compose (row@fold (function (_ next total) + (format@compose total (..entry-writer next))) + format@identity + tar) + (format.segment ..end-of-archive-size end-of-archive))))) (exception: #export (wrong-checksum {expected Nat} {actual Nat}) (exception.report @@ -755,7 +756,10 @@ ## add-in the checksum of the spaces. (def: (expected-checksum checksum header) (-> Checksum Binary Nat) - (let [|checksum| (|> checksum ..from-checksum encoding.to-utf8 ..checksum)] + (let [|checksum| (|> checksum + ..from-checksum + encoding.to-utf8 + ..checksum)] (|> (..checksum header) (n.- |checksum|) (n.+ ..checksum-checksum)))) diff --git a/stdlib/source/lux/data/text/encoding.lux b/stdlib/source/lux/data/text/encoding.lux index 1ef044080..ae1e11021 100644 --- a/stdlib/source/lux/data/text/encoding.lux +++ b/stdlib/source/lux/data/text/encoding.lux @@ -1,6 +1,7 @@ (.module: [lux #* ["@" target] + ["." host] [abstract [codec (#+ Codec)]] [control @@ -8,8 +9,7 @@ [data [binary (#+ Binary)]] [type - abstract] - ["." host]]) + abstract]]) ## https://docs.oracle.com/javase/8/docs/technotes/guides/intl/encoding.doc.html @@ -182,7 +182,14 @@ @.js (as-is (host.import: Uint8Array) - + + ## On Node + (host.import: Buffer + (#static from #as from|encode [host.String host.String] Buffer) + (#static from #as from|decode [Uint8Array] Buffer) + (toString [host.String] host.String)) + + ## On the browser (host.import: TextEncoder (new [host.String]) (encode [host.String] Uint8Array)) @@ -204,8 +211,19 @@ (java/lang/String::getBytes (..name ..utf-8) value) @.js - (|> (TextEncoder::new [(..name ..utf-8)]) - (TextEncoder::encode [value]))})) + (cond host.on-nashorn? + (:coerce Binary ("js object do" "getBytes" value ["utf8"])) + + host.on-node-js? + (|> (Buffer::from|encode [value "utf8"]) + ## This coercion is valid as per NodeJS's documentation: + ## https://nodejs.org/api/buffer.html#buffer_buffers_and_typedarrays + (:coerce Uint8Array)) + + ## On the browser + (|> (TextEncoder::new [(..name ..utf-8)]) + (TextEncoder::encode [value])) + )})) (def: #export (from-utf8 value) (-> Binary (Try Text)) @@ -216,8 +234,20 @@ (#try.Success (java/lang/String::new value (..name ..utf-8))) @.js - (#try.Success (|> (TextDecoder::new [(..name ..utf-8)]) - (TextDecoder::decode [value])))})) + (cond host.on-nashorn? + (|> ("js object new" ("js constant" "java.lang.String") [value "utf8"]) + (:coerce Text) + #try.Success) + + host.on-node-js? + (|> (Buffer::from|decode [value]) + (Buffer::toString ["utf8"]) + #try.Success) + + ## On the browser + (|> (TextDecoder::new [(..name ..utf-8)]) + (TextDecoder::decode [value]) + #try.Success))})) (structure: #export UTF-8 (Codec Binary Text) diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux index f46c3334b..d4f12e9fe 100644 --- a/stdlib/source/lux/debug.lux +++ b/stdlib/source/lux/debug.lux @@ -119,8 +119,8 @@ (`` (|> value (~~ (template.splice ))))) (["boolean" [(:coerce .Bit) %.bit]] - ["string" [(:coerce .Text) %t]] - ["number" [(:coerce .Frac) %f]] + ["string" [(:coerce .Text) %.text]] + ["number" [(:coerce .Frac) %.frac]] ["undefined" [JSON::stringify]]) "object" diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux index cf7902a8f..eb0da3594 100644 --- a/stdlib/source/lux/host.js.lux +++ b/stdlib/source/lux/host.js.lux @@ -8,7 +8,8 @@ ["" code (#+ Parser)]]] [data ["." product] - [text + ["." maybe] + ["." text ["%" format (#+ format)]] [collection ["." list ("#@." functor)]]] @@ -64,7 +65,7 @@ .local-identifier ..nullable))) -(type: Common-Method [Text (List Nullable) Bit Nullable]) +(type: Common-Method [Text (Maybe Text) (List Nullable) Bit Nullable]) (type: Static-Method Common-Method) (type: Virtual-Method Common-Method) @@ -76,6 +77,7 @@ (Parser Common-Method) ($_ <>.and .local-identifier + (<>.maybe (<>.after (.this! (' #as)) .local-identifier)) (.tuple (<>.some ..nullable)) (<>.parses? (.this! (' #try))) ..nullable)) @@ -145,6 +147,15 @@ ..static-method )) +(syntax: #export (try expression) + {#.doc (doc (case (try (risky-computation input)) + (#.Right success) + (do-something success) + + (#.Left error) + (recover-from-failure error)))} + (wrap (list (` ("lux try" ((~! io.io) (~ expression))))))) + (def: (with-try try? without-try) (-> Bit Code Code) (if try? @@ -179,8 +190,10 @@ (with-gensyms [g!object] (let [qualify (: (-> Text Code) (|>> (format class "::") code.local-identifier)) - g!type (code.local-identifier class)] - (wrap (list& (` (type: (~ g!type) (..Object (primitive (~ (code.text class)))))) + g!type (code.local-identifier class) + real-class (text.replace-all "/" "." class)] + (wrap (list& (` (type: (~ g!type) + (..Object (primitive (~ (code.text real-class)))))) (list@map (function (_ member) (case member (#Constructor inputsT) @@ -191,7 +204,7 @@ (~ g!type)) (:assume ("js object new" - ("js constant" (~ (code.text class))) + ("js constant" (~ (code.text real-class))) [(~+ (list@map (with-null g!temp) g!inputs))]))))) (#Field [field fieldT]) @@ -204,12 +217,17 @@ (#Method method) (case method - (#Static [method inputsT try? outputT]) - (make-function (qualify method) g!temp method inputsT try? outputT) + (#Static [method alias inputsT try? outputT]) + (..make-function (qualify (maybe.default method alias)) + g!temp + (format real-class "." method) + inputsT + try? + outputT) - (#Virtual [method inputsT try? outputT]) + (#Virtual [method alias inputsT try? outputT]) (let [g!inputs (input-variables inputsT)] - (` (def: ((~ (qualify method)) + (` (def: ((~ (qualify (maybe.default method alias))) [(~+ (list@map product.right g!inputs))] (~ g!object)) (-> [(~+ (list@map nullable-type inputsT))] @@ -224,8 +242,12 @@ [(~+ (list@map (with-null g!temp) g!inputs))]))))))))))) members))))) - (#Function [name inputsT try? outputT]) - (wrap (list (make-function (code.local-identifier name) g!temp name inputsT try? outputT))) + (#Function [name alias inputsT try? outputT]) + (wrap (list (..make-function (code.local-identifier (maybe.default name alias)) + g!temp + name + inputsT + try? outputT))) ))) (syntax: #export (type-of object) @@ -256,3 +278,17 @@ _ false))) + +(template: (!defined? constant) + (case (..type-of ("js constant" constant)) + "undefined" + false + + _ + true)) + +(def: #export on-nashorn? + Bit + (and (!defined? "java") + (!defined? "java.lang") + (!defined? "java.lang.Object"))) diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux index 88bf45304..a1dff7792 100644 --- a/stdlib/source/lux/tool/compiler/default/init.lux +++ b/stdlib/source/lux/tool/compiler/default/init.lux @@ -49,7 +49,7 @@ ["." artifact] ["." document]]]]]) -(def: #export (state target module expander host-analysis host generate generation-bundle host-directive-bundle program extender) +(def: #export (state target module expander host-analysis host generate generation-bundle host-directive-bundle program anchorT,expressionT,directiveT extender) (All [anchor expression directive] (-> Host Module @@ -60,7 +60,7 @@ (///generation.Bundle anchor expression directive) (///directive.Bundle anchor expression directive) (Program expression directive) - Extender + [Type Type Type] Extender (///directive.State+ anchor expression directive))) (let [synthesis-state [synthesisE.bundle ///synthesis.init] generation-state [generation-bundle (///generation.state host module)] @@ -68,7 +68,7 @@ analysis-state [(analysisE.bundle eval host-analysis) (///analysis.state (///analysis.info ///version.version target))]] [(dictionary.merge host-directive-bundle - (luxD.bundle expander host-analysis program extender)) + (luxD.bundle expander host-analysis program anchorT,expressionT,directiveT extender)) {#///directive.analysis {#///directive.state analysis-state #///directive.phase (analysisP.phase expander)} #///directive.synthesis {#///directive.state synthesis-state diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index f162cc157..0580372c1 100644 --- a/stdlib/source/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/lux/tool/compiler/default/platform.lux @@ -179,7 +179,7 @@ (///phase.run' state) (:: try.monad map product.left))) - (def: #export (initialize static module expander host-analysis platform generation-bundle host-directive-bundle program extender + (def: #export (initialize static module expander host-analysis platform generation-bundle host-directive-bundle program anchorT,expressionT,directiveT extender import compilation-sources) (All [] (-> Static @@ -190,7 +190,7 @@ (///directive.Bundle ) (Program expression directive) - Extender + [Type Type Type] Extender Import (List Context) (Promise (Try [ Archive])))) (do (try.with promise.monad) @@ -203,6 +203,7 @@ generation-bundle host-directive-bundle program + anchorT,expressionT,directiveT extender)] _ (ioW.enable (get@ #&file-system platform) static) [archive analysis-state bundles] (ioW.thaw (get@ #host platform) (get@ #&file-system platform) static import compilation-sources) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux index 59557b6de..090f81842 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux @@ -303,10 +303,10 @@ (define-alias alias def-name)))] (wrap /////directive.no-requirements)))])) -(template [ ] - [(def: ( extender) +(template [ ] + [(def: ( [anchorT expressionT directiveT] extender) (All [anchor expression directive] - (-> Extender + (-> [Type Type Type] Extender (Handler anchor expression directive))) (function (handler extension-name phase archive inputsC+) (case inputsC+ @@ -314,10 +314,7 @@ (do phase.monad [[_ _ name] (evaluate! archive Text nameC) [_ handlerV] ( archive (:coerce Text name) - (:by-example [anchor expression directive] - {(Handler anchor expression directive) - handler} - ) + (type ) valueC) _ (<| (///.install extender (:coerce Text name)) @@ -333,10 +330,26 @@ _ (phase.throw ///.invalid-syntax [extension-name %.code inputsC+]))))] - ["Analysis" def::analysis /////analysis.Handler /////directive.lift-analysis ..analyser] - ["Synthesis" def::synthesis /////synthesis.Handler /////directive.lift-synthesis ..synthesizer] - ["Generation" def::generation (/////generation.Handler anchor expression directive) /////directive.lift-generation ..generator] - ["Directive" def::directive (/////directive.Handler anchor expression directive) (<|) ..directive] + ["Analysis" + def::analysis + /////analysis.Handler /////analysis.Handler + /////directive.lift-analysis + ..analyser] + ["Synthesis" + def::synthesis + /////synthesis.Handler /////synthesis.Handler + /////directive.lift-synthesis + ..synthesizer] + ["Generation" + def::generation + (/////generation.Handler anchorT expressionT directiveT) (/////generation.Handler anchor expression directive) + /////directive.lift-generation + ..generator] + ["Directive" + def::directive + (/////directive.Handler anchorT expressionT directiveT) (/////directive.Handler anchor expression directive) + (<|) + ..directive] ) ## TODO; Both "prepare-program" and "define-program" exist only @@ -393,11 +406,12 @@ _ (phase.throw ///.invalid-syntax [extension-name %.code inputsC+])))) -(def: (bundle::def expander host-analysis program extender) +(def: (bundle::def expander host-analysis program anchorT,expressionT,directiveT extender) (All [anchor expression directive] (-> Expander /////analysis.Bundle (Program expression directive) + [Type Type Type] Extender (Bundle anchor expression directive))) (<| (///bundle.prefix "def") @@ -405,21 +419,22 @@ (dictionary.put "module" def::module) (dictionary.put "alias" def::alias) (dictionary.put "type tagged" (def::type-tagged expander host-analysis)) - (dictionary.put "analysis" (def::analysis extender)) - (dictionary.put "synthesis" (def::synthesis extender)) - (dictionary.put "generation" (def::generation extender)) - (dictionary.put "directive" (def::directive extender)) + (dictionary.put "analysis" (def::analysis anchorT,expressionT,directiveT extender)) + (dictionary.put "synthesis" (def::synthesis anchorT,expressionT,directiveT extender)) + (dictionary.put "generation" (def::generation anchorT,expressionT,directiveT extender)) + (dictionary.put "directive" (def::directive anchorT,expressionT,directiveT extender)) (dictionary.put "program" (def::program program)) ))) -(def: #export (bundle expander host-analysis program extender) +(def: #export (bundle expander host-analysis program anchorT,expressionT,directiveT extender) (All [anchor expression directive] (-> Expander /////analysis.Bundle (Program expression directive) + [Type Type Type] Extender (Bundle anchor expression directive))) (<| (///bundle.prefix "lux") (|> ///bundle.empty (dictionary.put "def" (lux::def expander host-analysis)) - (dictionary.merge (..bundle::def expander host-analysis program extender))))) + (dictionary.merge (..bundle::def expander host-analysis program anchorT,expressionT,directiveT extender))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux index 7c18df1b9..40322f88b 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux @@ -155,8 +155,8 @@ (runtime: (lux//try op) (with-vars [ex] - (_.try (_.return (_.apply/1 op ..unit)) - [ex (_.return (|> ex (_.do "toString" (list))))]))) + (_.try (_.return (..right (_.apply/1 op ..unit))) + [ex (_.return (..left (|> ex (_.do "toString" (list)))))]))) (def: length (-> Expression Computation) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 709704e95..4fd43bf15 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -492,7 +492,7 @@ (..can-query (function (size _) (|> (Fs::statSync [path] (!fs)) - (:: try.monad map (|>> Stats::size frac-to-nat)) + (:: try.monad map (|>> Stats::size f.nat)) io.io)))) (def: last-modified diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index f208fb73e..63c398bf9 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -91,7 +91,7 @@ (with-expansions [ (as-is anchor expression artifact)] (def: #export (compiler static - expander host-analysis platform generation-bundle host-directive-bundle program extender + expander host-analysis platform generation-bundle host-directive-bundle program anchorT,expressionT,directiveT extender service packager,package) (All [] @@ -102,6 +102,7 @@ (generation.Bundle ) (directive.Bundle ) (Program expression artifact) + [Type Type Type] Extender Service [Packager Path] @@ -119,7 +120,7 @@ platform} {(Promise (Try [(directive.State+ ) Archive])) - (:assume (platform.initialize static compilation-module expander host-analysis platform generation-bundle host-directive-bundle program extender + (:assume (platform.initialize static compilation-module expander host-analysis platform generation-bundle host-directive-bundle program anchorT,expressionT,directiveT extender import compilation-sources))}) [archive state] (:share [] {(Platform ) diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index 9aa8ae987..154cb8ea2 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -1,7 +1,8 @@ (.module: [lux #* ["@" target - ["." jvm]] + ["." jvm] + ["." js]] [abstract [monad (#+ do)]] [control @@ -51,13 +52,16 @@ )) (for {@.old - (as-is) + (as-is)} + + (generation: (..my-generation self phase archive {parameters (<>.some .any)}) + (do phase.monad + [] + (wrap (for {@.jvm + (row.row (#jvm.Constant (#jvm.LDC (#jvm.String self)))) - @.jvm - (as-is (generation: (..my-generation self phase archive {parameters (<>.some .any)}) - (do phase.monad - [] - (wrap (row.row (#jvm.Constant (#jvm.LDC (#jvm.String self))))))))}) + @.js + (js.string self)}))))) (for {@.old (as-is)} diff --git a/stdlib/source/test/lux/host.js.lux b/stdlib/source/test/lux/host.js.lux index faf9f6b5f..9112716ca 100644 --- a/stdlib/source/test/lux/host.js.lux +++ b/stdlib/source/test/lux/host.js.lux @@ -1,28 +1,88 @@ (.module: [lux #* - ["&" host] - [math ["r" random]]] - lux/test) + ["_" test (#+ Test)] + [math + ["." random (#+ Random)]] + [abstract + [monad (#+ do)]] + [control + ["." try]] + [data + ["." text ("#@." equivalence)] + [number + ["." nat] + ["." frac]]]] + {1 + ["." /]}) -(context: "JavaScript operations" - ($_ seq - (test "Null equals itself." - (is? (&.null) (&.null))) +(/.import: Uint8Array) - (test "Undefined equals itself." - (is? (&.undef) (&.undef))) +## On Nashorn +(/.import: java/lang/String + (new [Uint8Array /.String]) + (getBytes [/.String] Uint8Array)) - (test "Can reference JavaScript objects." - (is? (&.ref "Math") (&.ref "Math"))) +## On Node +(/.import: Buffer + (#static from [/.String /.String] Buffer) + (toString [/.String] /.String)) - (test "Can create objects and access their fields." - (|> (&.object "foo" "BAR") - (&.get "foo" Text) - (is? "BAR"))) +## On the browser +(/.import: TextEncoder + (new [/.String]) + (encode [/.String] Uint8Array)) - (test "Can call JavaScript functions" - (and (is? +124.0 - (&.call! (&.ref "Math.ceil" &.Function) [+123.45] Frac)) - (is? +124.0 - (&.call! (&.ref "Math") "ceil" [+123.45] Frac)))) - )) +(/.import: TextDecoder + (new [/.String]) + (decode [Uint8Array] /.String)) + +(def: #export test + Test + (do {@ random.monad} + [boolean random.bit + number (:: @ map (|>> (nat.% 100) nat.frac) random.nat) + string (random.ascii 5) + function (:: @ map (function (_ shift) + (: (-> Nat Nat) + (nat.+ shift))) + random.nat) + ## I64s get compiled as JavaScript objects with a specific structure. + object random.nat] + (<| (_.covering /._) + ($_ _.and + (_.cover [/.on-browser? /.on-node-js? /.on-nashorn?] + (or /.on-nashorn? + /.on-node-js? + /.on-browser?)) + (_.cover [/.type-of] + (and (text@= "boolean" (/.type-of boolean)) + (text@= "number" (/.type-of number)) + (text@= "string" (/.type-of string)) + (text@= "function" (/.type-of function)) + (text@= "object" (/.type-of object)))) + (_.cover [/.try] + (case (/.try (error! string)) + (#try.Success _) + false + + (#try.Failure error) + (text@= string error))) + (_.cover [/.import:] + (let [encoding "utf8"] + (text@= string + (cond /.on-nashorn? + (let [binary (java/lang/String::getBytes [encoding] (:coerce java/lang/String string))] + (|> (java/lang/String::new [binary encoding]) + (:coerce Text))) + + /.on-node-js? + (|> (Buffer::from [string encoding]) + (Buffer::toString [encoding])) + + ## On the browser + (let [binary (|> (TextEncoder::new [encoding]) + (TextEncoder::encode [string]))] + (|> (TextDecoder::new [encoding]) + (TextDecoder::decode [binary]))) + )))) + )))) -- cgit v1.2.3