From 4c36eaf769bc74e708d1f63e67ff612176963731 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 15 Jul 2017 20:45:10 -0400
Subject: - Can now generate Eq instances for #rec-style recursive types. -
 Minor refactorings.

---
 stdlib/source/lux/data/format/json.lux | 104 +++++++++++++++++----------------
 1 file changed, 55 insertions(+), 49 deletions(-)

(limited to 'stdlib/source/lux/data/format/json.lux')

diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index 2e31a3924..865e92b8c 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -5,7 +5,7 @@
   (lux (control functor
                 applicative
                 monad
-                eq
+                [eq #+ Eq]
                 codec
                 ["p" parser "p/" Monad<Parser>])
        (data [bool]
@@ -387,11 +387,11 @@
        _
        (#R;Error (format "JSON value is not " <desc> ": " (show-json json)))))]
 
-  [unit Unit #Null    "unit"    id]
+  [unit Unit #Null    "unit" id]
   [bool Bool #Boolean "bool" id]
   [int  Int  #Number  "int"  real-to-int]
-  [real Real #Number  "real"  id]
-  [text Text #String  "text"  id]
+  [real Real #Number  "real" id]
+  [text Text #String  "text" id]
   )
 
 (do-template [<test> <check> <type> <eq> <encoder> <tag> <desc> <pre>]
@@ -524,79 +524,85 @@
      =b pb]
     (wrap [=a =b])))
 
-(def: #export (alt pa pb json)
+(def: #export (alt pa pb)
   {#;doc "Heterogeneous alternative combinator."}
   (All [a b] (-> (Parser a) (Parser b) (Parser (| a b))))
-  (case (pa json)
-    (#R;Success a)
-    (sum;right (sum;left a))
+  (function [json]
+    (case (pa json)
+      (#R;Success a)
+      (sum;right (sum;left a))
 
-    (#R;Error message0)
-    (case (pb json)
-      (#R;Success b)
-      (sum;right (sum;right b))
+      (#R;Error message0)
+      (case (pb json)
+        (#R;Success b)
+        (sum;right (sum;right b))
 
-      (#R;Error message1)
-      (#R;Error message0))))
+        (#R;Error message1)
+        (#R;Error message0)))))
 
-(def: #export (either pl pr json)
+(def: #export (either pl pr)
   {#;doc "Homogeneous alternative combinator."}
   (All [a] (-> (Parser a) (Parser a) (Parser a)))
-  (case (pl json)
-    (#R;Success x)
-    (#R;Success x)
+  (function [json]
+    (case (pl json)
+      (#R;Success x)
+      (#R;Success x)
 
-    _
-    (pr json)))
+      _
+      (pr json))))
 
-(def: #export (opt p json)
+(def: #export (opt p)
   {#;doc "Optionality combinator."}
   (All [a]
     (-> (Parser a) (Parser (Maybe a))))
-  (case (p json)
-    (#R;Error _)  (#R;Success #;None)
-    (#R;Success x) (#R;Success (#;Some x))))
+  (function [json]
+    (case (p json)
+      (#R;Error _)  (#R;Success #;None)
+      (#R;Success x) (#R;Success (#;Some x)))))
 
 (def: #export (run json parser)
   (All [a] (-> JSON (Parser a) (R;Result a)))
   (parser json))
 
-(def: #export (ensure test parser json)
+(def: #export (ensure test parser)
   {#;doc "Only parses a JSON if it passes a test (which is also a parser)."}
   (All [a] (-> (Parser Unit) (Parser a) (Parser a)))
-  (case (test json)
-    (#R;Success _)
-    (parser json)
+  (function [json]
+    (case (test json)
+      (#R;Success _)
+      (parser json)
 
-    (#R;Error error)
-    (#R;Error error)))
+      (#R;Error error)
+      (#R;Error error))))
 
-(def: #export (array-size! size json)
+(def: #export (array-size! size)
   {#;doc "Ensures a JSON array has the specified size."}
   (-> Nat (Parser Unit))
-  (case json
-    (#Array parts)
-    (if (n.= size (vector;size parts))
-      (#R;Success [])
-      (#R;Error (format "JSON array does no have size " (%n size) " " (show-json json))))
+  (function [json]
+    (case json
+      (#Array parts)
+      (if (n.= size (vector;size parts))
+        (#R;Success [])
+        (#R;Error (format "JSON array does no have size " (%n size) " " (show-json json))))
 
-    _
-    (#R;Error (format "JSON value is not an array: " (show-json json)))))
+      _
+      (#R;Error (format "JSON value is not an array: " (show-json json))))))
 
-(def: #export (object-fields! wanted-fields json)
+(def: #export (object-fields! wanted-fields)
   {#;doc "Ensures that every field in the list of wanted-fields is present in a JSON object."}
   (-> (List String) (Parser Unit))
-  (case json
-    (#Object kvs)
-    (let [actual-fields (d;keys kvs)]
-      (if (and (n.= (list;size wanted-fields) (list;size actual-fields))
-               (list;every? (list;member? text;Eq<Text> wanted-fields)
-                            actual-fields))
-        (#R;Success [])
-        (#R;Error (format "JSON object has wrong field-set. Expected: [" (text;join-with ", " wanted-fields) "]. Actual: [" (text;join-with ", " actual-fields) "]"))))
+  (function [json]
+    (case json
+      (#Object kvs)
+      (let [actual-fields (d;keys kvs)]
+        (if (and (n.= (list;size wanted-fields) (list;size actual-fields))
+                 (list;every? (list;member? text;Eq<Text> wanted-fields)
+                              actual-fields))
+          (#R;Success [])
+          (#R;Error (format "JSON object has wrong field-set. Expected: [" (text;join-with ", " wanted-fields) "]. Actual: [" (text;join-with ", " actual-fields) "]"))))
 
-    _
-    (#R;Error (format "JSON value is not an object: " (show-json json)))))
+      _
+      (#R;Error (format "JSON value is not an object: " (show-json json))))))
 
 ## [Structures]
 (struct: #export _ (Eq JSON)
-- 
cgit v1.2.3