diff options
| author | Eduardo Julian | 2020-12-11 22:40:31 -0400 | 
|---|---|---|
| committer | Eduardo Julian | 2020-12-11 22:40:31 -0400 | 
| commit | dff517cbdb9a1c80028782c62ad91c71ddb34909 (patch) | |
| tree | f69b4005e8b6dc9699a410554ce4571f60d9e0ee /stdlib | |
| parent | 9af671a34728b35c48bff2ba163c371dc5084946 (diff) | |
Improved parsing speed for Lux code.
Diffstat (limited to '')
46 files changed, 741 insertions, 215 deletions
| 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            ))) | 
