diff options
| author | Eduardo Julian | 2017-09-05 18:38:26 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2017-09-05 18:38:26 -0400 |
| commit | dd505e9d5c528388e80ca5a2cd3d08c8001ed634 (patch) | |
| tree | 4aaa61aab097abc4414547d511748ff1f5c209b7 /stdlib/source | |
| parent | 8eec2a1545cf28f2c9e8a5d604d995bfe7332e9b (diff) | |
- Added polytypic JSON codec support for unit-types.
Diffstat (limited to 'stdlib/source')
| -rw-r--r-- | stdlib/source/lux/macro/poly/json.lux | 22 |
1 files changed, 20 insertions, 2 deletions
diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux index 2c87603d3..379be9f49 100644 --- a/stdlib/source/lux/macro/poly/json.lux +++ b/stdlib/source/lux/macro/poly/json.lux @@ -27,6 +27,7 @@ [code] [poly #+ poly:]) [type] + (type [unit]) )) (def: #hidden _map_ @@ -49,7 +50,7 @@ (struct: #hidden _ (Codec JSON Nat) (def: (encode input) - (let [high (|> input (bit;and high-mask) (bit;unsigned-shift-right +32)) + (let [high (|> input (bit;and high-mask) (bit;shift-right +32)) low (bit;and low-mask input)] (#..;Array (vector (|> high nat-to-int int-to-frac #..;Number) (|> low nat-to-int int-to-frac #..;Number))))) @@ -74,6 +75,13 @@ #;None #..;Null (#;Some value) (writer value)))) +(struct: #hidden (Codec<JSON,Qty> carrier) + (All [unit] (-> unit (Codec JSON (unit;Qty unit)))) + (def: encode + (|>. unit;out (:: Codec<JSON,Int> encode))) + (def: decode + (|>. (:: Codec<JSON,Int> decode) (:: R;Functor<Result> map (unit;in carrier))))) + (poly: #hidden Codec<JSON,?>//encode (with-expansions [<basic> (do-template [<type> <matcher> <encoder>] @@ -92,7 +100,7 @@ [(do @ [_ (poly;this <type>)] (wrap (` (: (~ (@JSON//encode inputT)) - (|>. (:: <codec> (~' encode)) ..;string)))))] + (|>. (:: <codec> (~' encode)) #..;String)))))] [du;Duration du;Codec<Text,Duration>] [i;Instant i;Codec<Text,Instant>] @@ -109,6 +117,11 @@ <basic> <time> (do @ + [unitT (poly;apply (p;after (poly;this unit;Qty) + poly;any))] + (wrap (` (: (~ (@JSON//encode inputT)) + (:: (Codec<JSON,Qty> (:! (~ (poly;to-ast *env* unitT)) [])) (~' encode)))))) + (do @ [#let [g!key (code;local-symbol "\u0000key") g!val (code;local-symbol "\u0000val")] [_ _ .val.] (poly;apply ($_ p;seq @@ -216,6 +229,11 @@ <basic> <time> (do @ + [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))))) + (do @ [[_ _ valC] (poly;apply ($_ p;seq (poly;this d;Dict) poly;text |