aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--stdlib/source/lux/data/error.lux4
-rw-r--r--stdlib/source/lux/data/format/json.lux27
-rw-r--r--stdlib/source/lux/math/random.lux12
-rw-r--r--stdlib/source/test/lux/data/error.lux2
-rw-r--r--stdlib/source/test/lux/data/format/json.lux8
5 files changed, 34 insertions, 19 deletions
diff --git a/stdlib/source/lux/data/error.lux b/stdlib/source/lux/data/error.lux
index 9f84c2707..f05df614d 100644
--- a/stdlib/source/lux/data/error.lux
+++ b/stdlib/source/lux/data/error.lux
@@ -79,8 +79,8 @@
[(#Success reference) (#Success sample)]
(_@= reference sample)
- _
- false)))
+ [(#Failure reference) (#Failure sample)]
+ ("lux text =" reference sample))))
(def: #export (succeed value)
(All [a] (-> a (Error a)))
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index b68101e3c..64064fb1f 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -2,6 +2,7 @@
"For more information, please see: http://www.json.org/")}
[lux #*
[control
+ pipe
["." monad (#+ Monad do)]
[equivalence (#+ Equivalence)]
codec
@@ -192,19 +193,31 @@
############################################################
############################################################
-(def: (encode-boolean value)
+(def: encode-boolean
(-> Bit Text)
- (case value
- #0 "false"
- #1 "true"))
+ (|>> (case>
+ #0 "false"
+ #1 "true")))
+
+(def: encode-number
+ (-> Frac Text)
+ (|>> (case>
+ +0.0 "0.0"
+ -0.0 "0.0"
+ value (let [raw (:: frac.decimal encode value)]
+ (if (f/< +0.0 value)
+ raw
+ (|> raw (text.split 1) maybe.assume product.right))))))
(def: (show-null _) (-> Null Text) "null")
+
(do-template [<name> <type> <codec>]
[(def: <name> (-> <type> Text) <codec>)]
- [show-boolean Boolean encode-boolean]
- [show-number Number (:: frac.decimal encode)]
- [show-string String text.encode])
+ [show-boolean Boolean ..encode-boolean]
+ [show-number Number ..encode-number]
+ [show-string String text.encode]
+ )
(def: (show-array show-json elems)
(-> (-> JSON Text) (-> Array Text))
diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux
index d998168d4..c9c91408a 100644
--- a/stdlib/source/lux/math/random.lux
+++ b/stdlib/source/lux/math/random.lux
@@ -115,11 +115,13 @@
(def: #export safe-frac
(Random Frac)
- (:: ..monad map
- (|>> (i/% +1,000,000)
- .int-to-frac
- (f// +1,000,000.0))
- ..int))
+ (let [mantissa-range (.int (i64.left-shift 53 1))
+ mantissa-max (.int-to-frac (dec mantissa-range))]
+ (:: ..monad map
+ (|>> (i/% mantissa-range)
+ .int-to-frac
+ (f// mantissa-max))
+ ..int)))
(def: #export (char set)
(-> unicode.Set (Random Char))
diff --git a/stdlib/source/test/lux/data/error.lux b/stdlib/source/test/lux/data/error.lux
index 58d37aef7..9012b3212 100644
--- a/stdlib/source/test/lux/data/error.lux
+++ b/stdlib/source/test/lux/data/error.lux
@@ -32,7 +32,7 @@
(def: #export (error element)
(All [a] (-> (Random a) (Random (Error a))))
($_ r.or
- (r.ascii 10)
+ (:: r.monad wrap "KABOOM!")
element))
(def: #export test
diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux
index a170d3163..f276c5180 100644
--- a/stdlib/source/test/lux/data/format/json.lux
+++ b/stdlib/source/test/lux/data/format/json.lux
@@ -48,16 +48,16 @@
(def: #export json
(Random JSON)
- (r.rec (function (_ json)
+ (r.rec (function (_ recur)
(do r.monad
[size (:: @ map (n/% 2) r.nat)]
($_ r.or
(:: @ wrap [])
r.bit
- r.frac
+ r.safe-frac
(r.unicode size)
- (r.row size json)
- (r.dictionary text.hash size (r.unicode size) json)
+ (r.row size recur)
+ (r.dictionary text.hash size (r.unicode size) recur)
)))))
(def: #export test