From 8343ca14bdc6ec29070021cb6d8ef05e0a234fb6 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 4 Jan 2017 19:39:35 -0400
Subject: - Updated documentation for lux/data/format/json. - Minor
 refactorings.

---
 stdlib/source/lux/data/format/json.lux | 137 ++++++++++++++++++++++++---------
 1 file changed, 102 insertions(+), 35 deletions(-)

diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index 43b029f60..f9dafee7a 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -3,7 +3,9 @@
 ##  If a copy of the MPL was not distributed with this file,
 ##  You can obtain one at http://mozilla.org/MPL/2.0/.
 
-(;module:
+(;module: {#;doc "Functionality for reading, generating and processing values in the JSON format.
+
+                  For more information, please see: http://www.json.org/"}
   lux
   (lux (control functor
                 applicative
@@ -56,13 +58,24 @@
   )
 
 (type: #export (Parser a)
+  {#;doc "JSON parsers."}
   (-> JSON (Error a)))
 
 (type: #export (Gen a)
+  {#;doc "JSON generators."}
   (-> a JSON))
 
 ## [Syntax]
 (syntax: #export (json token)
+  {#;doc (doc "A way to produce JSON literals."
+              (json true)
+              (json 123)
+              (json 456.78)
+              (json "Some text")
+              (json #null)
+              (json ["this" "is" "an" "array"])
+              (json {"this" "is"
+                     "an" "object"}))}
   (let [(^open) Monad<Lux>
         wrapper (lambda [x] (` (;;json (~ x))))]
     (case token
@@ -136,19 +149,22 @@
     ))
 
 (def: #export null
+  {#;doc "The null JSON value."}
   JSON
   #Null)
 
-(def: #export (keys json)
+(def: #export (fields json)
+  {#;doc "Get all the fields in a JSON object."}
   (-> JSON (Error (List String)))
   (case json
     (#Object obj)
     (#;Right (dict;keys obj))
 
     _
-    (#;Left (format "Can't get keys of a non-object."))))
+    (#;Left (format "Can't get the fields of a non-object."))))
 
 (def: #export (get key json)
+  {#;doc "A JSON object field getter."}
   (-> String JSON (Error JSON))
   (case json
     (#Object obj)
@@ -163,6 +179,7 @@
     (#;Left (format "Can't get field " (show-string key) " of a non-object."))))
 
 (def: #export (set key value json)
+  {#;doc "A JSON object field setter."}
   (-> String JSON JSON (Error JSON))
   (case json
     (#Object obj)
@@ -171,8 +188,9 @@
     _
     (#;Left (format "Can't set field " (show-string key) " of a non-object."))))
 
-(do-template [<name> <tag> <type>]
+(do-template [<name> <tag> <type> <desc>]
   [(def: #export (<name> key json)
+     {#;doc (#;TextM (format "A JSON object field getter for " <desc> "."))}
      (-> Text JSON (Error <type>))
      (case (get key json)
        (#;Right (<tag> value))
@@ -184,26 +202,28 @@
        (#;Left error)
        (#;Left error)))]
 
-  [get-boolean #Boolean Boolean]
-  [get-number  #Number  Number]
-  [get-string  #String  String]
-  [get-array   #Array   Array]
-  [get-object  #Object  Object]
+  [get-boolean #Boolean Boolean "booleans"]
+  [get-number  #Number  Number  "numbers"]
+  [get-string  #String  String  "strings"]
+  [get-array   #Array   Array   "arrays"]
+  [get-object  #Object  Object  "objects"]
   )
 
-(do-template [<name> <type> <tag>]
+(do-template [<name> <type> <tag> <desc>]
   [(def: #export (<name> value)
+     {#;doc (#;TextM (format "A JSON generator for " <desc> "."))}
      (Gen <type>)
      (<tag> value))]
 
-  [gen-boolean Boolean #Boolean]
-  [gen-number  Number  #Number]
-  [gen-string  String  #String]
-  [gen-array   Array   #Array]
-  [gen-object  Object  #Object]
+  [gen-boolean Boolean #Boolean "booleans"]
+  [gen-number  Number  #Number  "numbers"]
+  [gen-string  String  #String  "strings"]
+  [gen-array   Array   #Array   "arrays"]
+  [gen-object  Object  #Object  "objects"]
   )
 
 (def: #export (gen-nullable gen)
+  {#;doc "Builds a JSON generator for potentially inexistent values."}
   (All [a] (-> (Gen a) (Gen (Maybe a))))
   (lambda [elem]
     (case elem
@@ -378,23 +398,25 @@
 ## Syntax
 (do-template [<name> <type> <tag> <desc> <pre>]
   [(def: #export (<name> json)
+     {#;doc (#;TextM (format "Reads a JSON value as " <desc> "."))}
      (Parser <type>)
      (case json
        (<tag> value)
        (#;Right (<pre> value))
 
        _
-       (#;Left (format "JSON value is not a " <desc> ": " (show-json json)))))]
+       (#;Left (format "JSON value is not " <desc> ": " (show-json json)))))]
 
-  [unit Unit #Null    "null"    id]
-  [bool Bool #Boolean "boolean" id]
-  [int  Int  #Number  "number"  real-to-int]
-  [real Real #Number  "number"  id]
-  [text Text #String  "string"  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]
   )
 
 (do-template [<test> <check> <type> <eq> <codec> <tag> <desc> <pre>]
   [(def: #export (<test> test json)
+     {#;doc (#;TextM (format "Asks whether a JSON value is a " <desc> "."))}
      (-> <type> (Parser Bool))
      (case json
        (<tag> value)
@@ -404,6 +426,7 @@
        (#;Left (format "JSON value is not a " <desc> ": " (show-json json)))))
 
    (def: #export (<check> test json)
+     {#;doc (#;TextM (format "Ensures a JSON value is a " <desc> "."))}
      (-> <type> (Parser Unit))
      (case json
        (<tag> value)
@@ -423,6 +446,7 @@
   )
 
 (def: #export (char json)
+  {#;doc "Reads a JSON value as a single-character string."}
   (Parser Char)
   (case json
     (#String input)
@@ -437,6 +461,7 @@
     (#;Left (format "JSON value is not a " "string" ": " (show-json json)))))
 
 (def: #export (char? test json)
+  {#;doc "Asks whether a JSON value is a single-character string with the specified character."}
   (-> Char (Parser Bool))
   (case json
     (#String input)
@@ -454,6 +479,7 @@
     (#;Left (format "JSON value is not a " "string" ": " (show-json json)))))
 
 (def: #export (char! test json)
+  {#;doc "Ensures a JSON value is a single-character string with the specified character."}
   (-> Char (Parser Unit))
   (case json
     (#String input)
@@ -471,6 +497,7 @@
     (#;Left (format "JSON value is not a " "string" ": " (show-json json)))))
 
 (def: #export (nullable parser)
+  {#;doc "A parser that can handle the presence of null values."}
   (All [a] (-> (Parser a) (Parser (Maybe a))))
   (lambda [json]
     (case json
@@ -487,6 +514,7 @@
       )))
 
 (def: #export (array parser)
+  {#;doc "Parses a JSON array, assuming that every element can be parsed the same way."}
   (All [a] (-> (Parser a) (Parser (List a))))
   (lambda [json]
     (case json
@@ -499,6 +527,7 @@
       (#;Left (format "JSON value is not an array: " (show-json json))))))
 
 (def: #export (object parser)
+  {#;doc "Parses a JSON object, assuming that every field's value can be parsed the same way."}
   (All [a] (-> (Parser a) (Parser (Dict String a))))
   (lambda [json]
     (case json
@@ -516,6 +545,7 @@
       (#;Left (format "JSON value is not an object: " (show-json json))))))
 
 (def: #export (at idx parser)
+  {#;doc "Parses an element inside a JSON array."}
   (All [a] (-> Nat (Parser a) (Parser a)))
   (lambda [json]
     (case json
@@ -536,6 +566,7 @@
       (#;Left (format "JSON value is not an array: " (show-json json))))))
 
 (def: #export (field field-name parser)
+  {#;doc "Parses a field inside a JSON object."}
   (All [a] (-> Text (Parser a) (Parser a)))
   (lambda [json]
     (case (get field-name json)
@@ -551,11 +582,13 @@
       (#;Left (format "JSON object does not have field " (show-string field-name) " @ " (show-json json))))))
 
 (def: #export any
+  {#;doc "Just returns the JSON input without applying any logic."}
   (Parser JSON)
   (lambda [json]
     (#;Right json)))
 
 (def: #export (seq pa pb)
+  {#;doc "Sequencing combinator."}
   (All [a b] (-> (Parser a) (Parser b) (Parser [a b])))
   (do Monad<Parser>
     [=a pa
@@ -563,6 +596,7 @@
     (wrap [=a =b])))
 
 (def: #export (alt pa pb json)
+  {#;doc "Heterogeneous alternative combinator."}
   (All [a b] (-> (Parser a) (Parser b) (Parser (| a b))))
   (case (pa json)
     (#;Right a)
@@ -577,6 +611,7 @@
       (#;Left message0))))
 
 (def: #export (either pl pr json)
+  {#;doc "Homogeneous alternative combinator."}
   (All [a] (-> (Parser a) (Parser a) (Parser a)))
   (case (pl json)
     (#;Right x)
@@ -586,6 +621,7 @@
     (pr json)))
 
 (def: #export (opt p json)
+  {#;doc "Optionality combinator."}
   (All [a]
     (-> (Parser a) (Parser (Maybe a))))
   (case (p json)
@@ -597,6 +633,7 @@
   (parser json))
 
 (def: #export (ensure test parser json)
+  {#;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)
     (#;Right _)
@@ -605,18 +642,20 @@
     (#;Left error)
     (#;Left error)))
 
-(def: #export (array-size! array-size json)
+(def: #export (array-size! size json)
+  {#;doc "Ensures a JSON array has the specified size."}
   (-> Nat (Parser Unit))
   (case json
     (#Array parts)
-    (if (n.= array-size (vector;size parts))
+    (if (n.= size (vector;size parts))
       (#;Right [])
-      (#;Left (format "JSON array does no have size " (%n array-size) " " (show-json json))))
+      (#;Left (format "JSON array does no have size " (%n size) " " (show-json json))))
 
     _
     (#;Left (format "JSON value is not an array: " (show-json json)))))
 
 (def: #export (object-fields! wanted-fields json)
+  {#;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)
@@ -683,7 +722,12 @@
   (syntax;alt (syntax;tuple (syntax;some syntax;any))
               (syntax;record (syntax;some (syntax;seq syntax;text syntax;any)))))
 
-(syntax: #export (shape^ [shape _shape^])
+(syntax: #export (shape [shape _shape^])
+  {#;doc (doc "Builds a parser that ensures the (inclusive) shape of an array or object."
+              (shape [bool! int! real!])
+              (shape {"isAlive" bool!
+                      "age" int!
+                      "income" real!}))}
   (case shape
     (#ArrayShape parts)
     (let [array-size (list;size parts)
@@ -701,7 +745,12 @@
       (wrap (list (` ($_ seq (~@ parsers))))))
     ))
 
-(syntax: #export (shape!^ [shape _shape^])
+(syntax: #export (shape! [shape _shape^])
+  {#;doc (doc "Builds a parser that ensures the (exclusive) shape of an array or object."
+              (shape! [bool! int! real!])
+              (shape! {"isAlive" bool!
+                       "age" int!
+                       "income" real!}))}
   (case shape
     (#ArrayShape parts)
     (let [array-size (list;size parts)
@@ -726,7 +775,7 @@
   (All [a b] (-> (-> a b) (List a) (List b)))
   List/map)
 
-(poly: #export (Codec<JSON,?>//encode *env* :x:)
+(poly: #hidden (Codec<JSON,?>//encode *env* :x:)
   (let [->Codec//encode (: (-> AST AST)
                            (lambda [.type.] (` (-> (~ .type.) JSON))))]
     (let% [<basic> (do-template [<type> <matcher> <encoder>]
@@ -877,7 +926,7 @@
           (compiler;fail (format "Can't create JSON encoder for: " (%type :x:)))
           ))))
 
-(poly: #export (Codec<JSON,?>//decode *env* :x:)
+(poly: #hidden (Codec<JSON,?>//decode *env* :x:)
   (let [->Codec//decode (: (-> AST AST)
                            (lambda [.type.] (` (-> JSON (Error (~ .type.))))))]
     (let% [<basic> (do-template [<type> <matcher> <decoder>]
@@ -926,7 +975,7 @@
               (wrap (` (: (~ :x:+)
                           (lambda [(~@ g!vars) (~ g!input)]
                             (do Monad<Error>
-                              [(~ g!key) (;;keys (~ g!input))]
+                              [(~ g!key) (;;fields (~ g!input))]
                               (mapM (~ (' %))
                                     (lambda [(~ g!key)]
                                       (do Monad<Error>
@@ -1026,11 +1075,11 @@
                                      (~ (->Codec//decode (` ((~ (type;to-ast :x:)) (~@ g!vars)))))))))]
                #let [.decoder. (case g!vars
                                  #;Nil
-                                 (` (;;shape^ [(~@ (List/map product;right pattern-matching))]))
+                                 (` (;;shape [(~@ (List/map product;right pattern-matching))]))
 
                                  _
                                  (` (lambda [(~@ g!vars)]
-                                      (;;shape^ [(~@ (List/map product;right pattern-matching))]))))]]
+                                      (;;shape [(~@ (List/map product;right pattern-matching))]))))]]
               (wrap (` (: (~ :x:+) (~ .decoder.))))
               ))
           (do @
@@ -1046,8 +1095,26 @@
           ))))
 
 (syntax: #export (Codec<JSON,?> :x:)
+  {#;doc (doc "A macro for automatically producing JSON codecs."
+              (type: Variant
+                (#Case0 Bool)
+                (#Case1 Int)
+                (#Case2 Real))
+
+              (type: Record
+                {#unit Unit
+                 #bool Bool
+                 #int Int
+                 #real Real
+                 #char Char
+                 #text Text
+                 #maybe (Maybe Int)
+                 #list (List Int)
+                 #variant Variant
+                 #tuple [Int Real Char]})
+
+              (derived: (Codec<JSON,?> Record)))}
   (wrap (list (` (: (Codec JSON (~ :x:))
-                    (struct
-                     (def: (~ (' encode)) (Codec<JSON,?>//encode (~ :x:)))
-                     (def: (~ (' decode)) (Codec<JSON,?>//decode (~ :x:)))
-                     ))))))
+                    (struct (def: (~ (' encode)) (Codec<JSON,?>//encode (~ :x:)))
+                            (def: (~ (' decode)) (Codec<JSON,?>//decode (~ :x:)))
+                            ))))))
-- 
cgit v1.2.3