aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2019-03-21 23:31:30 -0400
committerEduardo Julian2019-03-21 23:31:30 -0400
commit36c09baf6d977d6bcb712459325b9c5c3e7589ae (patch)
tree791bfce143f37bdba6b9bae070c983488c307069 /stdlib
parent38b267de130fa42454f152583fd2e46b3d3ff0f5 (diff)
- Ported lux/data/bit tests.
- Ported lux/data/color tests. - Ported lux/data/error tests. - Ported lux/data/identity tests. - Ported lux/data/lazy tests. - Ported lux/data/maybe tests. - Ported lux/data/name tests.
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/data/error.lux13
-rw-r--r--stdlib/source/lux/data/lazy.lux12
-rw-r--r--stdlib/source/test/lux.lux20
-rw-r--r--stdlib/source/test/lux/control/codec.lux27
-rw-r--r--stdlib/source/test/lux/control/concurrency/atom.lux2
-rw-r--r--stdlib/source/test/lux/control/reader.lux4
-rw-r--r--stdlib/source/test/lux/data.lux24
-rw-r--r--stdlib/source/test/lux/data/bit.lux61
-rw-r--r--stdlib/source/test/lux/data/color.lux117
-rw-r--r--stdlib/source/test/lux/data/error.lux107
-rw-r--r--stdlib/source/test/lux/data/identity.lux70
-rw-r--r--stdlib/source/test/lux/data/lazy.lux89
-rw-r--r--stdlib/source/test/lux/data/maybe.lux128
-rw-r--r--stdlib/source/test/lux/data/name.lux106
14 files changed, 428 insertions, 352 deletions
diff --git a/stdlib/source/lux/data/error.lux b/stdlib/source/lux/data/error.lux
index 938fca3b9..9f84c2707 100644
--- a/stdlib/source/lux/data/error.lux
+++ b/stdlib/source/lux/data/error.lux
@@ -3,7 +3,8 @@
[control
["." functor (#+ Functor)]
[apply (#+ Apply)]
- ["." monad (#+ Monad do)]]])
+ ["." monad (#+ Monad do)]
+ [equivalence (#+ Equivalence)]]])
(type: #export (Error a)
(#Failure Text)
@@ -71,6 +72,16 @@
(All [M a] (-> (Monad M) (-> (M a) (M (Error a)))))
(monad.lift monad (:: ..monad wrap)))
+(structure: #export (equivalence (^open "_@."))
+ (All [a] (-> (Equivalence a) (Equivalence (Error a))))
+ (def: (= reference sample)
+ (case [reference sample]
+ [(#Success reference) (#Success sample)]
+ (_@= reference sample)
+
+ _
+ false)))
+
(def: #export (succeed value)
(All [a] (-> a (Error a)))
(#Success value))
diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux
index c8f5746b1..dc889675a 100644
--- a/stdlib/source/lux/data/lazy.lux
+++ b/stdlib/source/lux/data/lazy.lux
@@ -4,9 +4,10 @@
[control
[functor (#+ Functor)]
[apply (#+ Apply)]
- [monad (#+ Monad do)]]
- [concurrency
- ["." atom]]
+ [monad (#+ Monad do)]
+ [equivalence (#+ Equivalence)]
+ [concurrency
+ ["." atom]]]
[macro (#+ with-gensyms)
["s" syntax (#+ syntax:)]]
[type
@@ -36,6 +37,11 @@
(with-gensyms [g!_]
(wrap (list (` ((~! freeze') (function ((~ g!_) (~ g!_)) (~ expr))))))))
+(structure: #export (equivalence (^open "_@."))
+ (All [a] (-> (Equivalence a) (Equivalence (Lazy a))))
+ (def: (= left right)
+ (_@= (..thaw left) (..thaw right))))
+
(structure: #export functor (Functor Lazy)
(def: (map f fa)
(freeze (f (thaw fa)))))
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index d6d667d72..bf1011080 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -108,23 +108,15 @@
["." / #_
["#." cli]
["#." io]
+ ["#." control]
+ ["#." data]
["#." host
- ["#/." jvm]]
- ["#." control]]
+ ["#/." jvm]]]
## [control
## [concurrency
- ## [promise (#+)]
- ## [stm (#+)]
## ## [semaphore (#+)]
## ]]
## [data
- ## [bit (#+)]
- ## [color (#+)]
- ## [error (#+)]
- ## [name (#+)]
- ## [identity (#+)]
- ## [lazy (#+)]
- ## [maybe (#+)]
## [product (#+)]
## [sum (#+)]
## [number (#+) ## TODO: FIX Specially troublesome...
@@ -416,13 +408,15 @@
/cli.test)
(<| (_.context "/io I/O (input/output)")
/io.test)
+ (<| (_.context "/control")
+ /control.test)
+ (<| (_.context "/data")
+ /data.test)
(<| (_.context "/host Host-platform interoperation")
($_ _.and
/host.test
(<| (_.context "/jvm JVM (Java Virtual Machine)")
/host/jvm.test)))
- (<| (_.context "/control")
- /control.test)
))
(program: args
diff --git a/stdlib/source/test/lux/control/codec.lux b/stdlib/source/test/lux/control/codec.lux
new file mode 100644
index 000000000..22c161616
--- /dev/null
+++ b/stdlib/source/test/lux/control/codec.lux
@@ -0,0 +1,27 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [control
+ [monad (#+ do)]]
+ [data
+ text/format
+ ["." error]]
+ [math
+ ["r" random (#+ Random)]]]
+ {1
+ ["." / (#+ Codec)
+ [//
+ [equivalence (#+ Equivalence)]]]})
+
+(def: #export (test (^open "/@.") (^open "/@.") generator)
+ (All [m a] (-> (Codec m a) (Equivalence a) (Random a) Test))
+ (do r.monad
+ [expected generator]
+ (<| (_.context (%name (name-of /.Codec)))
+ (_.test "Reflexivity."
+ (case (|> expected /@encode /@decode)
+ (#error.Success actual)
+ (/@= expected actual)
+
+ (#error.Failure error)
+ false)))))
diff --git a/stdlib/source/test/lux/control/concurrency/atom.lux b/stdlib/source/test/lux/control/concurrency/atom.lux
index a314e7193..29cc28ad4 100644
--- a/stdlib/source/test/lux/control/concurrency/atom.lux
+++ b/stdlib/source/test/lux/control/concurrency/atom.lux
@@ -3,7 +3,7 @@
["_" test (#+ Test)]
["." io]
[control
- [monad (#+ Monad do)]]
+ [monad (#+ do)]]
data/text/format
[math
["r" random]]]
diff --git a/stdlib/source/test/lux/control/reader.lux b/stdlib/source/test/lux/control/reader.lux
index 7cdd022bb..4e57131f5 100644
--- a/stdlib/source/test/lux/control/reader.lux
+++ b/stdlib/source/test/lux/control/reader.lux
@@ -44,11 +44,11 @@
(applyT.laws ..injection ..comparison /.apply)
(monadT.laws ..injection ..comparison /.monad)
- (let [(^open "io;.") io.monad]
+ (let [(^open "io@.") io.monad]
(_.test "Can add reader functionality to any monad."
(|> (: (/.Reader Any (IO Nat))
(do (/.with io.monad)
- [a (/.lift (io;wrap sample))
+ [a (/.lift (io@wrap sample))
b (wrap factor)]
(wrap (n/* b a))))
(/.run [])
diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux
new file mode 100644
index 000000000..ec1cdf702
--- /dev/null
+++ b/stdlib/source/test/lux/data.lux
@@ -0,0 +1,24 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]]
+ ["." / #_
+ ["#." bit]
+ ["#." color]
+ ["#." error]
+ ["#." identity]
+ ["#." lazy]
+ ["#." maybe]
+ ["#." name]
+ ])
+
+(def: #export test
+ Test
+ ($_ _.and
+ /bit.test
+ /color.test
+ /error.test
+ /identity.test
+ /lazy.test
+ /maybe.test
+ /name.test
+ ))
diff --git a/stdlib/source/test/lux/data/bit.lux b/stdlib/source/test/lux/data/bit.lux
index d064a736b..48643c29b 100644
--- a/stdlib/source/test/lux/data/bit.lux
+++ b/stdlib/source/test/lux/data/bit.lux
@@ -1,37 +1,38 @@
(.module:
[lux #*
+ ["_" test (#+ Test)]
+ ["." function]
[control
- ["M" monad (#+ Monad do)]]
- [data
- bit]
+ [monad (#+ do)]
+ {[0 #test]
+ [/
+ ["." equivalence]
+ ["." codec]]}]
+ data/text/format
[math
["r" random]]]
- lux/test)
+ {1
+ ["." /]})
-(context: "Bit operations."
- (<| (times 100)
- (do @
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of .Bit)))
+ (do r.monad
[value r.bit]
- (test "" (and (not (and value (not value)))
- (or value (not value))
-
- (not (:: disjunction identity))
- (:: disjunction compose value (not value))
- (:: conjunction identity)
- (not (:: conjunction compose value (not value)))
-
- (:: equivalence = value (not (not value)))
- (not (:: equivalence = value (not value)))
-
- (not (:: equivalence = value ((complement id) value)))
- (:: equivalence = value ((complement not) value))
-
- (case (|> value
- (:: codec encode)
- (:: codec decode))
- (#.Right dec-value)
- (:: equivalence = value dec-value)
-
- (#.Left _)
- #0)
- )))))
+ ($_ _.and
+ (_.test "A value cannot be true and false at the same time."
+ (not (and value (not value))))
+ (_.test "A value must be either true or false at any time."
+ (or value (not value)))
+ (_.test "Can create the complement of a predicate."
+ (and (not (:: /.equivalence = value ((/.complement function.identity) value)))
+ (:: /.equivalence = value ((/.complement not) value))))
+ (equivalence.test /.equivalence r.bit)
+ (codec.test /.codec /.equivalence r.bit)
+ (_.test "Or/disjunction monoid."
+ (and (not (:: /.or-monoid identity))
+ (:: /.or-monoid compose value (not value))))
+ (_.test "And/conjunction monoid."
+ (and (:: /.and-monoid identity)
+ (not (:: /.and-monoid compose value (not value)))))
+ ))))
diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux
index 5546a9d90..af16ef76e 100644
--- a/stdlib/source/test/lux/data/color.lux
+++ b/stdlib/source/test/lux/data/color.lux
@@ -1,19 +1,24 @@
(.module:
[lux #*
+ ["_" test (#+ Test)]
[control
- [monad (#+ do)]]
+ [monad (#+ do)]
+ {[0 #test]
+ [/
+ ["." equivalence]]}]
[data
- ["@" color]
+ text/format
[number
- ["." frac ("#;." number)]]]
+ ["." frac ("#@." number)]]]
["." math
["r" random]]]
- lux/test)
+ {1
+ ["." /]})
(def: color
- (r.Random @.Color)
+ (r.Random /.Color)
(|> ($_ r.and r.nat r.nat r.nat)
- (:: r.monad map @.from-rgb)))
+ (:: r.monad map /.from-rgb)))
(def: scale
(-> Nat Frac)
@@ -22,9 +27,9 @@
(def: square (-> Frac Frac) (math.pow +2.0))
(def: (distance from to)
- (-> @.Color @.Color Frac)
- (let [[fr fg fb] (@.to-rgb from)
- [tr tg tb] (@.to-rgb to)]
+ (-> /.Color /.Color Frac)
+ (let [[fr fg fb] (/.to-rgb from)
+ [tr tg tb] (/.to-rgb to)]
(math.pow +0.5 ($_ f/+
(|> (scale tr) (f/- (scale fr)) square)
(|> (scale tg) (f/- (scale fg)) square)
@@ -32,23 +37,24 @@
(def: error-margin Frac +1.8)
-(def: black (@.from-rgb [0 0 0]))
-(def: white (@.from-rgb [255 255 255]))
+(def: black (/.from-rgb [0 0 0]))
+(def: white (/.from-rgb [255 255 255]))
(do-template [<field>]
[(def: (<field> color)
- (-> @.Color Frac)
- (let [[hue saturation luminance] (@.to-hsl color)]
+ (-> /.Color Frac)
+ (let [[hue saturation luminance] (/.to-hsl color)]
<field>))]
[saturation]
[luminance]
)
-(context: "Color."
- (<| (times 100)
- (do @
- [any color
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /.Color)))
+ (do r.monad
+ [any ..color
colorful (|> color
(r.filter (function (_ color) (|> (distance color black) (f/>= +100.0))))
(r.filter (function (_ color) (|> (distance color white) (f/>= +100.0)))))
@@ -58,43 +64,42 @@
(and (f/>= +0.25 saturation)
(f/<= +0.75 saturation)))))))
ratio (|> r.frac (r.filter (f/>= +0.5)))]
- ($_ seq
- (test "Has equivalence."
- (:: @.equivalence = any any))
- (test "Can convert to/from HSL."
- (|> any @.to-hsl @.from-hsl
- (distance any)
- (f/<= error-margin)))
- (test "Can convert to/from HSB."
- (|> any @.to-hsb @.from-hsb
- (distance any)
- (f/<= error-margin)))
- (test "Can convert to/from CMYK."
- (|> any @.to-cmyk @.from-cmyk
- (distance any)
- (f/<= error-margin)))
- (test "Can interpolate between 2 colors."
- (and (f/<= (distance colorful black)
- (distance (@.darker ratio colorful) black))
- (f/<= (distance colorful white)
- (distance (@.brighter ratio colorful) white))))
- (test "Can calculate complement."
- (let [~any (@.complement any)
- (^open "@/.") @.equivalence]
- (and (not (@/= any ~any))
- (@/= any (@.complement ~any)))))
- (test "Can saturate color."
- (f/> (saturation mediocre)
- (saturation (@.saturate ratio mediocre))))
- (test "Can de-saturate color."
- (f/< (saturation mediocre)
- (saturation (@.de-saturate ratio mediocre))))
- (test "Can gray-scale color."
- (let [gray'ed (@.gray-scale mediocre)]
- (and (f/= +0.0
- (saturation gray'ed))
- (|> (luminance gray'ed)
- (f/- (luminance mediocre))
- frac;abs
- (f/<= error-margin)))))
+ ($_ _.and
+ (equivalence.test /.equivalence ..color)
+ (_.test "Can convert to/from HSL."
+ (|> any /.to-hsl /.from-hsl
+ (distance any)
+ (f/<= error-margin)))
+ (_.test "Can convert to/from HSB."
+ (|> any /.to-hsb /.from-hsb
+ (distance any)
+ (f/<= error-margin)))
+ (_.test "Can convert to/from CMYK."
+ (|> any /.to-cmyk /.from-cmyk
+ (distance any)
+ (f/<= error-margin)))
+ (_.test "Can interpolate between 2 colors."
+ (and (f/<= (distance colorful black)
+ (distance (/.darker ratio colorful) black))
+ (f/<= (distance colorful white)
+ (distance (/.brighter ratio colorful) white))))
+ (_.test "Can calculate complement."
+ (let [~any (/.complement any)
+ (^open "/@.") /.equivalence]
+ (and (not (/@= any ~any))
+ (/@= any (/.complement ~any)))))
+ (_.test "Can saturate color."
+ (f/> (saturation mediocre)
+ (saturation (/.saturate ratio mediocre))))
+ (_.test "Can de-saturate color."
+ (f/< (saturation mediocre)
+ (saturation (/.de-saturate ratio mediocre))))
+ (_.test "Can gray-scale color."
+ (let [gray'ed (/.gray-scale mediocre)]
+ (and (f/= +0.0
+ (saturation gray'ed))
+ (|> (luminance gray'ed)
+ (f/- (luminance mediocre))
+ frac@abs
+ (f/<= error-margin)))))
))))
diff --git a/stdlib/source/test/lux/data/error.lux b/stdlib/source/test/lux/data/error.lux
index 78e63338e..1dbe1969e 100644
--- a/stdlib/source/test/lux/data/error.lux
+++ b/stdlib/source/test/lux/data/error.lux
@@ -1,61 +1,64 @@
(.module:
[lux #*
+ ["_" test (#+ Test)]
["." io]
[control
+ pipe
[monad (#+ do Monad)]
- pipe]
+ {[0 #test]
+ [/
+ [".T" functor (#+ Injection Comparison)]
+ [".T" apply]
+ [".T" monad]
+ [".T" equivalence]]}]
[data
- ["/" error (#+ Error)]]]
- lux/test)
+ text/format
+ [number
+ ["." nat]]]
+ [math
+ ["r" random (#+ Random)]]]
+ {1
+ ["." / (#+ Error)]})
-(context: "Errors"
- (let [(^open "&;.") /.apply
- (^open "&;.") /.monad]
- ($_ seq
- (test "Functor correctly handles both cases."
- (and (|> (: (Error Int) (#/.Success +10))
- (&;map inc)
- (case> (#/.Success +11) #1 _ #0))
+(def: injection
+ (Injection Error)
+ (|>> #/.Success))
- (|> (: (Error Int) (#/.Failure "YOLO"))
- (&;map inc)
- (case> (#/.Failure "YOLO") #1 _ #0))
- ))
-
- (test "Apply correctly handles both cases."
- (and (|> (&;wrap +20)
- (case> (#/.Success +20) #1 _ #0))
- (|> (&;apply (&;wrap inc) (&;wrap +10))
- (case> (#/.Success +11) #1 _ #0))
- (|> (&;apply (&;wrap inc) (#/.Failure "YOLO"))
- (case> (#/.Failure "YOLO") #1 _ #0))))
-
- (test "Monad correctly handles both cases."
- (and (|> (do /.monad
- [f (wrap i/+)
- a (wrap +10)
- b (wrap +20)]
- (wrap (f a b)))
- (case> (#/.Success +30) #1 _ #0))
- (|> (do /.monad
- [f (wrap i/+)
- a (#/.Failure "YOLO")
- b (wrap +20)]
- (wrap (f a b)))
- (case> (#/.Failure "YOLO") #1 _ #0))
- ))
- )))
+(def: comparison
+ (Comparison Error)
+ (function (_ ==)
+ (:: (/.equivalence ==) =)))
-(context: "Monad transformer"
- (let [lift (/.lift io.monad)
- (^open "io;.") io.monad]
- (test "Can add error functionality to any monad."
- (|> (io.run (do (/.ErrorT io.monad)
- [a (lift (io;wrap +123))
- b (wrap +456)]
- (wrap (i/+ a b))))
- (case> (#/.Success +579)
- #1
-
- _
- #0)))))
+(def: #export (error element)
+ (All [a] (-> (Random a) (Random (Error a))))
+ ($_ r.or
+ (r.ascii 10)
+ element))
+
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /.Error)))
+ ($_ _.and
+ (equivalenceT.test (/.equivalence nat.equivalence) (..error r.nat))
+ (functorT.laws ..injection ..comparison /.functor)
+ (applyT.laws ..injection ..comparison /.apply)
+ (monadT.laws ..injection ..comparison /.monad)
+ (do r.monad
+ [left r.nat
+ right r.nat
+ #let [expected (n/+ left right)
+ (^open "io@.") io.monad]]
+ (let []
+ (_.test "Can add error functionality to any monad."
+ (let [lift (/.lift io.monad)]
+ (|> (do (/.with io.monad)
+ [a (lift (io@wrap left))
+ b (wrap right)]
+ (wrap (n/+ a b)))
+ io.run
+ (case> (#/.Success actual)
+ (n/= expected actual)
+
+ _
+ #0))))))
+ )))
diff --git a/stdlib/source/test/lux/data/identity.lux b/stdlib/source/test/lux/data/identity.lux
index 293f5d075..aced82f84 100644
--- a/stdlib/source/test/lux/data/identity.lux
+++ b/stdlib/source/test/lux/data/identity.lux
@@ -1,37 +1,43 @@
(.module:
[lux #*
+ ["_" test (#+ Test)]
[control
- ["M" monad (#+ Monad do)]
- comonad]
+ comonad
+ [monad (#+ do)]
+ {[0 #test]
+ [/
+ [".T" functor (#+ Injection Comparison)]
+ [".T" apply]
+ [".T" monad]
+ [".T" equivalence]]}]
[data
- ["&" identity]
- ["." text ("#;." monoid equivalence)]]]
- lux/test)
+ ["." text ("#@." monoid equivalence)
+ format]]]
+ {1
+ ["." / (#+ Identity)]})
-(context: "Identity"
- (let [(^open "&;.") &.apply
- (^open "&;.") &.monad
- (^open "&;.") &.comonad]
- ($_ seq
- (test "Functor does not affect values."
- (text;= "yololol" (&;map (text;compose "yolo") "lol")))
-
- (test "Apply does not affect values."
- (and (text;= "yolo" (&;wrap "yolo"))
- (text;= "yololol" (&;apply (&;wrap (text;compose "yolo")) (&;wrap "lol")))))
-
- (test "Monad does not affect values."
- (text;= "yololol" (do &.monad
- [f (wrap text;compose)
- a (wrap "yolo")
- b (wrap "lol")]
- (wrap (f a b)))))
-
- (test "CoMonad does not affect values."
- (and (text;= "yololol" (&;unwrap "yololol"))
- (text;= "yololol" (be &.comonad
- [f text;compose
- a "yolo"
- b "lol"]
- (f a b)))))
- )))
+(def: injection
+ (Injection Identity)
+ (|>>))
+
+(def: comparison
+ (Comparison Identity)
+ (function (_ ==)
+ ==))
+
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /.Identity)))
+ ($_ _.and
+ (functorT.laws ..injection ..comparison /.functor)
+ (applyT.laws ..injection ..comparison /.apply)
+ (monadT.laws ..injection ..comparison /.monad)
+ (let [(^open "/@.") /.comonad]
+ (_.test "CoMonad does not affect values."
+ (and (text@= "yololol" (/@unwrap "yololol"))
+ (text@= "yololol" (be /.comonad
+ [f text@compose
+ a "yolo"
+ b "lol"]
+ (f a b))))))
+ )))
diff --git a/stdlib/source/test/lux/data/lazy.lux b/stdlib/source/test/lux/data/lazy.lux
index 5fe6464ff..957ce0c34 100644
--- a/stdlib/source/test/lux/data/lazy.lux
+++ b/stdlib/source/test/lux/data/lazy.lux
@@ -1,54 +1,55 @@
(.module:
[lux #*
+ ["_" test (#+ Test)]
[control
- [monad (#+ do Monad)]]
+ [monad (#+ do)]
+ {[0 #test]
+ [/
+ [".T" functor (#+ Injection Comparison)]
+ [".T" apply]
+ [".T" monad]
+ [".T" equivalence]]}]
[data
- ["&" lazy]]
+ text/format
+ [number
+ ["." nat]]]
[math
- ["r" random]]]
- lux/test)
+ ["r" random (#+ Random)]]]
+ {1
+ ["." / (#+ Lazy)]})
-(context: "Lazy."
- (<| (times 100)
- (do @
+(def: injection
+ (Injection Lazy)
+ (|>> /.freeze))
+
+(def: comparison
+ (Comparison Lazy)
+ (function (_ ==)
+ (:: (/.equivalence ==) =)))
+
+(def: #export lazy
+ (All [a] (-> (Random a) (Random (Lazy a))))
+ (:: r.functor map (|>> /.freeze)))
+
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /.Lazy)))
+ (do r.monad
[left r.nat
right r.nat
- #let [lazy (&.freeze (n/* left right))
+ #let [lazy (/.freeze (n/* left right))
expected (n/* left right)]]
- ($_ seq
- (test "Lazying does not alter the expected value."
- (n/= expected
- (&.thaw lazy)))
- (test "Lazy values only evaluate once."
- (and (not (is? expected
- (&.thaw lazy)))
- (is? (&.thaw lazy)
- (&.thaw lazy))))
- ))))
-
-(context: "Functor, Apply, Monad."
- (<| (times 100)
- (do @
- [sample r.nat]
- ($_ seq
- (test "Functor map."
- (|> (&.freeze sample)
- (:: &.functor map inc)
- &.thaw
- (n/= (inc sample))))
-
- (test "Monad."
- (|> (do &.monad
- [f (wrap inc)
- a (wrap sample)]
- (wrap (f a)))
- &.thaw
- (n/= (inc sample))))
-
- (test "Apply apply."
- (let [(^open "&;.") &.monad
- (^open "&;.") &.apply]
- (|> (&;apply (&;wrap inc) (&;wrap sample))
- &.thaw
- (n/= (inc sample)))))
+ ($_ _.and
+ (_.test "Freezing does not alter the expected value."
+ (n/= expected
+ (/.thaw lazy)))
+ (_.test "Lazy values only evaluate once."
+ (and (not (is? expected
+ (/.thaw lazy)))
+ (is? (/.thaw lazy)
+ (/.thaw lazy))))
+ (equivalenceT.test (/.equivalence nat.equivalence) (..lazy r.nat))
+ (functorT.laws ..injection ..comparison /.functor)
+ (applyT.laws ..injection ..comparison /.apply)
+ (monadT.laws ..injection ..comparison /.monad)
))))
diff --git a/stdlib/source/test/lux/data/maybe.lux b/stdlib/source/test/lux/data/maybe.lux
index f42be25bf..e2c0ce3fa 100644
--- a/stdlib/source/test/lux/data/maybe.lux
+++ b/stdlib/source/test/lux/data/maybe.lux
@@ -1,69 +1,77 @@
(.module:
[lux #*
+ ["_" test (#+ Test)]
[control
- ["M" monad (#+ Monad do)]
- pipe]
+ pipe
+ [monad (#+ do)]
+ {[0 #test]
+ [/
+ [".T" functor (#+ Injection Comparison)]
+ [".T" apply]
+ [".T" monad]
+ [".T" equivalence]]}]
[data
- ["&" maybe ("#;." monoid)]
- ["." text ("#;." monoid)]]
- ["." io ("#;." monad)]]
- lux/test)
+ ["." text
+ format]
+ [number
+ ["." nat]]]
+ ["." io ("#@." monad)]
+ [math
+ ["r" random (#+ Random)]]]
+ {1
+ ["." / ("#@." monoid)]})
-(context: "Maybe"
- (let [(^open "&;.") &.apply
- (^open "&;.") &.monad
- (^open "&;.") (&.equivalence text.equivalence)]
- ($_ seq
- (test "Can compare Maybe values."
- (and (&;= #.None #.None)
- (&;= (#.Some "yolo") (#.Some "yolo"))
- (not (&;= (#.Some "yolo") (#.Some "lol")))
- (not (&;= (#.Some "yolo") #.None))))
+(def: injection
+ (Injection Maybe)
+ (|>> #.Some))
- (test "Monoid respects Maybe."
- (and (&;= #.None &;identity)
- (&;= (#.Some "yolo") (&;compose (#.Some "yolo") (#.Some "lol")))
- (&;= (#.Some "yolo") (&;compose (#.Some "yolo") #.None))
- (&;= (#.Some "lol") (&;compose #.None (#.Some "lol")))
- (&;= #.None (: (Maybe Text) (&;compose #.None #.None)))))
-
- (test "Functor respects Maybe."
- (and (&;= #.None (&;map (text;compose "yolo") #.None))
- (&;= (#.Some "yololol") (&;map (text;compose "yolo") (#.Some "lol")))))
-
- (test "Apply respects Maybe."
- (and (&;= (#.Some "yolo") (&;wrap "yolo"))
- (&;= (#.Some "yololol")
- (&;apply (&;wrap (text;compose "yolo")) (&;wrap "lol")))))
-
- (test "Monad respects Maybe."
- (&;= (#.Some "yololol")
- (do &.monad
- [f (wrap text;compose)
- a (wrap "yolo")
- b (wrap "lol")]
- (wrap (f a b)))))
+(def: comparison
+ (Comparison Maybe)
+ (function (_ ==)
+ (:: (/.equivalence ==) =)))
- (do r.monad
- [default r.nat
- maybe r.nat]
- (_.test "Can have defaults for Maybe values."
- (and (is? default (maybe.default default
- #.None))
+(def: #export maybe
+ (All [a] (-> (Random a) (Random (Maybe a))))
+ (:: r.functor map (|>> #.Some)))
- (is? maybe (maybe.default default
- (#.Some maybe))))))
- )))
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of .Maybe)))
+ ($_ _.and
+ (equivalenceT.test (/.equivalence nat.equivalence) (..maybe r.nat))
+ (functorT.laws ..injection ..comparison /.functor)
+ (applyT.laws ..injection ..comparison /.apply)
+ (monadT.laws ..injection ..comparison /.monad)
+ (do r.monad
+ [left r.nat
+ right r.nat
+ #let [expected (n/+ left right)]]
+ (let [lift (/.lift io.monad)]
+ (_.test "Can add maybe functionality to any monad."
+ (|> (io.run (do (/.with io.monad)
+ [a (lift (io@wrap left))
+ b (wrap right)]
+ (wrap (n/+ a b))))
+ (case> (#.Some actual)
+ (n/= expected actual)
-(context: "Monad transformer"
- (let [lift (&.lift io.monad)]
- (test "Can add maybe functionality to any monad."
- (|> (io.run (do (&.MaybeT io.monad)
- [a (lift (io;wrap +123))
- b (wrap +456)]
- (wrap (i/+ a b))))
- (case> (#.Some +579)
- #1
-
- _
- #0)))))
+ _
+ false)))))
+ (let [(^open "/@.") (/.equivalence text.equivalence)
+ (^open "/@.") /.monoid]
+ (_.test "Monoid respects Maybe."
+ (and (/@= #.None /@identity)
+ (/@= (#.Some "yolo") (/@compose (#.Some "yolo") (#.Some "lol")))
+ (/@= (#.Some "yolo") (/@compose (#.Some "yolo") #.None))
+ (/@= (#.Some "lol") (/@compose #.None (#.Some "lol")))
+ (/@= #.None (: (Maybe Text) (/@compose #.None #.None))))))
+ (do r.monad
+ [default r.nat
+ value r.nat]
+ (_.test "Can have defaults for Maybe values."
+ (and (is? default (/.default default
+ #.None))
+
+ (is? value (/.default default
+ (#.Some value))))))
+ )))
diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux
index 32744ad5f..6582e68ff 100644
--- a/stdlib/source/test/lux/data/name.lux
+++ b/stdlib/source/test/lux/data/name.lux
@@ -1,73 +1,63 @@
(.module:
[lux #*
+ ["_" test (#+ Test)]
[control
- [monad (#+ do Monad)]
- pipe]
+ pipe
+ [monad (#+ do)]
+ {[0 #test]
+ [/
+ [".T" equivalence]
+ [".T" codec]]}]
[data
- ["&" name]
- ["." text ("#;." equivalence)
+ ["." text ("#@." equivalence)
format]]
[math
- ["r" random]]]
- lux/test)
+ ["r" random (#+ Random)]]]
+ {1
+ ["." /]})
-(def: (gen-part size)
+(def: (part size)
(-> Nat (r.Random Text))
(|> (r.unicode size) (r.filter (|>> (text.contains? ".") not))))
-(context: "Names"
- (<| (times 100)
- (do @
+(def: #export (name module-size short-size)
+ (-> Nat Nat (Random Name))
+ (r.and (..part module-size)
+ (..part short-size)))
+
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of .Name)))
+ (do r.monad
[## First Name
sizeM1 (|> r.nat (:: @ map (n/% 100)))
- sizeN1 (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1))))
- module1 (gen-part sizeM1)
- short1 (gen-part sizeN1)
- #let [name1 [module1 short1]]
+ sizeS1 (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1))))
+ (^@ name1 [module1 short1]) (..name sizeM1 sizeS1)
## Second Name
sizeM2 (|> r.nat (:: @ map (n/% 100)))
- sizeN2 (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1))))
- module2 (gen-part sizeM2)
- short2 (gen-part sizeN2)
- #let [name2 [module2 short2]]
- #let [(^open "&;.") &.equivalence
- (^open "&;.") &.codec]]
- ($_ seq
- (test "Can get the module & short parts of an name."
- (and (is? module1 (&.module name1))
- (is? short1 (&.short name1))))
-
- (test "Can compare names for equivalence."
- (and (&;= name1 name1)
- (if (&;= name1 name2)
- (and (text;= module1 module2)
- (text;= short1 short2))
- (or (not (text;= module1 module2))
- (not (text;= short1 short2))))))
-
- (test "Can encode names as text."
- (|> name1
- &;encode &;decode
- (case> (#.Right dec-name) (&;= name1 dec-name)
- _ #0)))
-
- (test "Encoding an name without a module component results in text equal to the short of the name."
- (if (text.empty? module1)
- (text;= short1 (&;encode name1))
- #1))
+ sizeS2 (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1))))
+ (^@ name2 [module2 short2]) (..name sizeM2 sizeS2)]
+ ($_ _.and
+ (equivalenceT.test /.equivalence (..name sizeM1 sizeS1))
+ (codecT.test /.codec /.equivalence (..name sizeM1 sizeS1))
+ (_.test "Can get the module / short parts of an name."
+ (and (is? module1 (/.module name1))
+ (is? short1 (/.short name1))))
+ (let [(^open "/@.") /.codec]
+ (_.test "Encoding an name without a module component results in text equal to the short of the name."
+ (if (text.empty? module1)
+ (text@= short1 (/@encode name1))
+ #1)))
+ (let [(^open "/@.") /.equivalence]
+ ($_ _.and
+ (_.test "Can obtain Name from identifier."
+ (and (/@= ["lux" "yolo"] (name-of .yolo))
+ (/@= ["test/lux/data/name" "yolo"] (name-of ..yolo))
+ (/@= ["" "yolo"] (name-of yolo))
+ (/@= ["lux/test" "yolo"] (name-of lux/test.yolo))))
+ (_.test "Can obtain Name from tag."
+ (and (/@= ["lux" "yolo"] (name-of #.yolo))
+ (/@= ["test/lux/data/name" "yolo"] (name-of #..yolo))
+ (/@= ["" "yolo"] (name-of #yolo))
+ (/@= ["lux/test" "yolo"] (name-of #lux/test.yolo))))))
))))
-
-(context: "Name-related macros."
- (let [(^open "&;.") &.equivalence]
- ($_ seq
- (test "Can obtain Name from identifier."
- (and (&;= ["lux" "yolo"] (name-of .yolo))
- (&;= ["test/lux/data/name" "yolo"] (name-of ..yolo))
- (&;= ["" "yolo"] (name-of yolo))
- (&;= ["lux/test" "yolo"] (name-of lux/test.yolo))))
-
- (test "Can obtain Name from tag."
- (and (&;= ["lux" "yolo"] (name-of #.yolo))
- (&;= ["test/lux/data/name" "yolo"] (name-of #..yolo))
- (&;= ["" "yolo"] (name-of #yolo))
- (&;= ["lux/test" "yolo"] (name-of #lux/test.yolo)))))))