diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/test/lux/data/collection/dictionary/ordered.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/color.lux | 85 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/color/hsl.lux | 95 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/color/rgb.lux | 18 | ||||
| -rw-r--r-- | stdlib/source/test/lux/meta/extension.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/lux/world.lux | 11 | ||||
| -rw-r--r-- | stdlib/source/test/lux/world/finance/money.lux (renamed from stdlib/source/test/lux/world/money.lux) | 58 | ||||
| -rw-r--r-- | stdlib/source/test/lux/world/finance/money/currency.lux (renamed from stdlib/source/test/lux/world/money/currency.lux) | 0 | ||||
| -rw-r--r-- | stdlib/source/test/lux/world/finance/trade/session.lux | 89 |
9 files changed, 213 insertions, 148 deletions
diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux index d1c9ba933..410580860 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux @@ -42,7 +42,8 @@ (def .public test Test (<| (_.covering /._) - (_.for [/.Dictionary]) + (_.for [/.Dictionary + /.#order /.#root]) (do [! random.monad] [size (of ! each (n.% 100) random.nat) keys (random.set n.hash size random.nat) diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index ee2eb70b2..25c041fd7 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -36,68 +36,6 @@ (Random /.Color) (random#each /.of_rgb /rgb.random)) -(def scale - (-> Nat Frac) - (|>> .int int.frac)) - -(def square - (-> Frac Frac) - (f.pow +2.0)) - -(def square_root - (-> Frac Frac) - (f.pow +0.5)) - -(def (distance/3 from to) - (-> /.Color /.Color Frac) - (let [from (/.rgb from) - to (/.rgb to)] - (square_root - (all f.+ - (|> (scale (rgb.red to)) (f.- (scale (rgb.red from))) square) - (|> (scale (rgb.green to)) (f.- (scale (rgb.green from))) square) - (|> (scale (rgb.blue to)) (f.- (scale (rgb.blue from))) square))))) - -(def rgb_error_margin - +1.8) - -(with_template [<name> <field>] - [(def <name> - (-> /.Color Frac) - (|>> /.rgb - hsl.of_rgb - <field>))] - - [saturation hsl.saturation] - [luminance hsl.luminance] - ) - -... (def transformation -... Test -... (do random.monad -... [mediocre (|> ..random -... (random.only (|>> saturation -... ((function (_ saturation) -... (and (f.>= +0.25 saturation) -... (f.<= +0.75 saturation))))))) -... ratio (|> random.safe_frac (random.only (f.>= +0.5)))] -... (all _.and -... (_.coverage [/.saturated] -... (f.> (saturation mediocre) -... (saturation (/.saturated ratio mediocre)))) -... (_.coverage [/.un_saturated] -... (f.< (saturation mediocre) -... (saturation (/.un_saturated ratio mediocre)))) -... (_.coverage [/.gray_scale] -... (let [gray'ed (/.gray_scale mediocre)] -... (and (f.= +0.0 -... (saturation gray'ed)) -... (|> (luminance gray'ed) -... (f.- (luminance mediocre)) -... f.abs -... (f.<= ..rgb_error_margin))))) -... ))) - ... (def palette ... Test ... (_.for [/.Spread /.Palette] @@ -123,28 +61,6 @@ ... [+1.0 /.analogous] ... [+0.5 /.monochromatic] ... )) -... (,, (with_template [<palette>] -... [(_.coverage [<palette>] -... (let [expected (/.of_hsb [eH eS +0.5]) -... [c0 c1 c2] (<palette> expected)] -... (and (of /.equivalence = expected c0) -... (not (of /.equivalence = expected c1)) -... (not (of /.equivalence = expected c2)))))] - -... [/.triad] -... [/.clash] -... [/.split_complement])) -... (,, (with_template [<palette>] -... [(_.coverage [<palette>] -... (let [expected (/.of_hsb [eH eS +0.5]) -... [c0 c1 c2 c3] (<palette> expected)] -... (and (of /.equivalence = expected c0) -... (not (of /.equivalence = expected c1)) -... (not (of /.equivalence = expected c2)) -... (not (of /.equivalence = expected c3)))))] - -... [/.square] -... [/.tetradic])) ... ))))) (def .public test @@ -154,7 +70,6 @@ (do [! random.monad] [expected ..random] (all _.and - ... ..transformation ... ..palette /rgb.test diff --git a/stdlib/source/test/lux/data/color/hsl.lux b/stdlib/source/test/lux/data/color/hsl.lux index 72782e0f2..de9c3ef8a 100644 --- a/stdlib/source/test/lux/data/color/hsl.lux +++ b/stdlib/source/test/lux/data/color/hsl.lux @@ -14,7 +14,8 @@ [\\library ["[0]" / (.only) [// - ["[0]" rgb]]]] + ["[0]" rgb] + ["[0]" hsb]]]] [// ["[0]T" rgb]]) @@ -30,6 +31,9 @@ luminance ..value] (in (/.hsl hue saturation luminance)))) +(def rgb_error_margin + +1.8) + (def .public test Test (<| (_.covering /._) @@ -38,7 +42,18 @@ expected_rgb rgbT.random expected_hsl ..random - possible_value random.frac]) + possible_value random.frac + + mediocre (|> ..random + (random.only (|>> (the /.#saturation) + ((function (_ it) + (and (f.>= +0.25 it) + (f.<= +0.75 it))))))) + ratio (|> random.safe_frac (random.only (f.>= +0.5))) + + eH (of ! each (|>> f.abs (f.% +0.9) (f.+ +0.05)) + random.safe_frac) + .let [eS +0.5]]) (all _.and (_.for [/.Value] (all _.and @@ -66,23 +81,63 @@ (/.value? (f.- f.smallest /.most)) (not (/.value? (f.+ f.smallest /.most))))) )) - (_.for [/.HSL] - (all _.and - (_.for [/.equivalence] - (equivalenceS.spec /.equivalence ..random)) + (_.for [/.HSL + /.#hue /.#saturation /.#luminance] + (`` (all _.and + (_.for [/.equivalence] + (equivalenceS.spec /.equivalence ..random)) - (_.coverage [/.hsl - /.hue /.saturation /.luminance] - (|> (/.hsl (/.hue expected_hsl) (/.saturation expected_hsl) (/.luminance expected_hsl)) - (of /.equivalence = expected_hsl))) - (_.coverage [/.of_rgb /.rgb] - (and (|> expected_rgb - /.of_rgb - /.rgb - (of rgb.equivalence = expected_rgb)) - (|> expected_hsl - /.rgb - /.of_rgb - (of /.equivalence = expected_hsl)))) - )) + (_.coverage [/.hsl] + (|> (/.hsl (the /.#hue expected_hsl) + (the /.#saturation expected_hsl) + (the /.#luminance expected_hsl)) + (of /.equivalence = expected_hsl))) + (_.coverage [/.of_rgb /.rgb] + (and (|> expected_rgb + /.of_rgb + /.rgb + (of rgb.equivalence = expected_rgb)) + (|> expected_hsl + /.rgb + /.of_rgb + (of /.equivalence = expected_hsl)))) + + (_.coverage [/.saturated] + (f.> (the /.#saturation mediocre) + (the /.#saturation (/.saturated ratio mediocre)))) + (_.coverage [/.un_saturated] + (f.< (the /.#saturation mediocre) + (the /.#saturation (/.un_saturated ratio mediocre)))) + (_.coverage [/.gray_scale] + (let [gray'ed (/.gray_scale mediocre)] + (and (f.= +0.0 + (the /.#saturation gray'ed)) + (|> (the /.#luminance gray'ed) + (f.- (the /.#luminance mediocre)) + f.abs + (f.<= ..rgb_error_margin))))) + + (,, (with_template [<palette>] + [(_.coverage [<palette>] + (let [expected (/.of_rgb (hsb.rgb (hsb.hsb eH eS +0.5))) + [c0 c1 c2] (<palette> expected)] + (and (of /.equivalence = expected c0) + (not (of /.equivalence = expected c1)) + (not (of /.equivalence = expected c2)))))] + + [/.triad] + [/.clash] + [/.split_complement])) + (,, (with_template [<palette>] + [(_.coverage [<palette>] + (let [expected (/.of_rgb (hsb.rgb (hsb.hsb eH eS +0.5))) + [c0 c1 c2 c3] (<palette> expected)] + (and (of /.equivalence = expected c0) + (not (of /.equivalence = expected c1)) + (not (of /.equivalence = expected c2)) + (not (of /.equivalence = expected c3)))))] + + [/.square] + [/.tetradic])) + ))) ))) diff --git a/stdlib/source/test/lux/data/color/rgb.lux b/stdlib/source/test/lux/data/color/rgb.lux index 19094bfe2..4325eb72b 100644 --- a/stdlib/source/test/lux/data/color/rgb.lux +++ b/stdlib/source/test/lux/data/color/rgb.lux @@ -55,9 +55,9 @@ Frac) (square_root (all f.+ - (|> (scale (/.red to)) (f.- (scale (/.red from))) square) - (|> (scale (/.green to)) (f.- (scale (/.green from))) square) - (|> (scale (/.blue to)) (f.- (scale (/.blue from))) square)))) + (|> (scale (the /.#red to)) (f.- (scale (the /.#red from))) square) + (|> (scale (the /.#green to)) (f.- (scale (the /.#green from))) square) + (|> (scale (the /.#blue to)) (f.- (scale (the /.#blue from))) square)))) (def .public test Test @@ -99,7 +99,8 @@ (n.= /.limit) not)) )) - (_.for [/.RGB] + (_.for [/.RGB + /.#red /.#green /.#blue] (all _.and (_.for [/.equivalence] (equivalenceS.spec /.equivalence ..random)) @@ -110,15 +111,14 @@ (_.for [/.subtraction] (monoidS.spec /.equivalence /.subtraction ..random)) - (_.coverage [/.rgb - /.red /.green /.blue] + (_.coverage [/.rgb] (let [it (/.rgb expected_red expected_green expected_blue)] (and (same? expected_red - (/.red it)) + (the /.#red it)) (same? expected_green - (/.green it)) + (the /.#green it)) (same? expected_blue - (/.blue it))))) + (the /.#blue it))))) (_.coverage [/.complement] (let [~expected (/.complement expected) (open "/#[0]") /.equivalence] diff --git a/stdlib/source/test/lux/meta/extension.lux b/stdlib/source/test/lux/meta/extension.lux index 9d49aeb16..f98359d94 100644 --- a/stdlib/source/test/lux/meta/extension.lux +++ b/stdlib/source/test/lux/meta/extension.lux @@ -39,12 +39,12 @@ ["[0]" name]]])) (.,, (.these))))] [compiler - ["[0]" phase] [meta [archive ["[0]" unit]]] [language [lux + ["[0]" phase] ["[0]" translation] ["[0]" declaration] ["[0]" analysis (.only) diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux index e1309f5f5..bf9ff3c7f 100644 --- a/stdlib/source/test/lux/world.lux +++ b/stdlib/source/test/lux/world.lux @@ -13,7 +13,10 @@ ["[1][0]" output ["[1]/[0]" video ["[1]/[0]" resolution]]] - ["[1][0]" money] + ["[1][0]" finance + ["[1]/[0]" money] + ["[1]/[0]" trade + ["[1]/[0]" session]]] ["[1][0]" net] ["[1][0]" time] ["[1][0]" locale] @@ -26,9 +29,13 @@ /shell.test /console.test /environment.test + /input/keyboard.test /output/video/resolution.test - /money.test + + /finance/money.test + /finance/trade/session.test + /net.test /time.test /locale.test diff --git a/stdlib/source/test/lux/world/money.lux b/stdlib/source/test/lux/world/finance/money.lux index 4cddc38ee..773589a15 100644 --- a/stdlib/source/test/lux/world/money.lux +++ b/stdlib/source/test/lux/world/finance/money.lux @@ -13,48 +13,46 @@ ["[0]" text (.only) ["%" \\format]]] [math - ["[0]" random (.only Random)] + ["[0]" random (.only Random) (.use "[1]#[0]" functor)] [number ["n" nat]]] [test ["_" property (.only Test)]]]] [\\library ["[0]" / (.only) - ["[0]" currency]]] + ["[0]" currency (.only Currency)]]] ["[0]" / ["[1][0]" currency]]) -(def .public random - (Random (Ex (_ of) - (/.Money of))) - (do random.monad - [expected_currency /currency.random - expected_amount random.nat] - (in (/.money expected_currency expected_amount)))) +(def .public (random $) + (All (_ $) + (-> (Currency $) + (Random (/.Money $)))) + (random#each (/.money $) + random.nat)) (def .public test Test (<| (_.covering /._) (do [! random.monad] - [.let [expected_currency currency.usd] - expected_amount random.nat + [expected_amount random.nat expected_parameter (random.only (n.> 0) random.nat) expected_subject random.nat]) (_.for [/.Money]) (all _.and (_.for [/.equivalence /.=] - (equivalenceS.spec /.equivalence ..random)) + (equivalenceS.spec /.equivalence (..random currency.usd))) (_.for [/.order /.<] - (orderS.spec /.order ..random)) + (orderS.spec /.order (..random currency.usd))) (_.coverage [/.money /.currency /.amount] - (let [it (/.money expected_currency expected_amount)] - (and (same? expected_currency (/.currency it)) + (let [it (/.money currency.usd expected_amount)] + (and (same? currency.usd (/.currency it)) (same? expected_amount (/.amount it))))) (_.coverage [/.+ /.-] - (let [parameter (/.money expected_currency expected_parameter) - subject (/.money expected_currency expected_subject)] + (let [parameter (/.money currency.usd expected_parameter) + subject (/.money currency.usd expected_subject)] (and (|> subject (/.+ parameter) (of /.equivalence = subject) @@ -65,21 +63,21 @@ (maybe#each (of /.equivalence = subject)) (maybe.else false))))) (_.coverage [/.min] - (let [expected_parameter (/.money expected_currency expected_parameter) - expected_subject (/.money expected_currency expected_subject)] + (let [expected_parameter (/.money currency.usd expected_parameter) + expected_subject (/.money currency.usd expected_subject)] (and (/.<= expected_parameter (/.min expected_parameter expected_subject)) (/.<= expected_subject (/.min expected_parameter expected_subject))))) (_.coverage [/.max] - (let [expected_parameter (/.money expected_currency expected_parameter) - expected_subject (/.money expected_currency expected_subject)] + (let [expected_parameter (/.money currency.usd expected_parameter) + expected_subject (/.money currency.usd expected_subject)] (and (/.>= expected_parameter (/.max expected_parameter expected_subject)) (/.>= expected_subject (/.max expected_parameter expected_subject))))) - (let [expected_parameter (/.money expected_currency expected_parameter) - expected_subject (/.money expected_currency expected_subject)] + (let [expected_parameter (/.money currency.usd expected_parameter) + expected_subject (/.money currency.usd expected_subject)] (all _.and (_.coverage [/.>] (bit#= (/.> expected_parameter expected_subject) @@ -89,17 +87,17 @@ (/.>= expected_subject expected_parameter))) )) (_.coverage [/.units /.sub_units] - (let [expected (/.money expected_currency expected_amount) - actual (/.money expected_currency (n.+ (/.units expected) - (/.sub_units expected)))] + (let [expected (/.money currency.usd expected_amount) + actual (/.money currency.usd (n.+ (/.units expected) + (/.sub_units expected)))] (/.= expected actual))) (_.coverage [/.of_units /.of_sub_units] - (let [expected (/.money expected_currency expected_amount) - actual (/.+ (/.of_units expected_currency (/.units expected)) - (/.of_sub_units expected_currency (/.sub_units expected)))] + (let [expected (/.money currency.usd expected_amount) + actual (/.+ (/.of_units currency.usd (/.units expected)) + (/.of_sub_units currency.usd (/.sub_units expected)))] (/.= expected actual))) (do ! - [it ..random] + [it (..random currency.usd)] (_.coverage [/.format] (and (text.starts_with? (%.nat (/.amount it)) (text.replaced_once "." "" (/.format it))) diff --git a/stdlib/source/test/lux/world/money/currency.lux b/stdlib/source/test/lux/world/finance/money/currency.lux index eeb59e9fc..eeb59e9fc 100644 --- a/stdlib/source/test/lux/world/money/currency.lux +++ b/stdlib/source/test/lux/world/finance/money/currency.lux diff --git a/stdlib/source/test/lux/world/finance/trade/session.lux b/stdlib/source/test/lux/world/finance/trade/session.lux new file mode 100644 index 000000000..6ce1979d2 --- /dev/null +++ b/stdlib/source/test/lux/world/finance/trade/session.lux @@ -0,0 +1,89 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)] + [\\specification + ["[0]S" equivalence]]] + [data + ["[0]" bit (.use "[1]#[0]" equivalence)] + ["[0]" text (.use "[1]#[0]" equivalence)] + [collection + ["[0]" list]]] + [math + ["[0]" random (.only Random)] + [number + ["n" nat]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" / (.only) + [/// + ["[0]" money (.only) + ["[0]" currency (.only Currency)]]]]] + [/// + ["[0]T" money]]) + +(def .public (random $) + (All (_ $) + (-> (Currency $) + (Random (/.Session $)))) + (do random.monad + [p0 (moneyT.random $) + p1 (moneyT.random $) + p2 (moneyT.random $) + p3 (moneyT.random $) + bullish? random.bit + volume random.nat] + (when (list.sorted money.< (list p0 p1 p2 p3)) + (list low bottom top high) + (in [/.#open (if bullish? + bottom + top) + /.#high high + /.#low low + /.#close (if bullish? + top + bottom) + /.#volume volume]) + + _ + (undefined)))) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [before (..random currency.usd) + after (..random currency.usd)]) + (_.for [/.Session /.Price /.Volume + /.#open /.#high /.#low /.#close /.#volume]) + (all _.and + (_.for [/.equivalence] + (equivalenceS.spec /.equivalence (..random currency.usd))) + + (_.coverage [/.composite] + (let [both (/.composite before after)] + (and (money.= (the /.#open before) + (the /.#open both)) + (and (money.>= (the /.#high before) + (the /.#high both)) + (money.>= (the /.#high after) + (the /.#high both))) + (and (money.<= (the /.#low before) + (the /.#low both)) + (money.<= (the /.#low after) + (the /.#low both))) + (money.= (the /.#close after) + (the /.#close both)) + (and (n.>= (the /.#volume before) + (the /.#volume both)) + (n.>= (the /.#volume after) + (the /.#volume both)))))) + (_.coverage [/.format] + (bit#= (of /.equivalence = + before + after) + (text#= (/.format before) + (/.format after)))) + ))) |