Ported tests for format-related modules.

1 files changed, 51 insertions, 43 deletions

diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index a213fa1d0..b68101e3c 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -5,7 +5,7 @@
     ["." monad (#+ Monad do)]
     [equivalence (#+ Equivalence)]
     codec
-    ["p" parser (#+ Parser) ("#;." monad)]
+    ["p" parser (#+ Parser) ("#@." monad)]
     ["ex" exception (#+ exception:)]]
    [data
     ["." bit]
@@ -14,12 +14,12 @@
     ["." sum]
     ["." product]
     [number
-     ["." frac ("#;." decimal)]]
-    ["." text ("#;." equivalence monoid)
+     ["." frac ("#@." decimal)]]
+    ["." text ("#@." equivalence monoid)
      ["l" lexer]]
     [collection
-     ["." list ("#;." fold monad)]
-     ["." row (#+ Row row) ("#;." monad)]
+     ["." list ("#@." fold monad)]
+     ["." row (#+ Row row) ("#@." monad)]
      ["." dictionary (#+ Dictionary)]]]
    ["." macro (#+ monad with-gensyms)
     ["s" syntax (#+ syntax:)]
@@ -76,7 +76,7 @@
       (wrap (list (` (: JSON #Null))))
 
       [_ (#.Tuple members)]
-      (wrap (list (` (: JSON (#Array ((~! row) (~+ (list;map wrapper members))))))))
+      (wrap (list (` (: JSON (#Array ((~! row) (~+ (list@map wrapper members))))))))
 
       [_ (#.Record pairs)]
       (do ..monad
@@ -102,7 +102,7 @@
     (#error.Success (dictionary.keys obj))
 
     _
-    (#error.Failure ($_ text;compose "Cannot get the fields of a non-object."))))
+    (#error.Failure ($_ text@compose "Cannot get the fields of a non-object."))))
 
 (def: #export (get key json)
   {#.doc "A JSON object field getter."}
@@ -114,10 +114,10 @@
       (#error.Success value)
 
       #.None
-      (#error.Failure ($_ text;compose "Missing field '" key "' on object.")))
+      (#error.Failure ($_ text@compose "Missing field '" key "' on object.")))
 
     _
-    (#error.Failure ($_ text;compose "Cannot get field '" key "' of a non-object."))))
+    (#error.Failure ($_ text@compose "Cannot get field '" key "' of a non-object."))))
 
 (def: #export (set key value json)
   {#.doc "A JSON object field setter."}
@@ -127,18 +127,18 @@
     (#error.Success (#Object (dictionary.put key value obj)))
 
     _
-    (#error.Failure ($_ text;compose "Cannot set field '" key "' of a non-object."))))
+    (#error.Failure ($_ text@compose "Cannot set field '" key "' of a non-object."))))
 
 (do-template [<name> <tag> <type> <desc>]
   [(def: #export (<name> key json)
-     {#.doc (code.text ($_ text;compose "A JSON object field getter for " <desc> "."))}
+     {#.doc (code.text ($_ text@compose "A JSON object field getter for " <desc> "."))}
      (-> Text JSON (Error <type>))
      (case (get key json)
        (#error.Success (<tag> value))
        (#error.Success value)
 
        (#error.Success _)
-       (#error.Failure ($_ text;compose "Wrong value type at key: " key))
+       (#error.Failure ($_ text@compose "Wrong value type at key: " key))
 
        (#error.Failure error)
        (#error.Failure error)))]
@@ -165,7 +165,7 @@
 
       [(#Array xs) (#Array ys)]
       (and (n/= (row.size xs) (row.size ys))
-           (list;fold (function (_ idx prev)
+           (list@fold (function (_ idx prev)
                         (and prev
                              (maybe.default #0
                                             (do maybe.monad
@@ -177,7 +177,7 @@
       
       [(#Object xs) (#Object ys)]
       (and (n/= (dictionary.size xs) (dictionary.size ys))
-           (list;fold (function (_ [xk xv] prev)
+           (list@fold (function (_ [xk xv] prev)
                         (and prev
                              (case (dictionary.get xk ys)
                                #.None   #0
@@ -208,16 +208,16 @@
 
 (def: (show-array show-json elems)
   (-> (-> JSON Text) (-> Array Text))
-  ($_ text;compose "["
-      (|> elems (row;map show-json) row.to-list (text.join-with ","))
+  ($_ text@compose "["
+      (|> elems (row@map show-json) row.to-list (text.join-with ","))
       "]"))
 
 (def: (show-object show-json object)
   (-> (-> JSON Text) (-> Object Text))
-  ($_ text;compose "{"
+  ($_ text@compose "{"
       (|> object
           dictionary.entries
-          (list;map (function (_ [key value]) ($_ text;compose (show-string key) ":" (show-json value))))
+          (list@map (function (_ [key value]) ($_ text@compose (show-string key) ":" (show-json value))))
           (text.join-with ","))
       "}"))
 
@@ -241,7 +241,7 @@
 
 (exception: #export (unconsumed-input {input (List JSON)})
   (|> input
-      (list;map show-json)
+      (list@map show-json)
       (text.join-with text.new-line)))
 
 (exception: #export (empty-input)
@@ -279,7 +279,7 @@
 
 (do-template [<name> <type> <tag> <desc>]
   [(def: #export <name>
-     {#.doc (code.text ($_ text;compose "Reads a JSON value as " <desc> "."))}
+     {#.doc (code.text ($_ text@compose "Reads a JSON value as " <desc> "."))}
      (Reader <type>)
      (do p.monad
        [head any]
@@ -288,7 +288,7 @@
          (wrap value)
 
          _
-         (fail ($_ text;compose "JSON value is not " <desc> ".")))))]
+         (fail ($_ text@compose "JSON value is not " <desc> ".")))))]
 
   [null    Any  #Null    "null"]
   [boolean Bit  #Boolean "boolean"]
@@ -298,7 +298,7 @@
 
 (do-template [<test> <check> <type> <eq> <encoder> <tag> <desc>]
   [(def: #export (<test> test)
-     {#.doc (code.text ($_ text;compose "Asks whether a JSON value is a " <desc> "."))}
+     {#.doc (code.text ($_ text@compose "Asks whether a JSON value is a " <desc> "."))}
      (-> <type> (Reader Bit))
      (do p.monad
        [head any]
@@ -307,10 +307,10 @@
          (wrap (:: <eq> = test value))
 
          _
-         (fail ($_ text;compose "JSON value is not " <desc> ".")))))
+         (fail ($_ text@compose "JSON value is not " <desc> ".")))))
 
    (def: #export (<check> test)
-     {#.doc (code.text ($_ text;compose "Ensures a JSON value is a " <desc> "."))}
+     {#.doc (code.text ($_ text@compose "Ensures a JSON value is a " <desc> "."))}
      (-> <type> (Reader Any))
      (do p.monad
        [head any]
@@ -318,10 +318,10 @@
          (<tag> value)
          (if (:: <eq> = test value)
            (wrap [])
-           (fail ($_ text;compose "Value mismatch: " (<encoder> test) " =/= " (<encoder> value))))
+           (fail ($_ text@compose "Value mismatch: " (<encoder> test) " =/= " (<encoder> value))))
 
          _
-         (fail ($_ text;compose "JSON value is not a " <desc> ".")))))]
+         (fail ($_ text@compose "JSON value is not a " <desc> ".")))))]
 
   [boolean? boolean! Bit  bit.equivalence  encode-boolean           #Boolean "boolean"]
   [number?  number!  Frac frac.equivalence (:: frac.decimal encode) #Number  "number"]
@@ -353,7 +353,7 @@
           (fail (ex.construct unconsumed-input remainder))))
 
       _
-      (fail (text;compose "JSON value is not an array: " (show-json head))))))
+      (fail (text@compose "JSON value is not an array: " (show-json head))))))
 
 (def: #export (object parser)
   {#.doc "Parses a JSON object. Use this with the 'field' combinator."}
@@ -364,7 +364,7 @@
       (#Object kvs)
       (case (p.run (|> kvs
                        dictionary.entries
-                       (list;map (function (_ [key value])
+                       (list@map (function (_ [key value])
                                    (list (#String key) value)))
                        list.concat)
                    parser)
@@ -380,7 +380,7 @@
           (fail (ex.construct unconsumed-input remainder))))
       
       _
-      (fail (text;compose "JSON value is not an object: " (show-json head))))))
+      (fail (text@compose "JSON value is not an object: " (show-json head))))))
 
 (def: #export (field field-name parser)
   {#.doc "Parses a field inside a JSON object. Use this inside the 'object' combinator."}
@@ -388,7 +388,7 @@
   (function (recur inputs)
     (case inputs
       (^ (list& (#String key) value inputs'))
-      (if (text;= key field-name)
+      (if (text@= key field-name)
         (case (p.run (list value) parser)
           (#error.Success [#.Nil output])
           (#error.Success [inputs' output])
@@ -409,6 +409,14 @@
       _
       (ex.throw unconsumed-input inputs))))
 
+(def: #export dictionary
+  {#.doc "Parses a dictionary-like JSON object."}
+  (All [a] (-> (Reader a) (Reader (Dictionary Text a))))
+  (|>> (p.and ..string)
+       p.some
+       object
+       (p@map (dictionary.from-list text.hash))))
+
 ############################################################
 ############################################################
 ############################################################
@@ -456,8 +464,8 @@
                       [mark (l.one-of "eE")
                        signed?' (l.this? "-")
                        offset (l.many l.decimal)]
-                      (wrap ($_ text;compose mark (if signed?' "-" "") offset))))]
-    (case (frac;decode ($_ text;compose (if signed? "-" "") digits "." decimals exp))
+                      (wrap ($_ text@compose mark (if signed?' "-" "") offset))))]
+    (case (frac@decode ($_ text@compose (if signed? "-" "") digits "." decimals exp))
       (#error.Failure message)
       (p.fail message)
       
@@ -468,32 +476,32 @@
   (l.Lexer Text)
   ($_ p.either
       (p.after (l.this "\t")
-               (p;wrap text.tab))
+               (p@wrap text.tab))
       (p.after (l.this "\b")
-               (p;wrap text.back-space))
+               (p@wrap text.back-space))
       (p.after (l.this "\n")
-               (p;wrap text.new-line))
+               (p@wrap text.new-line))
       (p.after (l.this "\r")
-               (p;wrap text.carriage-return))
+               (p@wrap text.carriage-return))
       (p.after (l.this "\f")
-               (p;wrap text.form-feed))
-      (p.after (l.this (text;compose "\" text.double-quote))
-               (p;wrap text.double-quote))
+               (p@wrap text.form-feed))
+      (p.after (l.this (text@compose "\" text.double-quote))
+               (p@wrap text.double-quote))
       (p.after (l.this "\\")
-               (p;wrap "\"))))
+               (p@wrap "\"))))
 
 (def: string~
   (l.Lexer String)
   (<| (l.enclosed [text.double-quote text.double-quote])
       (loop [_ []])
       (do p.monad
-        [chars (l.some (l.none-of (text;compose "\" text.double-quote)))
+        [chars (l.some (l.none-of (text@compose "\" text.double-quote)))
          stop l.peek])
-      (if (text;= "\" stop)
+      (if (text@= "\" stop)
         (do @
           [escaped escaped~
            next-chars (recur [])]
-          (wrap ($_ text;compose chars escaped next-chars)))
+          (wrap ($_ text@compose chars escaped next-chars)))
         (wrap chars))))
 
 (def: (kv~ json~)