diff options
Diffstat (limited to 'stdlib/source/test/lux/data')
36 files changed, 206 insertions, 206 deletions
diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index 691b6ff55..cdb0d9101 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -50,7 +50,7 @@ ["[0]" \\format] ["[0]" \\parser]]]) -(def: !expect +(def !expect (template (_ <expectation> <computation>) [(case <computation> <expectation> @@ -59,9 +59,9 @@ _ false)])) -(def: segment_size 10) +(def segment_size 10) -(def: (utf8_conversion_does_not_alter? value) +(def (utf8_conversion_does_not_alter? value) (Predicate Text) (|> value (at utf8.codec encoded) @@ -73,32 +73,32 @@ {try.#Failure error} false))) -(def: random_text +(def random_text (Random Text) (random.only ..utf8_conversion_does_not_alter? (random.unicode ..segment_size))) -(def: random_symbol +(def random_symbol (Random Symbol) (random.and ..random_text ..random_text)) -(def: location_equivalence +(def location_equivalence (Equivalence Location) (implementation - (def: (= [expected_module expected_line expected_column] + (def (= [expected_module expected_line expected_column] [sample_module sample_line sample_column]) (and (text#= expected_module sample_module) (n.= expected_line sample_line) (n.= expected_column sample_column))))) -(def: random_location +(def random_location (Random Location) (all random.and ..random_text random.nat random.nat)) -(def: random_code +(def random_code (Random Code) (random.rec (function (_ again) @@ -121,7 +121,7 @@ random_sequence ))))))) -(def: random_type +(def random_type (Random Type) (let [(open "[0]") random.monad] (all random.either @@ -130,7 +130,7 @@ (in .Code) (in .Type)))) -(def: size +(def size Test (<| (_.for [\\parser.Size]) (`` (all _.and @@ -151,7 +151,7 @@ [\\parser.size_64 \\parser.bits_64 \\format.bits_64] )))))) -(def: binary +(def binary Test (`` (all _.and (~~ (with_template [<parser> <format>] @@ -169,7 +169,7 @@ [\\parser.binary_64 \\format.binary_64] ))))) -(def: utf8 +(def utf8 Test (`` (all _.and (~~ (with_template [<parser> <format>] @@ -188,7 +188,7 @@ [\\parser.text \\format.text] ))))) -(def: sequence +(def sequence Test (`` (all _.and (~~ (with_template [<parser> <format>] @@ -207,7 +207,7 @@ [\\parser.sequence_64 \\format.sequence_64] ))))) -(def: simple +(def simple Test (`` (all _.and (~~ (with_template [<parser> <format> <random> <equivalence>] @@ -246,7 +246,7 @@ (exception.match? \\parser.not_a_bit error)))))) ))) -(def: complex +(def complex Test (`` (all _.and (~~ (with_template [<parser> <format> <random> <equivalence>] @@ -326,7 +326,7 @@ actual)))))) ))) -(def: \\parser +(def \\parser Test (<| (_.covering \\parser._) (_.for [\\parser.Parser]) @@ -399,18 +399,18 @@ ..complex )))) -(def: equivalence +(def equivalence (Equivalence \\format.Specification) (implementation - (def: (= reference subject) + (def (= reference subject) (/#= (\\format.instance reference) (\\format.instance subject))))) -(def: random_specification +(def random_specification (Random \\format.Specification) (at random.monad each \\format.nat random.nat)) -(def: \\format +(def \\format Test (<| (_.covering \\format._) (_.for [\\format.Mutation \\format.Specification \\format.Writer]) @@ -419,7 +419,7 @@ ($monoid.spec ..equivalence \\format.monoid ..random_specification)) ))) -(def: (succeed result) +(def (succeed result) (-> (Try Bit) Bit) (case result {try.#Failure _} @@ -428,7 +428,7 @@ {try.#Success output} output)) -(def: .public (random size) +(def .public (random size) (-> Nat (Random /.Binary)) (let [output (/.empty size)] (loop (again [idx 0]) @@ -439,7 +439,7 @@ (again (++ idx)))) (at random.monad in output))))) -(def: (throws? exception try) +(def (throws? exception try) (All (_ e a) (-> (Exception e) (Try a) Bit)) (case try {try.#Failure error} @@ -448,7 +448,7 @@ {try.#Success _} false)) -(def: (binary_io power read write value) +(def (binary_io power read write value) (-> Nat (-> Nat /.Binary (Try Nat)) (-> Nat Nat /.Binary (Try Any)) Nat Bit) (let [bytes (i64.left_shifted power 1) binary (/.empty bytes) @@ -466,13 +466,13 @@ (throws? /.index_out_of_bounds (read 1 binary)) (throws? /.index_out_of_bounds (write 1 value binary))))) -(def: as_list +(def as_list (-> /.Binary (List Nat)) (/.mix (function (_ head tail) {.#Item head tail}) (list))) -(def: test|unsafe +(def test|unsafe Test (<| (_.covering !._) (_.for [!.Binary]) @@ -536,7 +536,7 @@ (n.= 0 copy/1))))) ))))) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.Binary]) diff --git a/stdlib/source/test/lux/data/bit.lux b/stdlib/source/test/lux/data/bit.lux index 868c673f6..7b6b72d08 100644 --- a/stdlib/source/test/lux/data/bit.lux +++ b/stdlib/source/test/lux/data/bit.lux @@ -16,7 +16,7 @@ [\\library ["[0]" /]]) -(def: .public test +(def .public test Test (<| (_.covering /._) (do random.monad diff --git a/stdlib/source/test/lux/data/collection.lux b/stdlib/source/test/lux/data/collection.lux index ffbe005bb..2f85ba057 100644 --- a/stdlib/source/test/lux/data/collection.lux +++ b/stdlib/source/test/lux/data/collection.lux @@ -21,7 +21,7 @@ ["[1]/[0]" finger] ["[1]/[0]" zipper]]]) -(def: dictionary +(def dictionary Test (all _.and /dictionary.test @@ -29,14 +29,14 @@ /dictionary/plist.test )) -(def: queue +(def queue Test (all _.and /queue.test /queue/priority.test )) -(def: set +(def set Test (all _.and /set.test @@ -44,7 +44,7 @@ /set/ordered.test )) -(def: tree +(def tree Test (all _.and /tree.test @@ -52,7 +52,7 @@ /tree/zipper.test )) -(def: .public test +(def .public test Test (all _.and /array.test diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index d62e20981..73d2b7b3a 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -28,16 +28,16 @@ ["[0]" / (.only Array) ["!" \\unsafe]]]) -(def: injection +(def injection (Injection Array) (|>> list /.of_list)) -(def: bounded_size +(def bounded_size (Random Nat) (at random.monad each (|>> (n.% 20) ++) random.nat)) -(def: structures +(def structures Test (do [! random.monad] [size ..bounded_size] @@ -52,7 +52,7 @@ ($mix.spec ..injection /.equivalence /.mix)) ))) -(def: search +(def search Test (do [! random.monad] [size ..bounded_size @@ -114,7 +114,7 @@ (/.any? n.even? the_array))) ))) -(def: test|unsafe +(def test|unsafe Test (<| (_.covering !._) (_.for [!.Array]) @@ -134,8 +134,8 @@ (_.for [!.composite] ($monoid.spec (/.equivalence n.equivalence) (implementation - (def: identity (!.empty 0)) - (def: (composite left right) + (def identity (!.empty 0)) + (def (composite left right) (!.composite left right))) (random.array size random.nat))) (_.for [!.each] @@ -304,7 +304,7 @@ (!.any? n.even? the_array))) ))))) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.Array]) diff --git a/stdlib/source/test/lux/data/collection/bits.lux b/stdlib/source/test/lux/data/collection/bits.lux index 72bd8a31f..a53a0f042 100644 --- a/stdlib/source/test/lux/data/collection/bits.lux +++ b/stdlib/source/test/lux/data/collection/bits.lux @@ -14,12 +14,12 @@ [\\library ["[0]" / (.only Bits)]]) -(def: (size min max) +(def (size min max) (-> Nat Nat (Random Nat)) (|> random.nat (at random.monad each (|>> (n.% (++ max)) (n.max min))))) -(def: .public random +(def .public random (Random Bits) (do [! random.monad] [size (at ! each (n.% 1,000) random.nat)] @@ -29,7 +29,7 @@ [idx (|> random.nat (at ! each (n.% size)))] (in (/.one idx /.empty)))))) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.Bits]) diff --git a/stdlib/source/test/lux/data/collection/dictionary.lux b/stdlib/source/test/lux/data/collection/dictionary.lux index f5c0b4c9d..e4207f540 100644 --- a/stdlib/source/test/lux/data/collection/dictionary.lux +++ b/stdlib/source/test/lux/data/collection/dictionary.lux @@ -24,11 +24,11 @@ [\\library ["[0]" /]]) -(def: injection +(def injection (Injection (/.Dictionary Nat)) (|>> [0] list (/.of_list n.hash))) -(def: for_dictionaries +(def for_dictionaries Test (do [! random.monad] [.let [capped_nat (at random.monad each (n.% 100) random.nat)] @@ -56,8 +56,8 @@ [constant random.nat .let [hash (is (Hash Nat) (implementation - (def: equivalence n.equivalence) - (def: (hash _) + (def equivalence n.equivalence) + (def (hash _) constant)))]] (_.coverage [/.key_hash] (same? hash (/.key_hash (/.empty hash))))) @@ -130,7 +130,7 @@ (|> dict /.entries (/.of_list n.hash) (= dict))))) ))) -(def: for_entries +(def for_entries Test (do random.monad [.let [capped_nat (at random.monad each (n.% 100) random.nat)] @@ -248,7 +248,7 @@ (maybe.trusted (/.value non_key rebound))))))) ))) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.Dictionary]) diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux index 19454582a..c90d91cda 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux @@ -23,7 +23,7 @@ [\\library ["[0]" /]]) -(def: .public (dictionary order gen_key gen_value size) +(def .public (dictionary order gen_key gen_value size) (All (_ k v) (-> (Order k) (Random k) (Random v) Nat (Random (/.Dictionary k v)))) (case size @@ -38,7 +38,7 @@ value gen_value] (in (/.has key value partial))))) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.Dictionary]) diff --git a/stdlib/source/test/lux/data/collection/dictionary/plist.lux b/stdlib/source/test/lux/data/collection/dictionary/plist.lux index 7cd9ad3aa..46874e2d1 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/plist.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/plist.lux @@ -22,7 +22,7 @@ [\\library ["[0]" /]]) -(def: .public (random size gen_key gen_value) +(def .public (random size gen_key gen_value) (All (_ v) (-> Nat (Random Text) (Random v) (Random (/.PList v)))) (do random.monad @@ -30,7 +30,7 @@ values (random.list size gen_value)] (in (list.zipped_2 (set.list keys) values)))) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.PList]) diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index f82ac2f35..61d1f7a0d 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -32,12 +32,12 @@ [\\library ["[0]" / (.open: "[1]#[0]" monad)]]) -(def: bounded_size +(def bounded_size (Random Nat) (at random.monad each (n.% 100) random.nat)) -(def: random +(def random (Random (List Nat)) (do [! random.monad] [size ..bounded_size] @@ -45,7 +45,7 @@ (random.set n.hash size) (at ! each set.list)))) -(def: signatures +(def signatures Test (all _.and (_.for [/.equivalence] @@ -84,7 +84,7 @@ false))))) )) -(def: whole +(def whole Test (do [! random.monad] [size ..bounded_size @@ -128,7 +128,7 @@ symmetry!))) ))) -(def: indices +(def indices Test (let [(open "/#[0]") (/.equivalence n.equivalence) (open "/#[0]") /.functor] @@ -188,7 +188,7 @@ _ (not changed?)))) )))) -(def: slice +(def slice Test (let [(open "/#[0]") (/.equivalence n.equivalence) (open "/#[0]") /.monoid] @@ -237,7 +237,7 @@ (/.together subs))))) )))) -(def: member +(def member Test (let [(open "/#[0]") (/.equivalence n.equivalence)] (do [! random.monad] @@ -275,7 +275,7 @@ )) ))))) -(def: grouping +(def grouping Test (let [(open "/#[0]") (/.equivalence n.equivalence) (open "/#[0]") /.functor @@ -370,7 +370,7 @@ (/.together (list sample/0 sample/1 sample/2))))) )))) -(def: search +(def search Test (let [(open "/#[0]") /.functor @@ -411,7 +411,7 @@ (not (/.any? n.even? sample)))) )))) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [.List]) diff --git a/stdlib/source/test/lux/data/collection/queue.lux b/stdlib/source/test/lux/data/collection/queue.lux index 460c64618..c5fe69611 100644 --- a/stdlib/source/test/lux/data/collection/queue.lux +++ b/stdlib/source/test/lux/data/collection/queue.lux @@ -19,11 +19,11 @@ [\\library ["[0]" /]]) -(def: injection +(def injection (Injection /.Queue) (|>> list /.of_list)) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.Queue]) diff --git a/stdlib/source/test/lux/data/collection/queue/priority.lux b/stdlib/source/test/lux/data/collection/queue/priority.lux index 106884fa1..9013b4a44 100644 --- a/stdlib/source/test/lux/data/collection/queue/priority.lux +++ b/stdlib/source/test/lux/data/collection/queue/priority.lux @@ -15,7 +15,7 @@ [\\library ["[0]" / (.only Queue)]]) -(def: .public (random size) +(def .public (random size) (-> Nat (Random (Queue Nat))) (do [! random.monad] [inputs (random.list size random.nat)] @@ -26,7 +26,7 @@ /.empty inputs))) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.Queue]) diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux index 445d6b033..c6d9f6d4d 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -27,7 +27,7 @@ [\\library ["[0]" / (.open: "[1]#[0]" monad)]]) -(def: signatures +(def signatures Test (do [! random.monad] [size (at ! each (n.% 100) random.nat)] @@ -46,7 +46,7 @@ ($monad.spec /#in /.equivalence /.monad)) ))) -(def: whole +(def whole Test (do [! random.monad] [size (at ! each (n.% 100) random.nat) @@ -79,7 +79,7 @@ (/.any? (bit.complement n.even?) sample))) ))) -(def: index_based +(def index_based Test (do [! random.monad] [size (at ! each (|>> (n.% 100) ++) random.nat)] @@ -130,7 +130,7 @@ )) ))) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.Sequence]) diff --git a/stdlib/source/test/lux/data/collection/set.lux b/stdlib/source/test/lux/data/collection/set.lux index be1168ad5..7dfd3b682 100644 --- a/stdlib/source/test/lux/data/collection/set.lux +++ b/stdlib/source/test/lux/data/collection/set.lux @@ -20,12 +20,12 @@ [\\library ["[0]" / (.open: "[1]#[0]" equivalence)]]) -(def: gen_nat +(def gen_nat (Random Nat) (at random.monad each (n.% 100) random.nat)) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.Set]) @@ -55,9 +55,9 @@ [hash (at ! each (function (_ constant) (is (Hash Nat) (implementation - (def: equivalence n.equivalence) + (def equivalence n.equivalence) - (def: (hash _) + (def (hash _) constant)))) random.nat)] (_.coverage [/.member_hash] diff --git a/stdlib/source/test/lux/data/collection/set/multi.lux b/stdlib/source/test/lux/data/collection/set/multi.lux index 0cabf93c6..6a05d80c9 100644 --- a/stdlib/source/test/lux/data/collection/set/multi.lux +++ b/stdlib/source/test/lux/data/collection/set/multi.lux @@ -21,11 +21,11 @@ [\\library ["[0]" /]]) -(def: count +(def count (Random Nat) (at random.monad each (|>> (n.% 10) ++) random.nat)) -(def: .public (random size hash count element) +(def .public (random size hash count element) (All (_ a) (-> Nat (Hash a) (Random Nat) (Random a) (Random (/.Set a)))) (do [! random.monad] [elements (random.set hash size element) @@ -36,7 +36,7 @@ (list.zipped_2 element_counts (set.list elements)))))) -(def: signature +(def signature Test (do [! random.monad] [diversity (at ! each (n.% 10) random.nat)] @@ -50,7 +50,7 @@ ($hash.spec /.hash))) ))) -(def: composition +(def composition Test (do [! random.monad] [diversity (at ! each (n.% 10) random.nat) @@ -108,7 +108,7 @@ common_changes!))) )))) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.Set]) diff --git a/stdlib/source/test/lux/data/collection/set/ordered.lux b/stdlib/source/test/lux/data/collection/set/ordered.lux index 95f1644a1..f95f2e481 100644 --- a/stdlib/source/test/lux/data/collection/set/ordered.lux +++ b/stdlib/source/test/lux/data/collection/set/ordered.lux @@ -19,11 +19,11 @@ ["[0]" / (.only Set) ["[0]" //]]]) -(def: size +(def size (random.Random Nat) (at random.monad each (n.% 100) random.nat)) -(def: .public (random size order gen_value) +(def .public (random size order gen_value) (All (_ a) (-> Nat (Order a) (Random a) (Random (Set a)))) (case size 0 @@ -36,7 +36,7 @@ gen_value)] (in (/.has value partial))))) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.Set]) diff --git a/stdlib/source/test/lux/data/collection/stack.lux b/stdlib/source/test/lux/data/collection/stack.lux index 3f600a958..64339fccd 100644 --- a/stdlib/source/test/lux/data/collection/stack.lux +++ b/stdlib/source/test/lux/data/collection/stack.lux @@ -18,11 +18,11 @@ [\\library ["[0]" /]]) -(def: (injection value) +(def (injection value) (Injection /.Stack) (/.top value /.empty)) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.Stack]) diff --git a/stdlib/source/test/lux/data/collection/stream.lux b/stdlib/source/test/lux/data/collection/stream.lux index 17bb614ad..398873f2f 100644 --- a/stdlib/source/test/lux/data/collection/stream.lux +++ b/stdlib/source/test/lux/data/collection/stream.lux @@ -21,15 +21,15 @@ [\\library ["[0]" /]]) -(def: (equivalence super) +(def (equivalence super) (All (_ a) (-> (Equivalence a) (Equivalence (/.Stream a)))) (implementation - (def: (= reference subject) + (def (= reference subject) (at (list.equivalence super) = (/.first 100 reference) (/.first 100 subject))))) -(def: (iterations step) +(def (iterations step) (All (_ a) (-> (-> a a) (-> a (/.Stream a)))) @@ -38,7 +38,7 @@ (let [state' (step state)] [state' state])))) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.Stream]) diff --git a/stdlib/source/test/lux/data/collection/tree.lux b/stdlib/source/test/lux/data/collection/tree.lux index f1d964e2e..a302565f9 100644 --- a/stdlib/source/test/lux/data/collection/tree.lux +++ b/stdlib/source/test/lux/data/collection/tree.lux @@ -19,7 +19,7 @@ [\\library ["[0]" / (.only Tree)]]) -(def: .public (tree gen_value) +(def .public (tree gen_value) (All (_ a) (-> (Random a) (Random [Nat (Tree a)]))) (do [! random.monad] [value gen_value @@ -31,7 +31,7 @@ [/.#value value /.#children (list#each product.right children)]]))) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.Tree]) diff --git a/stdlib/source/test/lux/data/collection/tree/finger.lux b/stdlib/source/test/lux/data/collection/tree/finger.lux index bb6d9ac98..bad7dec35 100644 --- a/stdlib/source/test/lux/data/collection/tree/finger.lux +++ b/stdlib/source/test/lux/data/collection/tree/finger.lux @@ -18,16 +18,16 @@ [\\library ["[0]" /]]) -(def: builder +(def builder (/.builder text.monoid)) -(def: :@: +(def :@: (by_example [@] (is (/.Builder @ Text) ..builder) @)) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.Tree]) diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux index eb4a1c553..c98560160 100644 --- a/stdlib/source/test/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux @@ -25,7 +25,7 @@ ["[0]" / (.only Zipper) ["tree" //]]]) -(def: move +(def move Test (do random.monad [expected random.nat @@ -151,7 +151,7 @@ (maybe.else false)))) ))) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.Zipper]) diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index e1d06c542..a59494de6 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -21,30 +21,30 @@ [\\library ["[0]" /]]) -(def: .public random +(def .public random (Random /.Color) (|> (all random.and random.nat random.nat random.nat) (at random.monad each /.of_rgb))) -(def: scale +(def scale (-> Nat Frac) (|>> .int int.frac)) -(def: square +(def square (-> Frac Frac) (f.pow +2.0)) -(def: square_root +(def square_root (-> Frac Frac) (f.pow +0.5)) -(def: (distance/1 from to) +(def (distance/1 from to) (-> Frac Frac Frac) (square_root (square (f.- from to)))) -(def: (distance/3 from to) +(def (distance/3 from to) (-> /.Color /.Color Frac) (let [[fr fg fb] (/.rgb from) [tr tg tb] (/.rgb to)] @@ -54,10 +54,10 @@ (|> (scale tg) (f.- (scale fg)) square) (|> (scale tb) (f.- (scale fb)) square))))) -(def: rgb_error_margin +1.8) +(def rgb_error_margin +1.8) (with_template [<field>] - [(def: (<field> color) + [(def (<field> color) (-> /.Color Frac) (let [[hue saturation luminance] (/.hsl color)] <field>))] @@ -66,7 +66,7 @@ [luminance] ) -(def: (encoding expected) +(def (encoding expected) (-> /.Color Test) (all _.and (_.coverage [/.RGB /.rgb /.of_rgb] @@ -86,7 +86,7 @@ (f.<= ..rgb_error_margin))) )) -(def: transformation +(def transformation Test (do random.monad [colorful (|> ..random @@ -125,7 +125,7 @@ (f.<= ..rgb_error_margin))))) ))) -(def: palette +(def palette Test (_.for [/.Spread /.Palette] (do [! random.monad] @@ -174,7 +174,7 @@ [/.tetradic])) ))))) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.Color]) diff --git a/stdlib/source/test/lux/data/color/named.lux b/stdlib/source/test/lux/data/color/named.lux index 7034f41d1..4365468df 100644 --- a/stdlib/source/test/lux/data/color/named.lux +++ b/stdlib/source/test/lux/data/color/named.lux @@ -200,7 +200,7 @@ [/.yellow /.yellow_green]] )] - (def: all_colors + (def all_colors (list.together (`` (list (~~ (with_template [<definition> <by_letter>] [((is (-> Any (List //.Color)) (function (_ _) @@ -209,22 +209,22 @@ <colors>)))))) - (def: unique_colors + (def unique_colors (set.of_list //.hash ..all_colors)) - (def: verdict + (def verdict (n.= (list.size ..all_colors) (set.size ..unique_colors))) (with_template [<definition> <by_letter>] - [(def: <definition> + [(def <definition> Test (_.coverage <by_letter> ..verdict))] <colors>) - (def: .public test + (def .public test Test (<| (_.covering /._) (`` (all _.and diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index 613767144..13d7f11cc 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -76,7 +76,7 @@ #date date.Date #grams (unit.Qty unit.Gram)])) -(def: gen_recursive +(def gen_recursive (Random Recursive) (random.rec (function (_ gen_recursive) @@ -84,11 +84,11 @@ (random.and random.safe_frac gen_recursive))))) -(def: qty +(def qty (All (_ unit) (Random (unit.Qty unit))) (at random.monad each unit.quantity random.int)) -(def: gen_record +(def gen_record (Random Record) (do [! random.monad] [size (at ! each (n.% 2) random.nat)] @@ -109,22 +109,22 @@ ))) (for @.old (these) - (these (def: equivalence + (these (def equivalence (Equivalence Record) (\\polytypic/equivalence.equivalence Record)) - (def: codec + (def codec (Codec JSON Record) (\\polytypic.codec Record)))) -(def: \\polytypic +(def \\polytypic Test (<| (_.covering \\polytypic._) (_.for [\\polytypic.codec] (for @.old (_.property "PLACEHOLDER" true) ($codec.spec ..equivalence ..codec ..gen_record))))) -(def: .public random +(def .public random (Random /.JSON) (random.rec (function (_ again) @@ -139,25 +139,25 @@ (random.dictionary text.hash size (random.unicode size) again) ))))) -(def: boolean +(def boolean (syntax (_ []) (do meta.monad [value meta.seed] (in (list (code.bit (n.even? value))))))) -(def: number +(def number (syntax (_ []) (do meta.monad [value meta.seed] (in (list (code.frac (n.frac value))))))) -(def: string +(def string (syntax (_ []) (do meta.monad [value (macro.symbol "string")] (in (list (code.text (%.code value))))))) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.JSON]) diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index 16bf8fb62..dad5eea06 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -35,7 +35,7 @@ [\\library ["[0]" /]]) -(def: path +(def path Test (_.for [/.Path] (do [! random.monad] @@ -70,7 +70,7 @@ (exception.match? /.not_ascii error))) ))))) -(def: name +(def name Test (_.for [/.Name] (do [! random.monad] @@ -103,7 +103,7 @@ (exception.match? /.not_ascii error))) ))))) -(def: small +(def small Test (_.for [/.Small] (do [! random.monad] @@ -127,7 +127,7 @@ (exception.match? /.not_a_small_number error))) ))))) -(def: big +(def big Test (_.for [/.Big] (do [! random.monad] @@ -151,9 +151,9 @@ (exception.match? /.not_a_big_number error))) ))))) -(def: chunk_size 32) +(def chunk_size 32) -(def: entry +(def entry Test (do [! random.monad] [expected_path (random.lower_case (-- /.path_size)) @@ -221,7 +221,7 @@ [/.Contiguous /.#Contiguous] )))))))) -(def: random_mode +(def random_mode (Random /.Mode) (do [! random.monad] [] @@ -238,7 +238,7 @@ (random.either (in /.set_group_id_on_execution) (in /.set_user_id_on_execution))))))) -(def: mode +(def mode Test (_.for [/.Mode /.mode] (do [! random.monad] @@ -311,7 +311,7 @@ [/.set_user_id_on_execution] ))))))) -(def: ownership +(def ownership Test (do [! random.monad] [path (random.lower_case /.path_size) @@ -390,7 +390,7 @@ (try.else false))) )))) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.Tar]) diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index 72be44fa1..0798b1d83 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -29,35 +29,35 @@ [\\library ["[0]" / (.only XML)]]) -(def: char_range +(def char_range Text (format "_" "abcdefghijklmnopqrstuvwxyz" "ABCDEFGHIJKLMNOPQRSTUVWXYZ")) -(def: char +(def char (Random Nat) (do [! random.monad] [idx (|> random.nat (at ! each (n.% (text.size char_range))))] (in (maybe.trusted (text.char idx char_range))))) -(def: (size bottom top) +(def (size bottom top) (-> Nat Nat (Random Nat)) (let [constraint (|>> (n.% top) (n.max bottom))] (random#each constraint random.nat))) -(def: (text bottom top) +(def (text bottom top) (-> Nat Nat (Random Text)) (do random.monad [size (..size bottom top)] (random.text ..char size))) -(def: symbol +(def symbol (Random Symbol) (random.and (..text 0 10) (..text 1 10))) -(def: .public random +(def .public random (Random XML) (random.rec (function (_ random) (random.or (..text 1 10) @@ -68,7 +68,7 @@ (random.dictionary symbol.hash size ..symbol (..text 0 10)) (random.list size random))))))) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.XML]) diff --git a/stdlib/source/test/lux/data/identity.lux b/stdlib/source/test/lux/data/identity.lux index a6b0fb397..b7d1ff001 100644 --- a/stdlib/source/test/lux/data/identity.lux +++ b/stdlib/source/test/lux/data/identity.lux @@ -12,16 +12,16 @@ [\\library ["[0]" / (.only Identity)]]) -(def: injection +(def injection (Injection Identity) (|>>)) -(def: comparison +(def comparison (Comparison Identity) (function (_ ==) ==)) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.Identity]) diff --git a/stdlib/source/test/lux/data/product.lux b/stdlib/source/test/lux/data/product.lux index 1cde90959..df2d4dc93 100644 --- a/stdlib/source/test/lux/data/product.lux +++ b/stdlib/source/test/lux/data/product.lux @@ -14,7 +14,7 @@ [\\library ["[0]" /]]) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [.Tuple .And]) diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux index 8543ddba6..fd3f4fecc 100644 --- a/stdlib/source/test/lux/data/sum.lux +++ b/stdlib/source/test/lux/data/sum.lux @@ -21,7 +21,7 @@ [\\library ["[0]" /]]) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [.Union .Or]) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index 3c65ea9ff..15e456a9c 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -79,13 +79,13 @@ ["[0]" \\parser] ["[0]" \\format]) -(def: (equivalence example) +(def (equivalence example) (All (_ a) (-> a (Equivalence (\\format.Format a)))) (implementation - (def: (= reference subject) + (def (= reference subject) (/#= (reference example) (subject example))))) -(def: random_contravariant +(def random_contravariant (Random (Ex (_ a) [(\\format.Format a) (Random a)])) @@ -97,7 +97,7 @@ (random#in [\\format.frac random.frac]) )) -(def: codec +(def codec Test (`` (all _.and (~~ (with_template [<format> <codec> <random>] @@ -145,7 +145,7 @@ )) ))) -(def: \\format +(def \\format Test (<| (_.covering \\format._) (_.for [\\format.Format]) @@ -212,7 +212,7 @@ (\\format.mod sample)))) )))) -(def: !expect +(def !expect (template (_ <pattern> <value>) [(case <value> <pattern> @@ -221,7 +221,7 @@ _ false)])) -(def: (should_fail' sample parser exception) +(def (should_fail' sample parser exception) (All (_ a e) (-> Text (\\parser.Parser a) (Exception e) Bit)) (case (\\parser.result parser sample) {try.#Failure error} @@ -230,7 +230,7 @@ _ false)) -(def: (should_fail sample parser) +(def (should_fail sample parser) (All (_ a) (-> Text (\\parser.Parser a) Bit)) (case (\\parser.result parser sample) {try.#Failure _} @@ -239,18 +239,18 @@ _ false)) -(def: (should_pass expected parser) +(def (should_pass expected parser) (-> Text (\\parser.Parser Text) Bit) (|> expected (\\parser.result parser) (at try.functor each (/#= expected)) (try.else false))) -(def: (should_pass! expected parser) +(def (should_pass! expected parser) (-> Text (\\parser.Parser \\parser.Slice) Bit) (..should_pass expected (\\parser.slice parser))) -(def: \\parser#character_classes +(def \\parser#character_classes Test (all _.and (do [! random.monad] @@ -387,7 +387,7 @@ ))) )) -(def: \\parser#runs +(def \\parser#runs Test (let [octal! (\\parser.one_of! "01234567")] (all _.and @@ -473,7 +473,7 @@ (..should_fail (\\format.format first) (\\parser.between! 2 1 octal!))))) ))) -(def: \\parser +(def \\parser Test (<| (_.covering \\parser._) (_.for [\\parser.Parser]) @@ -624,12 +624,12 @@ \\parser#runs ))) -(def: bounded_size +(def bounded_size (random.Random Nat) (|> random.nat (at random.monad each (|>> (nat.% 20) (nat.+ 1))))) -(def: size +(def size Test (do [! random.monad] [size (at ! each (nat.% 10) random.nat) @@ -641,7 +641,7 @@ (or (/.empty? sample) (not (nat.= 0 size))))))) -(def: affix +(def affix Test (do [! random.monad] [inner (random.unicode 1) @@ -670,7 +670,7 @@ (/.contains? inner sample)))) )))) -(def: index +(def index Test (do [! random.monad] [inner (random.unicode 1) @@ -717,7 +717,7 @@ (nat.= 2))))) ))) -(def: char +(def char Test (all _.and (_.for [/.Char /.of_char] @@ -768,7 +768,7 @@ ))))) )) -(def: manipulation +(def manipulation Test (do [! random.monad] [size (at ! each (|>> (nat.% 10) (nat.+ 2)) random.nat) @@ -851,7 +851,7 @@ inverse!))) ))) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [.Text]) diff --git a/stdlib/source/test/lux/data/text/buffer.lux b/stdlib/source/test/lux/data/text/buffer.lux index 6c1531b66..f11248cd8 100644 --- a/stdlib/source/test/lux/data/text/buffer.lux +++ b/stdlib/source/test/lux/data/text/buffer.lux @@ -14,13 +14,13 @@ [\\library ["[0]" /]]) -(def: part +(def part (Random Text) (do [! random.monad] [size (at ! each (|>> (n.% 10) ++) random.nat)] (random.alphabetic size))) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.Buffer]) diff --git a/stdlib/source/test/lux/data/text/encoding.lux b/stdlib/source/test/lux/data/text/encoding.lux index 12be514b8..a3686fc6a 100644 --- a/stdlib/source/test/lux/data/text/encoding.lux +++ b/stdlib/source/test/lux/data/text/encoding.lux @@ -189,35 +189,35 @@ [])] <encodings>)] - (def: all_encodings + (def all_encodings (list.together (list <named>))) - (def: unique_encodings + (def unique_encodings (list#mix (function (_ encoding set) (set.has (/.name encoding) set)) (set.empty text.hash) ..all_encodings)) - (def: verdict + (def verdict (n.= (list.size ..all_encodings) (set.size ..unique_encodings))) (with_template [<definition> <by_letter>] - [(def: <definition> + [(def <definition> Test (`` (_.coverage [/.name (~~ (template.spliced <by_letter>))] ..verdict)))] <encodings>) - (def: .public random + (def .public random (Random /.Encoding) (let [options (list.size ..all_encodings)] (do [! random.monad] [choice (at ! each (n.% options) random.nat)] (in (maybe.trusted (list.item choice ..all_encodings)))))) - (def: .public test + (def .public test Test (<| (_.covering /._) (_.for [/.Encoding]) diff --git a/stdlib/source/test/lux/data/text/encoding/utf8.lux b/stdlib/source/test/lux/data/text/encoding/utf8.lux index 20f49c113..e7cdc660d 100644 --- a/stdlib/source/test/lux/data/text/encoding/utf8.lux +++ b/stdlib/source/test/lux/data/text/encoding/utf8.lux @@ -12,7 +12,7 @@ [\\library ["[0]" /]]) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.codec] diff --git a/stdlib/source/test/lux/data/text/escape.lux b/stdlib/source/test/lux/data/text/escape.lux index a583c2b6e..082f638c2 100644 --- a/stdlib/source/test/lux/data/text/escape.lux +++ b/stdlib/source/test/lux/data/text/escape.lux @@ -31,30 +31,30 @@ ["[0]" unicode ["[1]" set]]]]]) -(def: (range max min) +(def (range max min) (-> Char Char (Random Char)) (let [range (n.- min max)] (at random.monad each (|>> (n.% range) (n.+ min)) random.nat))) -(def: under_range +(def under_range (Random Char) (..range (debug.private /.ascii_bottom) 0)) -(def: over_range +(def over_range (Random Char) (..range (hex "FFFF") (++ (debug.private /.ascii_top)))) -(def: in_range +(def in_range (Random Char) (..range (++ (debug.private /.ascii_top)) (debug.private /.ascii_bottom))) -(def: ascii_range +(def ascii_range (Random Char) (..range (++ (debug.private /.ascii_top)) 0)) -(def: valid_sigils +(def valid_sigils (Set Char) (set.of_list n.hash (list (debug.private /.\0_sigil) @@ -69,7 +69,7 @@ (debug.private /.\\_sigil) (debug.private /.\u_sigil)))) -(def: static_sample +(def static_sample (syntax (_ []) (do meta.monad [seed meta.seed @@ -78,11 +78,11 @@ (random.result (random.pcg_32 [seed seed])))]] (in (list (code.text expected)))))) -(def: static_escaped +(def static_escaped (syntax (_ [un_escaped <code>.text]) (in (list (code.text (/.escaped un_escaped)))))) -(def: .public test +(def .public test Test (<| (_.covering /._) (all _.and diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index a31b6247b..787d432a6 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -22,7 +22,7 @@ [\\library ["[0]" /]]) -(def: (should_pass regex input) +(def (should_pass regex input) (-> (Parser Text) Text Bit) (|> input (<text>.result regex) @@ -33,7 +33,7 @@ _ #0))) -(def: (text_should_pass test regex input) +(def (text_should_pass test regex input) (-> Text (Parser Text) Text Bit) (|> input (<text>.result regex) @@ -44,7 +44,7 @@ _ false))) -(def: (should_fail regex input) +(def (should_fail regex input) (All (_ a) (-> (Parser a) Text Bit)) (|> input (<text>.result regex) @@ -55,7 +55,7 @@ _ false))) -(def: should_check +(def should_check (syntax (_ [pattern <code>.any regex <code>.any input <code>.any]) @@ -69,7 +69,7 @@ (~ g!_) false)))))))) -(def: basics +(def basics Test (_.property "Can parse character literals." (and (should_pass (/.regex "a") "a") @@ -77,7 +77,7 @@ (should_pass (/.regex "\.") ".") (should_fail (/.regex "\.") "a")))) -(def: system_character_classes +(def system_character_classes Test (all _.and (_.property "Can parse anything." @@ -108,7 +108,7 @@ (should_fail (/.regex "\W") "a"))) )) -(def: special_system_character_classes +(def special_system_character_classes Test (all _.and (_.property "Lower-case." @@ -155,7 +155,7 @@ (should_fail (/.regex "\p{Print}") (text.of_char (hex "1234"))))) )) -(def: custom_character_classes +(def custom_character_classes Test (all _.and (_.property "Can parse using custom character classes." @@ -194,7 +194,7 @@ (should_fail RE "p"))))) )) -(def: references +(def references Test (let [number (/.regex "\d+")] (_.property "Can build complex regexs by combining simpler ones." @@ -202,7 +202,7 @@ (/.regex "(\@<number>)-(\@<number>)-(\@<number>)") "809-345-6789")))) -(def: fuzzy_quantifiers +(def fuzzy_quantifiers Test (all _.and (_.property "Can sequentially combine patterns." @@ -222,7 +222,7 @@ (should_fail (/.regex "a+") ""))) )) -(def: crisp_quantifiers +(def crisp_quantifiers Test (all _.and (_.property "Can match a pattern N times." @@ -244,7 +244,7 @@ (text_should_pass "aa" (/.regex "a{1,2}") "aa"))) )) -(def: groups +(def groups Test (all _.and (_.property "Can extract groups of sub-matches specified in a pattern." @@ -260,7 +260,7 @@ (should_check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (/.regex "(\d{3})-((\d{3})-(\d{4}))") "809-345-6789")) )) -(def: alternation +(def alternation Test (all _.and (_.property "Can specify alternative patterns." @@ -277,7 +277,7 @@ "123-456-7890"))) )) -(def: expands? +(def expands? (syntax (_ [form <code>.any]) (function (_ lux) {try.#Success [lux (list (code.bit (case (macro.single_expansion form lux) @@ -287,7 +287,7 @@ {try.#Failure error} false)))]}))) -(def: .public test +(def .public test Test (<| (_.covering /._) (all _.and diff --git a/stdlib/source/test/lux/data/text/unicode/block.lux b/stdlib/source/test/lux/data/text/unicode/block.lux index c07da3b71..4c07e1531 100644 --- a/stdlib/source/test/lux/data/text/unicode/block.lux +++ b/stdlib/source/test/lux/data/text/unicode/block.lux @@ -22,7 +22,7 @@ [\\library ["[0]" /]]) -(def: .public random +(def .public random (Random /.Block) (do [! random.monad] [start (at ! each (n.% 1,000,000) random.nat) @@ -154,7 +154,7 @@ <blocks>)] (with_template [<definition> <part>] - [(def: <definition> + [(def <definition> Test (`` (_.coverage [(~~ (template.spliced <part>))] (let [all (list.together (list <named>)) @@ -165,7 +165,7 @@ <blocks> ) - (def: .public test + (def .public test Test (<| (_.covering /._) (_.for [/.Block]) diff --git a/stdlib/source/test/lux/data/text/unicode/set.lux b/stdlib/source/test/lux/data/text/unicode/set.lux index e4eed7710..e2bbc663c 100644 --- a/stdlib/source/test/lux/data/text/unicode/set.lux +++ b/stdlib/source/test/lux/data/text/unicode/set.lux @@ -23,14 +23,14 @@ [// ["[0]" block]]]]) -(def: .public random +(def .public random (Random /.Set) (do [! random.monad] [left //block.random right //block.random] (in (/.set [left (list right)])))) -(def: .public test +(def .public test Test (<| (_.covering /._) (_.for [/.Set]) |