diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/source/lux/macro/poly/json.lux | 10 | ||||
| -rw-r--r-- | stdlib/source/lux/type/unit.lux | 61 | ||||
| -rw-r--r-- | stdlib/test/test/lux/data/format/json.lux | 9 |
3 files changed, 36 insertions, 44 deletions
diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux index 3cb1fac1a..155042437 100644 --- a/stdlib/source/lux/macro/poly/json.lux +++ b/stdlib/source/lux/macro/poly/json.lux @@ -69,12 +69,12 @@ #.None #//.Null (#.Some value) (writer value)))) -(struct: (Codec<JSON,Qty> carrier) - (All [unit] (-> unit (Codec JSON (unit.Qty unit)))) +(struct: Codec<JSON,Qty> + (All [unit] (Codec JSON (unit.Qty unit))) (def: encode (|>> unit.out (:: Codec<JSON,Int> encode))) (def: decode - (|>> (:: Codec<JSON,Int> decode) (:: e.Functor<Error> map (unit.in carrier))))) + (|>> (:: Codec<JSON,Int> decode) (:: e.Functor<Error> map unit.in)))) (poly: Codec<JSON,?>//encode (with-expansions @@ -114,7 +114,7 @@ [unitT (poly.apply (p.after (poly.this unit.Qty) poly.any))] (wrap (` (: (~ (@JSON//encode inputT)) - (:: ((~! Codec<JSON,Qty>) (:! (~ (poly.to-ast *env* unitT)) [])) (~' encode)))))) + (:: (~! Codec<JSON,Qty>) (~' encode)))))) (do @ [#let [g!key (code.local-symbol "\u0000key") g!val (code.local-symbol "\u0000val")] @@ -226,7 +226,7 @@ [unitT (poly.apply (p.after (poly.this unit.Qty) poly.any))] (wrap (` (: (~ (@JSON//decode inputT)) - (p.codec ((~! Codec<JSON,Qty>) (:! (~ (poly.to-ast *env* unitT)) [])) //.any))))) + (p.codec (~! Codec<JSON,Qty>) //.any))))) (do @ [[_ _ valC] (poly.apply ($_ p.seq (poly.this d.Dict) diff --git a/stdlib/source/lux/type/unit.lux b/stdlib/source/lux/type/unit.lux index cf59e25d4..c483ad71b 100644 --- a/stdlib/source/lux/type/unit.lux +++ b/stdlib/source/lux/type/unit.lux @@ -12,10 +12,20 @@ ["s" syntax #+ syntax:] (syntax ["cs" common] (common ["csr" reader] - ["csw" writer]))))) + ["csw" writer]))) + (type abstract))) -(type: #export (Qty unit) - [Int unit]) +(abstract: #export (Qty unit) + {} + Int + + (def: #export in + (All [unit] (-> Int (Qty unit))) + (|>> @abstract)) + + (def: #export out + (All [unit] (-> (Qty unit) Int)) + (|>> @repr))) (sig: #export (Scale s) (: (All [u] (-> (Qty u) (Qty (s u)))) @@ -37,23 +47,9 @@ (type: #export (Product p s) (|> s (Per (Inverse p)))) -(def: #export (in carrier magnitude) - (All [unit] (-> unit Int (Qty unit))) - [magnitude carrier]) - -(def: #export (pure magnitude) +(def: #export pure (-> Int Pure) - (in [] magnitude)) - -(def: #export (out quantity) - (All [unit] (-> (Qty unit) Int)) - (let [[magnitude carrier] quantity] - magnitude)) - -(def: (carrier quantity) - (All [unit] (-> (Qty unit) unit)) - (let [[magnitude carrier] quantity] - carrier)) + in) (do-template [<name> <tag>] [(def: <name> @@ -101,12 +97,12 @@ (|>> ..out (i/* (~ (code.int (nat-to-int numerator)))) (i// (~ (code.int (nat-to-int denominator)))) - (..in (:! ((~ g!scale) ($ +0)) [])))) + ..in)) (def: (~' de-scale) (|>> ..out (i/* (~ (code.int (nat-to-int denominator)))) (i// (~ (code.int (nat-to-int numerator)))) - (..in (:! ($ +0) [])))) + ..in)) (def: (~' ratio) [(~ (code.nat numerator)) (~ (code.nat denominator))]))) )))) @@ -114,7 +110,7 @@ (do-template [<name> <op>] [(def: #export (<name> param subject) (All [unit] (-> (Qty unit) (Qty unit) (Qty unit))) - (|> (out subject) (<op> (out param)) (in (carrier subject))))] + (|> subject out (<op> (out param)) in))] [u/+ i/+] [u/- i/-] @@ -126,22 +122,24 @@ (|> (out subject) (i/* (out input)) (i// (out param)) - (in (carrier subject))))) + in))) (def: #export (u/* param subject) (All [p s] (-> (Qty p) (Qty s) (Product (Qty p) (Qty s)))) (function [input] - (|> (out subject) + (|> subject + out (i/* (out (input param))) - (in (carrier subject))))) + in))) (def: #export (re-scale from to quantity) (All [si so u] (-> (Scale si) (Scale so) (Qty (si u)) (Qty (so u)))) (let [[numerator denominator] (|> (:: to ratio) (r.r// (:: from ratio)))] - (|> quantity out + (|> quantity + out (i/* (nat-to-int numerator)) (i// (nat-to-int denominator)) - (in (:! (($ +1) ($ +2)) []))))) + in))) (scale: #export Kilo [1 1_000]) (scale: #export Mega [1 1_000_000]) @@ -151,11 +149,6 @@ (scale: #export Micro [ 1_000_000 1]) (scale: #export Nano [1_000_000_000 1]) -(def: #export (as scale unit magnitude) - (All [s u] (-> (Scale s) u Int (Qty (s u)))) - (let [[_ carrier] (|> 0 (in unit) (:: scale scale))] - [magnitude carrier])) - (unit: #export Gram) (unit: #export Meter) (unit: #export Litre) @@ -179,5 +172,5 @@ (struct: #export Enum<Unit> (All [unit] (Enum (Qty unit))) (def: order Order<Unit>) - (def: (succ qty) (|> (out qty) i/inc (in (carrier qty)))) - (def: (pred qty) (|> (out qty) i/dec (in (carrier qty))))) + (def: succ (|>> ..out i/inc ..in)) + (def: pred (|>> ..out i/dec ..in))) diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux index 5cbef91b0..e08478993 100644 --- a/stdlib/test/test/lux/data/format/json.lux +++ b/stdlib/test/test/lux/data/format/json.lux @@ -100,10 +100,9 @@ (derived: (poly/eq.Eq<?> Recursive)) -(def: (qty carrier) - (All [unit] (-> unit (r.Random (unit.Qty unit)))) - (|> r.int - (:: r.Monad<Random> map (unit.in carrier)))) +(def: qty + (All [unit] (r.Random (unit.Qty unit))) + (|> r.int (:: r.Monad<Random> map unit.in))) (def: gen-record (r.Random Record) @@ -123,7 +122,7 @@ _instant.instant _duration.duration _date.date - (qty unit.@Gram) + qty ))) (derived: (poly/json.Codec<JSON,?> Record)) |