diff options
50 files changed, 762 insertions, 224 deletions
diff --git a/lux-bootstrapper/src/lux/analyser/proc/common.clj b/lux-bootstrapper/src/lux/analyser/proc/common.clj index 13d9d0cbd..1226e47f2 100644 --- a/lux-bootstrapper/src/lux/analyser/proc/common.clj +++ b/lux-bootstrapper/src/lux/analyser/proc/common.clj @@ -236,9 +236,7 @@ =else (&&/analyse-1 analyse exo-type ?else)] (return (&/|list (&&/|meta exo-type _location (&&/$proc (&/T ["lux" "syntax char case!"]) - (&/|list =input - (&&/|meta exo-type _location (&&/$tuple (&/|map &/|second =pairs))) - =else) + (&/$Cons =input (&/$Cons =else (&/|map &/|second =pairs))) (&/|map &/|first =pairs))))))) (defn analyse-proc [analyse exo-type proc ?values] diff --git a/lux-bootstrapper/src/lux/compiler/jvm/proc/common.clj b/lux-bootstrapper/src/lux/compiler/jvm/proc/common.clj index 569aa44ad..526e9d491 100644 --- a/lux-bootstrapper/src/lux/compiler/jvm/proc/common.clj +++ b/lux-bootstrapper/src/lux/compiler/jvm/proc/common.clj @@ -346,7 +346,7 @@ (return nil))) (defn ^:private compile-syntax-char-case! [compile ?values ?patterns] - (|do [:let [(&/$Cons ?input (&/$Cons [_ (&a/$tuple ?matches)] (&/$Cons ?else (&/$Nil)))) ?values] + (|do [:let [(&/$Cons ?input (&/$Cons ?else ?matches)) ?values] ^MethodVisitor *writer* &/get-writer :let [pattern-labels (&/|map (fn [_] (new Label)) ?patterns) matched-patterns (->> (&/zip2 ?patterns pattern-labels) diff --git a/lux-bootstrapper/src/lux/optimizer.clj b/lux-bootstrapper/src/lux/optimizer.clj index 6e235e084..c8c8af02f 100644 --- a/lux-bootstrapper/src/lux/optimizer.clj +++ b/lux-bootstrapper/src/lux/optimizer.clj @@ -813,6 +813,14 @@ ($ann _value-expr _type-expr) (&/T [meta ($ann (optimize-iter arity _value-expr) _type-expr)]) + ($proc ["lux" "syntax char case!"] (&/$Cons ?input (&/$Cons ?else ?matches)) ?special-args) + (&/T [meta ($proc (&/T ["lux" "syntax char case!"]) + (&/$Cons ?input + (&/$Cons (optimize-iter arity ?else) + (&/|map (partial optimize-iter arity) + ?matches))) + ?special-args)]) + _ optim ))) @@ -850,6 +858,11 @@ (or (contains-self-reference? func) (&/fold stepwise-test false args)) + ($proc ["lux" "syntax char case!"] (&/$Cons ?input (&/$Cons ?else ?matches)) ?special-args) + (or (contains-self-reference? ?input) + (contains-self-reference? ?else) + (&/fold stepwise-test false ?matches)) + ($proc proc-ident args special-args) (&/fold stepwise-test false args) @@ -871,7 +884,7 @@ (or (contains-self-reference? _test) (contains-self-reference? _then) (contains-self-reference? _else)) - + _ false ))) @@ -946,7 +959,7 @@ (&/|map (partial loop-transform register-offset direct?) args))]) ;; Captured-vars are ignored because they'll be handled properly at shift-function-body - + ($proc proc-ident args special-args) (&/T [meta ($proc proc-ident (&/|map (partial loop-transform register-offset direct?) args) special-args)]) diff --git a/lux-jvm/source/program.lux b/lux-jvm/source/program.lux index 8a6729e1d..c07ecd3e3 100644 --- a/lux-jvm/source/program.lux +++ b/lux-jvm/source/program.lux @@ -18,8 +18,9 @@ [collection [array (#+ Array)] ["." dictionary]]] - [world - ["." file]] + ["." world #_ + ["." file] + ["#/." program]] [target [jvm [bytecode (#+ Bytecode)]]] @@ -156,7 +157,7 @@ (def: (declare-success! _) (-> Any (Promise Any)) - (promise.future (io.exit +0))) + (promise.future (\ world/program.default exit +0))) (program: [{service /cli.service}] (exec (do promise.monad diff --git a/stdlib/source/lux/control/parser/binary.lux b/stdlib/source/lux/control/parser/binary.lux index 6f262f9d2..03bcc9eba 100644 --- a/stdlib/source/lux/control/parser/binary.lux +++ b/stdlib/source/lux/control/parser/binary.lux @@ -169,7 +169,7 @@ (Parser Text) (do //.monad [utf8 <binary>] - (//.lift (encoding.from-utf8 utf8))))] + (//.lift (\ encoding.utf8 decode utf8))))] [utf8/8 ..binary/8] [utf8/16 ..binary/16] diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux index 6e70655b0..d32829e88 100644 --- a/stdlib/source/lux/data/format/binary.lux +++ b/stdlib/source/lux/data/format/binary.lux @@ -164,7 +164,7 @@ (template [<name> <binary>] [(def: #export <name> (Writer Text) - (|>> encoding.to-utf8 <binary>))] + (|>> (\ encoding.utf8 encode) <binary>))] [utf8/8 ..binary/8] [utf8/16 ..binary/16] diff --git a/stdlib/source/lux/data/format/tar.lux b/stdlib/source/lux/data/format/tar.lux index 1d7b1c9f7..0b55a77a2 100644 --- a/stdlib/source/lux/data/format/tar.lux +++ b/stdlib/source/lux/data/format/tar.lux @@ -85,7 +85,7 @@ (\ n.octal encode) (..octal-padding <size>) (text.suffix suffix) - encoding.to-utf8 + (\ encoding.utf8 encode) (format.segment padded-size)))) (def: <coercion> @@ -126,8 +126,7 @@ (Parser Small) (do <>.monad [digits (<b>.segment ..small-size) - digits (<>.lift - (encoding.from-utf8 digits)) + digits (<>.lift (\ encoding.utf8 decode digits)) _ ..verify-small-suffix] (<>.lift (do {! try.monad} @@ -138,8 +137,7 @@ (Parser Big) (do <>.monad [digits (<b>.segment ..big-size) - digits (<>.lift - (encoding.from-utf8 digits)) + digits (<>.lift (\ encoding.utf8 decode digits)) end <b>.bits/8 _ (let [expected (`` (char (~~ (static ..blank))))] (<>.assert (exception.construct ..wrong-character [expected end]) @@ -170,7 +168,7 @@ (def: checksum-checksum (|> ..dummy-checksum :representation - encoding.to-utf8 + (\ encoding.utf8 encode) ..checksum)) (def: checksum-code @@ -188,15 +186,14 @@ (let [padded-size (n.+ (text.size ..checksum-suffix) ..small-size)] (|>> :representation - encoding.to-utf8 + (\ encoding.utf8 encode) (format.segment padded-size)))) (def: checksum-parser (Parser [Nat Checksum]) (do <>.monad [ascii (<b>.segment ..small-size) - digits (<>.lift - (encoding.from-utf8 ascii)) + digits (<>.lift (\ encoding.utf8 decode ascii)) _ ..verify-small-suffix value (<>.lift (\ n.octal decode digits))] @@ -210,7 +207,7 @@ (def: ascii? (-> Text Bit) - (|>> encoding.to-utf8 + (|>> (\ encoding.utf8 encode) (binary.fold (function (_ char verdict) (.and verdict (n.<= ..last-ascii char))) @@ -229,7 +226,7 @@ 0 (#try.Success string) size (loop [end (dec size)] (case end - 0 (#try.Success (encoding.to-utf8 "")) + 0 (#try.Success (\ encoding.utf8 encode "")) _ (do try.monad [last-char (binary.read/8 end string)] (`` (case (.nat last-char) @@ -252,7 +249,7 @@ (def: #export (<in> value) (-> <representation> (Try <type>)) (if (..ascii? value) - (if (|> value encoding.to-utf8 binary.size (n.<= <size>)) + (if (|> value (\ encoding.utf8 encode) binary.size (n.<= <size>)) (#try.Success (:abstraction value)) (exception.throw <exception> [value])) (exception.throw ..not-ascii [value]))) @@ -267,7 +264,7 @@ padded-size (n.+ (text.size suffix) <size>)] (|>> :representation (text.suffix suffix) - encoding.to-utf8 + (\ encoding.utf8 encode) (format.segment padded-size)))) (def: <parser> @@ -281,7 +278,7 @@ (<>.lift (do {! try.monad} [ascii (..un-pad string) - text (encoding.from-utf8 ascii)] + text (\ encoding.utf8 decode ascii)] (<in> text))))) (def: #export <none> @@ -309,7 +306,7 @@ (let [padded-size (n.+ (text.size ..null) ..magic-size)] (|>> :representation - encoding.to-utf8 + (\ encoding.utf8 encode) (format.segment padded-size)))) (def: magic-parser @@ -322,7 +319,7 @@ (n.= expected end))] (<>.lift (\ try.monad map (|>> :abstraction) - (encoding.from-utf8 string))))) + (\ encoding.utf8 decode string))))) ) (def: block-size Size 512) @@ -744,7 +741,7 @@ (-> Checksum Binary Nat) (let [|checksum| (|> checksum ..from-checksum - encoding.to-utf8 + (\ encoding.utf8 encode) ..checksum)] (|> (..checksum header) (n.- |checksum|) diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index 559782b1d..13f272c4b 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -154,7 +154,7 @@ (def: text^ (Parser XML) (|> (<>.either cdata^ - (<text>.many xml-char^)) + (..spaced^ (<text>.many xml-char^))) (<>\map (|>> #Text)))) (def: xml^ diff --git a/stdlib/source/lux/data/text/encoding.lux b/stdlib/source/lux/data/text/encoding.lux index 140acf270..32793f515 100644 --- a/stdlib/source/lux/data/text/encoding.lux +++ b/stdlib/source/lux/data/text/encoding.lux @@ -197,7 +197,7 @@ (new [host.String]) (decode [Uint8Array] host.String)))})) -(def: #export (to-utf8 value) +(def: (to-utf8 value) (-> Text Binary) (for {@.old (java/lang/String::getBytes (..name ..utf-8) @@ -224,7 +224,7 @@ (TextEncoder::encode [value])) )})) -(def: #export (from-utf8 value) +(def: (from-utf8 value) (-> Binary (Try Text)) (for {@.old (#try.Success (java/lang/String::new value (..name ..utf-8))) @@ -248,7 +248,7 @@ (TextDecoder::decode [value]) #try.Success))})) -(structure: #export UTF-8 +(structure: #export utf8 (Codec Binary Text) (def: encode ..to-utf8) diff --git a/stdlib/source/lux/data/text/unicode.lux b/stdlib/source/lux/data/text/unicode.lux index ff0a8a507..00c67f2c1 100644 --- a/stdlib/source/lux/data/text/unicode.lux +++ b/stdlib/source/lux/data/text/unicode.lux @@ -312,10 +312,10 @@ yi-syllables yi-radicals hangul-syllables - high-surrogates - high-private-use-surrogates - low-surrogates - private-use-area + ## high-surrogates + ## high-private-use-surrogates + ## low-surrogates + ## private-use-area cjk-compatibility-ideographs alphabetic-presentation-forms arabic-presentation-forms-a diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index bb2362d62..45985a41a 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -171,7 +171,7 @@ (template [<name> <set>] [(def: #export <name> (-> Nat (Random Text)) - (text (char <set>)))] + (..text (..char <set>)))] [unicode unicode.full] [ascii unicode.ascii] diff --git a/stdlib/source/lux/time.lux b/stdlib/source/lux/time.lux index 70b053a79..0a2f120fb 100644 --- a/stdlib/source/lux/time.lux +++ b/stdlib/source/lux/time.lux @@ -165,21 +165,45 @@ ## (n.< 1,000 millis) ($_ text\compose "." (n\encode millis)))) -(def: (encode time) - (-> Time Text) +(type: #export Clock + {#hour Nat + #minute Nat + #second Nat + #milli-second Nat}) + +(def: #export (clock time) + (-> Time Clock) (let [time (|> time ..to-millis .int duration.from-millis) [hours time] [(duration.query duration.hour time) (duration.frame duration.hour time)] [minutes time] [(duration.query duration.minute time) (duration.frame duration.minute time)] [seconds millis] [(duration.query duration.second time) (duration.frame duration.second time)]] + {#hour (.nat hours) + #minute (.nat minutes) + #second (.nat seconds) + #milli-second (|> millis + (..adjust-negative duration.second) + duration.to-millis + .nat)})) + +(def: #export (time clock) + (-> Clock (Try Time)) + (|> ($_ duration.merge + (duration.scale-up (get@ #hour clock) duration.hour) + (duration.scale-up (get@ #minute clock) duration.minute) + (duration.scale-up (get@ #second clock) duration.second) + (duration.from-millis (.int (get@ #milli-second clock)))) + duration.to-millis + .nat + ..from-millis)) + +(def: (encode time) + (-> Time Text) + (let [(^slots [#hour #minute #second #milli-second]) (..clock time)] ($_ text\compose - (..pad (.nat hours)) - ..separator (..pad (.nat minutes)) - ..separator (..pad (.nat seconds)) - (|> millis - (..adjust-negative duration.second) - duration.to-millis - .nat - ..encode-millis)))) + (..pad hour) + ..separator (..pad minute) + ..separator (..pad second) + (..encode-millis milli-second)))) (structure: #export codec {#.doc (doc "Based on ISO 8601." diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index 7c63b7d31..195d78e83 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -90,7 +90,7 @@ (def: millis-per-day (duration.query duration.milli-second duration.day)) -(def: (date-time instant) +(def: (split-date-time instant) (-> Instant [Date Duration]) (let [offset (..to-millis instant) bce? (i.< +0 offset) @@ -119,7 +119,7 @@ (def: (encode instant) (-> Instant Text) - (let [[date time] (..date-time instant) + (let [[date time] (..split-date-time instant) time (..clock-time time)] ($_ text\compose (\ date.codec encode date) ..date-suffix @@ -155,7 +155,7 @@ (template [<field> <type> <post-processing>] [(def: #export (<field> instant) (-> Instant <type>) - (let [[date time] (..date-time instant)] + (let [[date time] (..split-date-time instant)] (|> <field> <post-processing>)))] [date Date (|>)] @@ -185,3 +185,9 @@ +5 #day.Friday +6 #day.Saturday _ (undefined)))) + +(def: #export (from-date-time date time) + (-> Date Time Instant) + (..from-millis + (i.+ (i.* (date.days date) (duration.to-millis duration.day)) + (.int (//.to-millis time))))) diff --git a/stdlib/source/lux/time/month.lux b/stdlib/source/lux/time/month.lux index 41c85e981..f33a4e11c 100644 --- a/stdlib/source/lux/time/month.lux +++ b/stdlib/source/lux/time/month.lux @@ -4,6 +4,9 @@ [equivalence (#+ Equivalence)] [order (#+ Order)] [enum (#+ Enum)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)]] [data [number ["n" nat]]]]) @@ -46,21 +49,37 @@ _ false))) -(def: #export (number month) - (-> Month Nat) - (case month - #January 01 - #February 02 - #March 03 - #April 04 - #May 05 - #June 06 - #July 07 - #August 08 - #September 09 - #October 10 - #November 11 - #December 12)) +(with-expansions [<pairs> (as-is [01 #January] + [02 #February] + [03 #March] + [04 #April] + [05 #May] + [06 #June] + [07 #July] + [08 #August] + [09 #September] + [10 #October] + [11 #November] + [12 #December])] + (def: #export (number month) + (-> Month Nat) + (case month + (^template [<number> <month>] + [<month> <number>]) + (<pairs>))) + + (exception: #export (invalid-month {number Nat}) + (exception.report + ["Number" (\ n.decimal encode number)])) + + (def: #export (by-number number) + (-> Nat (Try Month)) + (case number + (^template [<number> <month>] + [<number> (#try.Success <month>)]) + (<pairs>) + _ (exception.throw ..invalid-month [number]))) + ) (structure: #export order (Order Month) 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 632cc91c2..d8859f767 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 @@ -781,4 +781,4 @@ (row.row ["0" (|> ..runtime _.code - encoding.to-utf8)])]))) + (\ encoding.utf8 encode))])]))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux index 766e5cbf2..2b5cfd4a8 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux @@ -471,79 +471,76 @@ [..open-tuple ..close-tuple parse-tuple] [..open-record ..close-record parse-record] )] - ## TODO: Add text.space as just another case for "lux syntax char case!" ASAP. - ## It's currently failing for some reason. - (`` (if (!n/= (char (~~ (static text.space))) char/0) + (`` ("lux syntax char case!" char/0 + [[(~~ (static text.space)) + (~~ (static text.carriage-return))] <horizontal-move> - ("lux syntax char case!" char/0 - [[(~~ (static text.carriage-return))] - <horizontal-move> - - ## New line - [(~~ (static text.new-line))] - (recur (!vertical where offset/0 source-code)) - - <composites> - - ## Text - [(~~ (static ..text-delimiter))] - (parse-text where (!inc offset/0) source-code) - - ## Special code - [(~~ (static ..sigil))] - (let [offset/1 (!inc offset/0)] - (<| (!with-char+ source-code//size source-code offset/1 char/1 - (!end-of-file where offset/1 source-code current-module)) - ("lux syntax char case!" char/1 - [[(~~ (static ..name-separator))] - (!parse-short-name current-module <move-2> where #.Tag) - - ## Single-line comment - [(~~ (static ..sigil))] - (case ("lux text index" (!inc offset/1) (static text.new-line) source-code) - (#.Some end) - (recur (!vertical where end source-code)) - - _ - (!end-of-file where offset/1 source-code current-module)) - - (~~ (template [<char> <bit>] - [[<char>] - (#.Right [[(update@ #.column (|>> !inc/2) where) - (!inc offset/1) - source-code] - [where (#.Bit <bit>)]])] - - ["0" #0] - ["1" #1]))] - - ## else - (cond (!name-char?|head char/1) ## Tag - (!parse-full-name offset/1 <move-2> where aliases #.Tag) - - ## else - (!failure ..parse where offset/0 source-code))))) - - ## Coincidentally (= ..name-separator ..frac-separator) - [(~~ (static ..name-separator))] - (let [offset/1 (!inc offset/0)] - (<| (!with-char+ source-code//size source-code offset/1 char/1 - (!end-of-file where offset/1 source-code current-module)) - (if (!digit? char/1) - (parse-rev source-code//size offset/0 where (!inc offset/1) source-code) - (!parse-short-name current-module [where offset/1 source-code] where #.Identifier)))) - - [(~~ (static ..positive-sign)) - (~~ (static ..negative-sign))] - (!parse-signed source-code//size offset/0 where source-code aliases - (!end-of-file where offset/0 source-code current-module))] - - ## else - (if (!digit? char/0) - ## Natural number - (parse-nat source-code//size offset/0 where (!inc offset/0) source-code) - ## Identifier - (!parse-full-name offset/0 <consume-1> where aliases #.Identifier)) - )))) + + ## New line + [(~~ (static text.new-line))] + (recur (!vertical where offset/0 source-code)) + + <composites> + + ## Text + [(~~ (static ..text-delimiter))] + (parse-text where (!inc offset/0) source-code) + + ## Special code + [(~~ (static ..sigil))] + (let [offset/1 (!inc offset/0)] + (<| (!with-char+ source-code//size source-code offset/1 char/1 + (!end-of-file where offset/1 source-code current-module)) + ("lux syntax char case!" char/1 + [[(~~ (static ..name-separator))] + (!parse-short-name current-module <move-2> where #.Tag) + + ## Single-line comment + [(~~ (static ..sigil))] + (case ("lux text index" (!inc offset/1) (static text.new-line) source-code) + (#.Some end) + (recur (!vertical where end source-code)) + + _ + (!end-of-file where offset/1 source-code current-module)) + + (~~ (template [<char> <bit>] + [[<char>] + (#.Right [[(update@ #.column (|>> !inc/2) where) + (!inc offset/1) + source-code] + [where (#.Bit <bit>)]])] + + ["0" #0] + ["1" #1]))] + + ## else + (cond (!name-char?|head char/1) ## Tag + (!parse-full-name offset/1 <move-2> where aliases #.Tag) + + ## else + (!failure ..parse where offset/0 source-code))))) + + ## Coincidentally (= ..name-separator ..frac-separator) + [(~~ (static ..name-separator))] + (let [offset/1 (!inc offset/0)] + (<| (!with-char+ source-code//size source-code offset/1 char/1 + (!end-of-file where offset/1 source-code current-module)) + (if (!digit? char/1) + (parse-rev source-code//size offset/0 where (!inc offset/1) source-code) + (!parse-short-name current-module [where offset/1 source-code] where #.Identifier)))) + + [(~~ (static ..positive-sign)) + (~~ (static ..negative-sign))] + (!parse-signed source-code//size offset/0 where source-code aliases + (!end-of-file where offset/0 source-code current-module))] + + ## else + (if (!digit? char/0) + ## Natural number + (parse-nat source-code//size offset/0 where (!inc offset/0) source-code) + ## Identifier + (!parse-full-name offset/0 <consume-1> where aliases #.Identifier)) + ))) ))) )) diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux index 74f0b4bd8..f8b31df58 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/context.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux @@ -127,7 +127,7 @@ (Promise (Try Input))) (do (try.with promise.monad) [[path binary] (..find-any-source-file system import contexts partial-host-extension module)] - (case (encoding.from-utf8 binary) + (case (\ encoding.utf8 decode binary) (#try.Success code) (wrap {#////.module module #////.file path diff --git a/stdlib/source/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/lux/tool/compiler/meta/packager/script.lux index 5b826a4e0..543b2682a 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/script.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/script.lux @@ -55,7 +55,7 @@ (function (_ artifact so-far) (do (try.with monad) [content (..write-artifact monad file-system static [module artifact]) - content (\ monad wrap (encoding.from-utf8 content))] + content (\ monad wrap (\ encoding.utf8 decode content))] (wrap (sequence so-far (:share [directive] {directive @@ -84,4 +84,4 @@ row.to-list (list\map (|>> (get@ #artifact.id))))])) (monad.fold ! (..write-module monad file-system static sequence) header) - (\ ! map (|>> to-code encoding.to-utf8)))))) + (\ ! map (|>> to-code (\ encoding.utf8 encode))))))) diff --git a/stdlib/source/lux/world/net/http/request.lux b/stdlib/source/lux/world/net/http/request.lux index 094f7ff97..0d9354cd8 100644 --- a/stdlib/source/lux/world/net/http/request.lux +++ b/stdlib/source/lux/world/net/http/request.lux @@ -47,7 +47,7 @@ (-> Body (Promise (Try Text))) (do promise.monad [blobs (frp.consume body)] - (wrap (encoding.from-utf8 (merge blobs))))) + (wrap (\ encoding.utf8 decode (merge blobs))))) (def: failure (//response.bad-request "")) diff --git a/stdlib/source/lux/world/net/http/response.lux b/stdlib/source/lux/world/net/http/response.lux index ee0d7b005..3e06614d2 100644 --- a/stdlib/source/lux/world/net/http/response.lux +++ b/stdlib/source/lux/world/net/http/response.lux @@ -28,7 +28,7 @@ (def: #export empty (-> Status Response) - (let [body (frp\wrap (encoding.to-utf8 ""))] + (let [body (frp\wrap (\ encoding.utf8 encode ""))] (function (_ status) [status {#//.headers (|> context.empty @@ -55,7 +55,7 @@ (def: #export bad-request (-> Text Response) - (|>> encoding.to-utf8 (content status.bad-request mime.utf-8))) + (|>> (\ encoding.utf8 encode) (content status.bad-request mime.utf-8))) (def: #export ok (-> MIME Binary Response) @@ -64,7 +64,7 @@ (template [<name> <type> <mime> <pre>] [(def: #export <name> (-> <type> Response) - (|>> <pre> encoding.to-utf8 (..ok <mime>)))] + (|>> <pre> (\ encoding.utf8 encode) (..ok <mime>)))] [text Text mime.utf-8 (<|)] [html html.Document mime.html html.html] diff --git a/stdlib/source/lux/world/shell.lux b/stdlib/source/lux/world/shell.lux index b3826f21f..aaa686061 100644 --- a/stdlib/source/lux/world/shell.lux +++ b/stdlib/source/lux/world/shell.lux @@ -261,7 +261,7 @@ (..can-write (function (_ message) (|> jvm-output - (java/io/OutputStream::write (encoding.to-utf8 message)))))) + (java/io/OutputStream::write (\ encoding.utf8 encode message)))))) (~~ (template [<name> <capability> <method>] [(def: <name> (<capability> diff --git a/stdlib/source/program/aedifex/cache.lux b/stdlib/source/program/aedifex/cache.lux index d6a8a70ef..50062c3f7 100644 --- a/stdlib/source/program/aedifex/cache.lux +++ b/stdlib/source/program/aedifex/cache.lux @@ -57,16 +57,16 @@ (|> package (get@ #//package.sha-1) (\ //hash.sha-1-codec encode) - encoding.to-utf8) + (\ encoding.utf8 encode)) (format prefix //artifact/extension.sha-1)) _ (..write! system (|> package (get@ #//package.md5) (\ //hash.md5-codec encode) - encoding.to-utf8) + (\ encoding.utf8 encode)) (format prefix //artifact/extension.md5)) _ (..write! system - (|> package (get@ #//package.pom) (\ xml.codec encode) encoding.to-utf8) + (|> package (get@ #//package.pom) (\ xml.codec encode) (\ encoding.utf8 encode)) (format prefix //artifact/extension.pom))] (wrap artifact)))) @@ -91,7 +91,7 @@ (All [a] (-> (Codec Text a) Binary (Try a))) (let [(^open "_\.") try.monad] (|> data - encoding.from-utf8 + (\ encoding.utf8 decode) (_\map (\ codec decode)) _\join))) diff --git a/stdlib/source/program/aedifex/command/install.lux b/stdlib/source/program/aedifex/command/install.lux index d11d96a0c..67dc242ac 100644 --- a/stdlib/source/program/aedifex/command/install.lux +++ b/stdlib/source/program/aedifex/command/install.lux @@ -62,7 +62,7 @@ _ (..save! system (binary.run tar.writer package) (format artifact-name ///artifact/extension.lux-library)) pom (\ promise.monad wrap (///pom.write profile)) - _ (..save! system (|> pom (\ xml.codec encode) encoding.to-utf8) + _ (..save! system (|> pom (\ xml.codec encode) (\ encoding.utf8 encode)) (format artifact-name ///artifact/extension.pom))] (console.write-line //clean.success console))) diff --git a/stdlib/source/program/aedifex/command/pom.lux b/stdlib/source/program/aedifex/command/pom.lux index cf07ad0e0..618c6b4b9 100644 --- a/stdlib/source/program/aedifex/command/pom.lux +++ b/stdlib/source/program/aedifex/command/pom.lux @@ -32,7 +32,7 @@ (file.get-file promise.monad fs ///pom.file)) outcome (|> pom (\ xml.codec encode) - encoding.to-utf8 + (\ encoding.utf8 encode) (!.use (\ file over-write))) _ (console.write-line //clean.success console)] (wrap ///pom.file))) diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index d21adaf0c..e8b0f2dba 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -61,7 +61,7 @@ [actual (\ repository download artifact extension)] (\ promise.monad wrap (do try.monad - [output (encoding.from-utf8 actual) + [output (\ encoding.utf8 decode actual) actual (\ codec decode output) _ (exception.assert exception [dependency output] (\ ///hash.equivalence = (hash library) actual))] @@ -82,7 +82,7 @@ pom (\ repository download artifact ///artifact/extension.pom)] (\ promise.monad wrap (do try.monad - [pom (encoding.from-utf8 pom) + [pom (\ encoding.utf8 decode pom) pom (\ xml.codec decode pom) profile (<xml>.run ///pom.parser pom)] (wrap {#///package.origin #///package.Remote diff --git a/stdlib/source/program/aedifex/input.lux b/stdlib/source/program/aedifex/input.lux index e2bc72154..623346237 100644 --- a/stdlib/source/program/aedifex/input.lux +++ b/stdlib/source/program/aedifex/input.lux @@ -43,7 +43,7 @@ (def: parse-project (-> Binary (Try Project)) (|>> (do> try.monad - [encoding.from-utf8] + [(\ encoding.utf8 decode)] [..parse-lux] [(list) (<c>.run //parser.project)]))) diff --git a/stdlib/source/program/aedifex/metadata.lux b/stdlib/source/program/aedifex/metadata.lux new file mode 100644 index 000000000..0eca976c0 --- /dev/null +++ b/stdlib/source/program/aedifex/metadata.lux @@ -0,0 +1,8 @@ +(.module: + [lux #* + [world + [file (#+ Path)]]]) + +(def: #export file + Path + "maven-metadata.xml") diff --git a/stdlib/source/program/aedifex/metadata/artifact.lux b/stdlib/source/program/aedifex/metadata/artifact.lux new file mode 100644 index 000000000..1f8068111 --- /dev/null +++ b/stdlib/source/program/aedifex/metadata/artifact.lux @@ -0,0 +1,151 @@ +(.module: + [lux (#- Name) + [abstract + [monad (#+ do)] + [equivalence (#+ Equivalence)]] + [control + ["<>" parser + ["<.>" xml (#+ Parser)] + ["<.>" text]]] + [data + ["." product] + ["." text + ["%" format (#+ format)]] + [number + ["n" nat]] + [format + ["." xml (#+ XML)]] + [collection + ["." list ("#\." functor)]]] + ["." time (#+ Time) + ["." instant (#+ Instant)] + ["." date (#+ Date)] + ["." year] + ["." month]]] + ["." /// #_ + ["#." artifact (#+ Group Name Version Artifact)]]) + +(type: #export Metadata + {#group Group + #name Name + #versions (List Version) + #last-updated Instant}) + +(def: (pad value) + (-> Nat Text) + (if (n.< 10 value) + (format "0" (%.nat value)) + (%.nat value))) + +(def: (date-format value) + (%.Format Date) + (format (|> value date.year year.value .nat %.nat) + (|> value date.month month.number ..pad) + (|> value date.day-of-month ..pad))) + +(def: (time-format value) + (%.Format Time) + (let [(^slots [#time.hour #time.minute #time.second]) (time.clock value)] + (format (..pad hour) + (..pad minute) + (..pad second)))) + +(def: (instant-format value) + (%.Format Instant) + (format (..date-format (instant.date value)) + (..time-format (instant.time value)))) + +(template [<definition> <tag>] + [(def: <definition> xml.Tag ["" <tag>])] + + [<group> "groupId"] + [<name> "artifactId"] + [<version> "version"] + [<versions> "versions"] + [<last-updated> "lastUpdated"] + [<metadata> "metadata"] + ) + +(template [<name> <type> <tag> <pre>] + [(def: <name> + (-> <type> XML) + (|>> <pre> #xml.Text list (#xml.Node <tag> xml.attributes)))] + + [write-group Group ..<group> (|>)] + [write-name Name ..<name> (|>)] + [write-version Version ..<version> (|>)] + [write-last-updated Instant ..<last-updated> ..instant-format] + ) + +(def: write-versions + (-> (List Version) XML) + (|>> (list\map ..write-version) (#xml.Node ..<versions> xml.attributes))) + +(def: #export (write value) + (-> Metadata XML) + (#xml.Node ..<metadata> + xml.attributes + (list (..write-group (get@ #group value)) + (..write-name (get@ #name value)) + (..write-versions (get@ #versions value)) + (..write-last-updated (get@ #last-updated value))))) + +(def: (sub tag parser) + (All [a] (-> xml.Tag (Parser a) (Parser a))) + (do <>.monad + [_ (<xml>.node tag)] + (<xml>.children parser))) + +(def: (text tag) + (-> xml.Tag (Parser Text)) + (..sub tag <xml>.text)) + +(def: date-parser + (<text>.Parser Date) + (do <>.monad + [year (<>.codec n.decimal (<text>.exactly 4 <text>.decimal)) + year (<>.lift (year.year (.int year))) + month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal)) + month (<>.lift (month.by-number month)) + day-of-month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))] + (<>.lift (date.date year month day-of-month)))) + +(def: time-parser + (<text>.Parser Time) + (do <>.monad + [hour (<>.codec n.decimal (<text>.exactly 2 <text>.decimal)) + minute (<>.codec n.decimal (<text>.exactly 2 <text>.decimal)) + second (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))] + (<>.lift (time.time + {#time.hour hour + #time.minute minute + #time.second second + #time.milli-second 0})))) + +(def: last-updated-parser + (Parser Instant) + (<text>.embed (do <>.monad + [date ..date-parser + time ..time-parser] + (wrap (instant.from-date-time date time))) + (..text ..<last-updated>))) + +(def: #export parser + (Parser Metadata) + (<| (..sub ..<metadata>) + ($_ <>.and + (<xml>.somewhere (..text ..<group>)) + (<xml>.somewhere (..text ..<name>)) + (<xml>.somewhere (<| (..sub ..<versions>) + (<>.many (..text ..<version>)))) + (<xml>.somewhere ..last-updated-parser) + ))) + +(def: #export equivalence + (Equivalence Metadata) + ($_ product.equivalence + text.equivalence + text.equivalence + (list.equivalence text.equivalence) + instant.equivalence + )) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index bd5c10c66..fdd985f2a 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -21,8 +21,9 @@ [collection ["." dictionary] ["." row (#+ Row)]]] - [world + ["." world #_ ["." file (#+ File Path)] + ["#/." program] ## ["." console] ] [tool @@ -66,7 +67,7 @@ (exec (log! (format text.new-line failure-description text.new-line error text.new-line)) - (io.run (io.exit +1))) + (io.run (\ world/program.default exit +1))) (#try.Success output) (wrap output)))) diff --git a/stdlib/source/program/licentia.lux b/stdlib/source/program/licentia.lux index 032269af3..896f74dab 100644 --- a/stdlib/source/program/licentia.lux +++ b/stdlib/source/program/licentia.lux @@ -62,7 +62,7 @@ [file (!.use (\ file.default file) [input]) blob (!.use (\ file content) []) document (io\wrap (do {! try.monad} - [raw-json (encoding.from-utf8 blob) + [raw-json (\ encoding.utf8 decode blob) json (|> raw-json (:coerce java/lang/String) java/lang/String::trim @@ -73,7 +73,7 @@ (\ ! map /output.license)))) output-file (: (IO (Try (File IO))) (file.get-file io.monad file.default output))] - (!.use (\ output-file over-write) (encoding.to-utf8 document))))] + (!.use (\ output-file over-write) (\ encoding.utf8 encode document))))] (wrap (log! (case ?done (#try.Success _) (success-message output) diff --git a/stdlib/source/program/scriptum.lux b/stdlib/source/program/scriptum.lux index aa15e7bfc..2a205287a 100644 --- a/stdlib/source/program/scriptum.lux +++ b/stdlib/source/program/scriptum.lux @@ -490,7 +490,7 @@ [outcome (do (try.with io.monad) [target (: (IO (Try (File IO))) (file.get-file io.monad file.default path))] - (!.use (\ target over-write) (encoding.to-utf8 (md.markdown documentation))))] + (!.use (\ target over-write) (\ encoding.utf8 encode (md.markdown documentation))))] (case outcome (#try.Failure error) (wrap (log! (ex.construct io-error error))) diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index 9166a4367..704faffbb 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -30,7 +30,9 @@ ["#." parser] ["#." pom] ["#." repository] - ["#." runtime]]) + ["#." runtime] + ["#." metadata #_ + ["#/." artifact]]]) (def: test Test @@ -59,6 +61,7 @@ /pom.test /repository.test /runtime.test + /metadata/artifact.test )) (program: args diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux index eafd1f968..ef08ba39e 100644 --- a/stdlib/source/test/aedifex/command/deploy.lux +++ b/stdlib/source/test/aedifex/command/deploy.lux @@ -123,7 +123,7 @@ deployed-pom! (\ binary.equivalence = - (|> expected-pom (\ xml.codec encode) encoding.to-utf8) + (|> expected-pom (\ xml.codec encode) (\ encoding.utf8 encode)) actual-pom) deployed-sha-1! diff --git a/stdlib/source/test/aedifex/command/pom.lux b/stdlib/source/test/aedifex/command/pom.lux index d63641e04..d179031ea 100644 --- a/stdlib/source/test/aedifex/command/pom.lux +++ b/stdlib/source/test/aedifex/command/pom.lux @@ -46,7 +46,7 @@ (do ! [verdict (do ///action.monad [expected (|> (///pom.write sample) - (try\map (|>> (\ xml.codec encode) encoding.to-utf8)) + (try\map (|>> (\ xml.codec encode) (\ encoding.utf8 encode))) (\ ! wrap)) file (: (Promise (Try (File Promise))) (file.get-file promise.monad fs path)) diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux index 08bbaa4a4..c3e26f5bf 100644 --- a/stdlib/source/test/aedifex/dependency/resolution.lux +++ b/stdlib/source/test/aedifex/dependency/resolution.lux @@ -67,19 +67,19 @@ (#try.Success [state (|> package (get@ #///package.pom) (\ xml.codec encode) - encoding.to-utf8)]) + (\ encoding.utf8 encode))]) (text\= extension ///artifact/extension.sha-1) (#try.Success [state (|> package (get@ #///package.sha-1) (\ ///hash.sha-1-codec encode) - encoding.to-utf8)]) + (\ encoding.utf8 encode))]) (text\= extension ///artifact/extension.md5) (#try.Success [state (|> package (get@ #///package.md5) (\ ///hash.md5-codec encode) - encoding.to-utf8)]) + (\ encoding.utf8 encode))]) ## else (#try.Failure "NOPE")) @@ -109,19 +109,19 @@ (#try.Success [state (|> expected-package (get@ #///package.pom) (\ xml.codec encode) - encoding.to-utf8)]) + (\ encoding.utf8 encode))]) (text\= extension ///artifact/extension.sha-1) (#try.Success [state (|> dummy-package (get@ #///package.sha-1) (\ ///hash.sha-1-codec encode) - encoding.to-utf8)]) + (\ encoding.utf8 encode))]) (text\= extension ///artifact/extension.md5) (#try.Success [state (|> expected-package (get@ #///package.md5) (\ ///hash.md5-codec encode) - encoding.to-utf8)]) + (\ encoding.utf8 encode))]) ## else (#try.Failure "NOPE")) @@ -139,19 +139,19 @@ (#try.Success [state (|> expected-package (get@ #///package.pom) (\ xml.codec encode) - encoding.to-utf8)]) + (\ encoding.utf8 encode))]) (text\= extension ///artifact/extension.sha-1) (#try.Success [state (|> expected-package (get@ #///package.sha-1) (\ ///hash.sha-1-codec encode) - encoding.to-utf8)]) + (\ encoding.utf8 encode))]) (text\= extension ///artifact/extension.md5) (#try.Success [state (|> dummy-package (get@ #///package.md5) (\ ///hash.md5-codec encode) - encoding.to-utf8)]) + (\ encoding.utf8 encode))]) ## else (#try.Failure "NOPE")) @@ -214,19 +214,19 @@ (#try.Success [state (|> expected-package (get@ #///package.pom) (\ xml.codec encode) - encoding.to-utf8)]) + (\ encoding.utf8 encode))]) (text\= extension ///artifact/extension.sha-1) (#try.Success [state (|> dummy-package (get@ #///package.sha-1) (\ ///hash.sha-1-codec encode) - encoding.to-utf8)]) + (\ encoding.utf8 encode))]) (text\= extension ///artifact/extension.md5) (#try.Success [state (|> expected-package (get@ #///package.md5) (\ ///hash.md5-codec encode) - encoding.to-utf8)]) + (\ encoding.utf8 encode))]) ## else (#try.Failure "NOPE")) @@ -244,19 +244,19 @@ (#try.Success [state (|> expected-package (get@ #///package.pom) (\ xml.codec encode) - encoding.to-utf8)]) + (\ encoding.utf8 encode))]) (text\= extension ///artifact/extension.sha-1) (#try.Success [state (|> expected-package (get@ #///package.sha-1) (\ ///hash.sha-1-codec encode) - encoding.to-utf8)]) + (\ encoding.utf8 encode))]) (text\= extension ///artifact/extension.md5) (#try.Success [state (|> dummy-package (get@ #///package.md5) (\ ///hash.md5-codec encode) - encoding.to-utf8)]) + (\ encoding.utf8 encode))]) ## else (#try.Failure "NOPE")) diff --git a/stdlib/source/test/aedifex/input.lux b/stdlib/source/test/aedifex/input.lux index dc424afc8..a0db21ba6 100644 --- a/stdlib/source/test/aedifex/input.lux +++ b/stdlib/source/test/aedifex/input.lux @@ -50,7 +50,7 @@ _ (|> expected //format.profile %.code - encoding.to-utf8 + (\ encoding.utf8 encode) (!.use (\ file over-write))) actual (: (Promise (Try Profile)) (/.read promise.monad fs //.default))] diff --git a/stdlib/source/test/aedifex/metadata/artifact.lux b/stdlib/source/test/aedifex/metadata/artifact.lux new file mode 100644 index 000000000..bb105f305 --- /dev/null +++ b/stdlib/source/test/aedifex/metadata/artifact.lux @@ -0,0 +1,69 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [control + ["." try ("#\." functor)] + [parser + ["<.>" xml]]] + [data + [number + ["n" nat]]] + ["." time + ["." date] + ["." year] + ["." month] + ["." instant] + ["." duration]] + [math + ["." random (#+ Random)]] + [macro + ["." code]]] + {#program + ["." /]}) + +(def: #export random + (Random /.Metadata) + ($_ random.and + (random.ascii/alpha 5) + (random.ascii/alpha 5) + (random.list 5 (random.ascii/alpha 5)) + (do {! random.monad} + [year (\ ! map (|>> (n.% 10,000) .int) random.nat) + month (\ ! map (n.% 13) random.nat) + day-of-month (\ ! map (n.% 29) random.nat) + hour (\ ! map (n.% 24) random.nat) + minute (\ ! map (n.% 60) random.nat) + second (\ ! map (n.% 60) random.nat)] + (wrap (try.assume + (do try.monad + [year (year.year year) + month (month.by-number month) + date (date.date year month day-of-month) + time (time.time + {#time.hour hour + #time.minute minute + #time.second second + #time.milli-second 0})] + (wrap (instant.from-date-time date time)))))))) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Metadata]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (do random.monad + [expected ..random] + (_.cover [/.write /.parser] + (|> expected + /.write + (<xml>.run /.parser) + (try\map (\ /.equivalence = expected)) + (try.default false)))) + ))) diff --git a/stdlib/source/test/lux/control/parser/binary.lux b/stdlib/source/test/lux/control/parser/binary.lux index b967df5db..88c4aafaa 100644 --- a/stdlib/source/test/lux/control/parser/binary.lux +++ b/stdlib/source/test/lux/control/parser/binary.lux @@ -52,8 +52,8 @@ (def: (utf8-conversion-does-not-alter? value) (Predicate Text) (|> value - encoding.to-utf8 - encoding.from-utf8 + (\ encoding.utf8 encode) + (\ encoding.utf8 decode) (case> (#try.Success converted) (text\= value converted) @@ -146,7 +146,7 @@ (`` ($_ _.and (~~ (template [<parser> <format>] [(do {! random.monad} - [expected (\ ! map encoding.to-utf8 (random.ascii ..segment-size))] + [expected (\ ! map (\ encoding.utf8 encode) (random.ascii ..segment-size))] (_.cover [<parser> <format>] (|> (format.run <format> expected) (/.run <parser>) @@ -327,14 +327,14 @@ (/.run /.any) (!expect (#try.Success _)))) (do {! random.monad} - [data (\ ! map encoding.to-utf8 (random.ascii ..segment-size))] + [data (\ ! map (\ encoding.utf8 encode) (random.ascii ..segment-size))] (_.cover [/.binary-was-not-fully-read] (|> data (/.run /.any) (!expect (^multi (#try.Failure error) (exception.match? /.binary-was-not-fully-read error)))))) (do {! random.monad} - [expected (\ ! map encoding.to-utf8 (random.ascii ..segment-size))] + [expected (\ ! map (\ encoding.utf8 encode) (random.ascii ..segment-size))] (_.cover [/.segment format.segment format.run] (|> expected (format.run (format.segment ..segment-size)) @@ -342,7 +342,7 @@ (!expect (^multi (#try.Success actual) (\ binary.equivalence = expected actual)))))) (do {! random.monad} - [data (\ ! map encoding.to-utf8 (random.ascii ..segment-size))] + [data (\ ! map (\ encoding.utf8 encode) (random.ascii ..segment-size))] (_.cover [/.end?] (|> data (/.run (do <>.monad @@ -354,7 +354,7 @@ (!expect (#try.Success #1))))) (do {! random.monad} [to-read (\ ! map (n.% (inc ..segment-size)) random.nat) - data (\ ! map encoding.to-utf8 (random.ascii ..segment-size))] + data (\ ! map (\ encoding.utf8 encode) (random.ascii ..segment-size))] (_.cover [/.Offset /.offset] (|> data (/.run (do <>.monad @@ -369,7 +369,7 @@ (!expect (#try.Success #1))))) (do {! random.monad} [to-read (\ ! map (n.% (inc ..segment-size)) random.nat) - data (\ ! map encoding.to-utf8 (random.ascii ..segment-size))] + data (\ ! map (\ encoding.utf8 encode) (random.ascii ..segment-size))] (_.cover [/.remaining] (|> data (/.run (do <>.monad diff --git a/stdlib/source/test/lux/data/color/named.lux b/stdlib/source/test/lux/data/color/named.lux index fce2e0d90..0420eed19 100644 --- a/stdlib/source/test/lux/data/color/named.lux +++ b/stdlib/source/test/lux/data/color/named.lux @@ -219,8 +219,8 @@ (template [<definition> <by-letter>] [(def: <definition> Test - (`` (_.cover <by-letter> - ..verdict)))] + (_.cover <by-letter> + ..verdict))] <colors>) diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index fc92947ff..f837c0d18 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -159,7 +159,7 @@ #let [content (|> chunk (list.repeat chunks) (text.join-with "") - encoding.to-utf8)]] + (\ encoding.utf8 encode))]] (`` ($_ _.and (~~ (template [<type> <tag>] [(_.cover [<type>] diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index e649040c1..a263b2a82 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -1,6 +1,5 @@ (.module: [lux (#- char) - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] [abstract [monad (#+ Monad do)] @@ -16,7 +15,8 @@ [data ["." name] ["." maybe] - ["." text ("#\." equivalence)] + ["." text ("#\." equivalence) + ["%" format (#+ format)]] [number ["n" nat]] [collection diff --git a/stdlib/source/test/lux/data/number/frac.lux b/stdlib/source/test/lux/data/number/frac.lux index f29cf93b1..ec3e4d3da 100644 --- a/stdlib/source/test/lux/data/number/frac.lux +++ b/stdlib/source/test/lux/data/number/frac.lux @@ -8,6 +8,7 @@ {[0 #spec] [/ ["$." equivalence] + ["$." hash] ["$." order] ["$." monoid] ["$." codec]]}] @@ -95,6 +96,8 @@ (`` ($_ _.and (_.for [/.equivalence /.=] ($equivalence.spec /.equivalence random.safe-frac)) + (_.for [/.hash] + ($hash.spec /.hash random.frac)) (_.for [/.order /.<] ($order.spec /.order random.safe-frac)) (~~ (template [<compose> <monoid>] @@ -232,11 +235,6 @@ (|> expected /.negate /.negate (/.= expected))] (and subtraction! inverse!)))) - (do random.monad - [sample random.frac] - (_.cover [/.hash] - (n.= (/.to-bits sample) - (\ /.hash hash sample)))) ..constant ..predicate diff --git a/stdlib/source/test/lux/data/number/i64.lux b/stdlib/source/test/lux/data/number/i64.lux index 12b935bef..78b293fd5 100644 --- a/stdlib/source/test/lux/data/number/i64.lux +++ b/stdlib/source/test/lux/data/number/i64.lux @@ -11,6 +11,7 @@ {[0 #spec] [/ ["$." equivalence] + ["$." hash] ["$." monoid]]}] [math ["." random (#+ Random)]]] @@ -167,6 +168,8 @@ ($_ _.and (_.for [/.equivalence] ($equivalence.spec /.equivalence random.i64)) + (_.for [/.hash] + ($hash.spec /.hash random.i64)) (_.for [/.disjunction] ($monoid.spec n.equivalence /.disjunction random.nat)) (_.for [/.conjunction] @@ -270,8 +273,6 @@ pattern)] (\= (/.reverse high) low))))) - (_.cover [/.hash] - (n.= pattern (\ /.hash hash pattern))) ..bit ..shift diff --git a/stdlib/source/test/lux/data/number/int.lux b/stdlib/source/test/lux/data/number/int.lux index 02d44e282..33b2927e4 100644 --- a/stdlib/source/test/lux/data/number/int.lux +++ b/stdlib/source/test/lux/data/number/int.lux @@ -6,6 +6,7 @@ {[0 #spec] [/ ["$." equivalence] + ["$." hash] ["$." order] ["$." enum] ["$." interval] @@ -14,8 +15,7 @@ [data ["." bit ("#\." equivalence)] [number - ["f" frac] - ["." i64 ("#\." hash)]]] + ["f" frac]]] [math ["." random (#+ Random)]]] {1 @@ -26,6 +26,8 @@ (`` ($_ _.and (_.for [/.equivalence /.=] ($equivalence.spec /.equivalence random.int)) + (_.for [/.hash] + ($hash.spec /.hash random.int)) (_.for [/.order /.<] ($order.spec /.order random.int)) (_.for [/.enum] @@ -160,11 +162,6 @@ [expected (\ ! map (/.% +1,000,000) random.int)] (_.cover [/.frac] (|> expected /.frac f.int (/.= expected)))) - (do random.monad - [sample random.int] - (_.cover [/.hash] - (i64\= (i64\hash sample) - (\ /.hash hash sample)))) ..predicate ..signature diff --git a/stdlib/source/test/lux/data/number/nat.lux b/stdlib/source/test/lux/data/number/nat.lux index d53ca4631..97f93dc53 100644 --- a/stdlib/source/test/lux/data/number/nat.lux +++ b/stdlib/source/test/lux/data/number/nat.lux @@ -6,6 +6,7 @@ {[0 #spec] [/ ["$." equivalence] + ["$." hash] ["$." order] ["$." enum] ["$." interval] @@ -14,8 +15,7 @@ [data ["." bit ("#\." equivalence)] [number - ["f" frac] - ["." i64 ("#\." hash)]]] + ["f" frac]]] [math ["." random]]] {1 @@ -26,6 +26,8 @@ (`` ($_ _.and (_.for [/.equivalence /.=] ($equivalence.spec /.equivalence random.nat)) + (_.for [/.hash] + ($hash.spec /.hash random.nat)) (_.for [/.order /.<] ($order.spec /.order random.nat)) (_.for [/.enum] @@ -119,11 +121,6 @@ [expected (\ ! map (/.% 1,000,000) random.nat)] (_.cover [/.frac] (|> expected /.frac f.nat (/.= expected)))) - (do random.monad - [sample random.nat] - (_.cover [/.hash] - (i64\= (i64\hash sample) - (\ /.hash hash sample)))) ..predicate ..signature diff --git a/stdlib/source/test/lux/data/number/rev.lux b/stdlib/source/test/lux/data/number/rev.lux index 2807dac8d..294d8b97a 100644 --- a/stdlib/source/test/lux/data/number/rev.lux +++ b/stdlib/source/test/lux/data/number/rev.lux @@ -6,6 +6,7 @@ {[0 #spec] [/ ["$." equivalence] + ["$." hash] ["$." order] ["$." enum] ["$." interval] @@ -27,6 +28,8 @@ (`` ($_ _.and (_.for [/.equivalence /.=] ($equivalence.spec /.equivalence random.rev)) + (_.for [/.hash] + ($hash.spec /.hash random.rev)) (_.for [/.order /.<] ($order.spec /.order random.rev)) (_.for [/.enum] @@ -156,11 +159,6 @@ random.safe-frac)] (_.cover [/.frac] (|> expected f.rev /.frac (f.= expected)))) - (do random.monad - [sample random.rev] - (_.cover [/.hash] - (i64\= (i64\hash sample) - (\ /.hash hash sample)))) ..signature )))) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index cd03b89fc..2dcd2bfa8 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -21,6 +21,7 @@ ["." random]]] ["." / #_ ["#." buffer] + ["#." encoding] ["#." regex]] {1 ["." /]}) @@ -297,5 +298,6 @@ (/.replace-all sep1 sep2 sample1)))) /buffer.test + /encoding.test /regex.test ))) diff --git a/stdlib/source/test/lux/data/text/encoding.lux b/stdlib/source/test/lux/data/text/encoding.lux new file mode 100644 index 000000000..fcf01e93d --- /dev/null +++ b/stdlib/source/test/lux/data/text/encoding.lux @@ -0,0 +1,224 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." codec]]}] + [control + ["." try]] + [data + ["." maybe] + ["." text ("#\." equivalence)] + [number + ["n" nat]] + [collection + ["." list ("#\." functor)] + ["." set]]] + [macro + ["." template]] + [math + ["." random (#+ Random)]]] + {1 + ["." /]}) + +(with-expansions [<encodings> (as-is [all/a + [/.ascii]] + + [all/ibm<1000 + [/.ibm-37 + /.ibm-273 + /.ibm-277 + /.ibm-278 + /.ibm-280 + /.ibm-284 + /.ibm-285 + /.ibm-290 + /.ibm-297 + /.ibm-300 + /.ibm-420 + /.ibm-424 + /.ibm-437 + /.ibm-500 + /.ibm-737 + /.ibm-775 + /.ibm-833 + /.ibm-834 + /.ibm-838 + /.ibm-850 + /.ibm-852 + /.ibm-855 + /.ibm-856 + /.ibm-857 + /.ibm-858 + /.ibm-860 + /.ibm-861 + /.ibm-862 + /.ibm-863 + /.ibm-864 + /.ibm-865 + /.ibm-866 + /.ibm-868 + /.ibm-869 + /.ibm-870 + /.ibm-871 + /.ibm-874 + /.ibm-875 + /.ibm-918 + /.ibm-921 + /.ibm-922 + /.ibm-930 + /.ibm-933 + /.ibm-935 + /.ibm-937 + /.ibm-939 + /.ibm-942 + /.ibm-942c + /.ibm-943 + /.ibm-943c + /.ibm-948 + /.ibm-949 + /.ibm-949c + /.ibm-950 + /.ibm-964 + /.ibm-970]] + + [all/ibm>1000 + [/.ibm-1006 + /.ibm-1025 + /.ibm-1026 + /.ibm-1046 + /.ibm-1047 + /.ibm-1097 + /.ibm-1098 + /.ibm-1112 + /.ibm-1122 + /.ibm-1123 + /.ibm-1124 + /.ibm-1140 + /.ibm-1141 + /.ibm-1142 + /.ibm-1143 + /.ibm-1144 + /.ibm-1145 + /.ibm-1146 + /.ibm-1147 + /.ibm-1148 + /.ibm-1149 + /.ibm-1166 + /.ibm-1364 + /.ibm-1381 + /.ibm-1383 + /.ibm-33722]] + + [all/iso + [/.iso-2022-cn + /.iso2022-cn-cns + /.iso2022-cn-gb + /.iso-2022-jp + /.iso-2022-jp-2 + /.iso-2022-kr + /.iso-8859-1 + /.iso-8859-2 + /.iso-8859-3 + /.iso-8859-4 + /.iso-8859-5 + /.iso-8859-6 + /.iso-8859-7 + /.iso-8859-8 + /.iso-8859-9 + /.iso-8859-11 + /.iso-8859-13 + /.iso-8859-15]] + + [all/mac + [/.mac-arabic + /.mac-central-europe + /.mac-croatian + /.mac-cyrillic + /.mac-dingbat + /.mac-greek + /.mac-hebrew + /.mac-iceland + /.mac-roman + /.mac-romania + /.mac-symbol + /.mac-thai + /.mac-turkish + /.mac-ukraine]] + + [all/utf + [/.utf-8 + /.utf-16 + /.utf-32]] + + [all/windows + [/.windows-31j + /.windows-874 + /.windows-949 + /.windows-950 + /.windows-1250 + /.windows-1252 + /.windows-1251 + /.windows-1253 + /.windows-1254 + /.windows-1255 + /.windows-1256 + /.windows-1257 + /.windows-1258 + /.windows-iso2022jp + /.windows-50220 + /.windows-50221]] + + [all/others + [/.cesu-8 + /.koi8-r + /.koi8-u]] + ) + <named> (template [<definition> <by-letter>] + [((: (-> Any (List /.Encoding)) + (function (_ _) + (`` (list (~~ (template.splice <by-letter>)))))) + 123)] + + <encodings>)] + (def: all-encodings + (list.concat (list <named>))) + + (def: unique-encodings + (set.from-list text.hash (list\map /.name ..all-encodings))) + + (def: verdict + (n.= (list.size ..all-encodings) + (set.size ..unique-encodings))) + + (template [<definition> <by-letter>] + [(def: <definition> + Test + (`` (_.cover [/.name (~~ (template.splice <by-letter>))] + ..verdict)))] + + <encodings>) + + (def: #export random + (Random /.Encoding) + (let [options (list.size ..all-encodings)] + (do {! random.monad} + [choice (\ ! map (n.% options) random.nat)] + (wrap (maybe.assume (list.nth choice ..all-encodings)))))) + + (def: #export test + Test + (<| (_.covering /._) + (_.for [/.Encoding]) + (`` ($_ _.and + (_.for [/.utf8] + ($codec.spec text.equivalence /.utf8 (random.unicode 5))) + + (~~ (template [<definition> <by-letter>] + [<definition>] + + <encodings>)) + )))) + ) diff --git a/stdlib/source/test/lux/locale/language.lux b/stdlib/source/test/lux/locale/language.lux index c1b8a4b5f..fb31baa0e 100644 --- a/stdlib/source/test/lux/locale/language.lux +++ b/stdlib/source/test/lux/locale/language.lux @@ -3,8 +3,12 @@ ["_" test (#+ Test)] [abstract [monad (#+ do)] - [hash (#+ Hash)]] + [hash (#+ Hash)] + {[0 #spec] + [/ + ["$." hash]]}] [data + ["." maybe] ["." text] [number ["n" nat]] @@ -14,7 +18,7 @@ [macro ["." template]] [math - ["." random]]] + ["." random (#+ Random)]]] {1 ["." /]}) @@ -34,7 +38,7 @@ {#count count #names (|> languages (list\map /.name) (set.from-list text.hash)) #codes (|> languages (list\map /.code) (set.from-list text.hash)) - #languages (|> languages (set.from-list /.hash)) + #languages (set.from-list /.hash languages) #test (_.cover <languages> true)}))] @@ -256,11 +260,24 @@ (!aliases /.zaza [/.dimili /.dimli /.kirdki /.kirmanjki /.zazaki]) )) +(def: #export random + (Random /.Language) + (let [options (|> ..languages + (list\map (|>> (get@ #languages) set.to-list)) + list.concat)] + (do {! random.monad} + [choice (\ ! map (n.% (list.size options)) + random.nat)] + (wrap (maybe.assume (list.nth choice options)))))) + (def: #export test Test (<| (_.covering /._) (_.for [/.Language]) ($_ _.and + (_.for [/.hash] + ($hash.spec /.hash ..random)) + ..languages-test ..aliases-test ))) diff --git a/stdlib/source/test/lux/locale/territory.lux b/stdlib/source/test/lux/locale/territory.lux index 4fe08f75a..4fc425804 100644 --- a/stdlib/source/test/lux/locale/territory.lux +++ b/stdlib/source/test/lux/locale/territory.lux @@ -3,8 +3,12 @@ ["_" test (#+ Test)] [abstract [monad (#+ do)] - [hash (#+ Hash)]] + [hash (#+ Hash)] + {[0 #spec] + [/ + ["$." hash]]}] [data + ["." maybe] ["." text] [number ["n" nat]] @@ -14,7 +18,7 @@ [macro ["." template]] [math - ["." random]]] + ["." random (#+ Random)]]] {1 ["." /]}) @@ -196,11 +200,24 @@ (!aliases /.wallis [/.futuna]) )) +(def: #export random + (Random /.Territory) + (let [options (|> ..territories + (list\map (|>> (get@ #territories) set.to-list)) + list.concat)] + (do {! random.monad} + [choice (\ ! map (n.% (list.size options)) + random.nat)] + (wrap (maybe.assume (list.nth choice options)))))) + (def: #export test Test (<| (_.covering /._) (_.for [/.Territory]) ($_ _.and + (_.for [/.hash] + ($hash.spec /.hash ..random)) + ..territories-test ..aliases-test ))) |