From b802e8efe275ee75473b755429b1805c5c83abbd Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 1 Aug 2017 00:12:40 -0400 Subject: - Broken down lux/data/format/json module into smaller family of modules. - Re-implemented JSON parsing in terms of lux/control/parser. --- stdlib/source/lux/data/format/json.lux | 910 +------------------------- stdlib/source/lux/data/format/json/codec.lux | 536 +++++++++++++++ stdlib/source/lux/data/format/json/reader.lux | 177 +++++ stdlib/source/lux/data/text/format.lux | 5 +- stdlib/test/test/lux/data/format/json.lux | 69 +- 5 files changed, 769 insertions(+), 928 deletions(-) create mode 100644 stdlib/source/lux/data/format/json/codec.lux create mode 100644 stdlib/source/lux/data/format/json/reader.lux (limited to 'stdlib') diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index c4951f188..379e3b23b 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Functionality for reading, generating and processing values in the JSON format. +(;module: {#;doc "Functionality for generating and processing values in the JSON format. For more information, please see: http://www.json.org/"} lux @@ -51,20 +51,15 @@ [Object (d;Dict String JSON)] ) -(type: #export (Parser a) - {#;doc "JSON parsers."} - (-> JSON (R;Result a))) - -(type: #export (Gen a) - {#;doc "JSON generators."} - (-> a JSON)) +(type: #export (Reader a) + {#;doc "JSON reader."} + (p;Parser (List JSON) a)) ## [Syntax] (syntax: #export (json token) - {#;doc (doc "A way to produce JSON literals." + {#;doc (doc "A simple way to produce JSON literals." (json true) - (json 123) - (json 456.78) + (json 123.456) (json "Some text") (json #null) (json ["this" "is" "an" "array"]) @@ -77,7 +72,6 @@ [_ ( value)] (wrap (list (` (: JSON ( (~ ( value)))))))) ([#;Bool code;bool #Boolean] - [#;Int (|>. int-to-real code;real) #Number] [#;Real code;real #Number] [#;Text code;text #String]) @@ -104,44 +98,6 @@ (wrap (list token)) ))) -## [Values] -(def: #hidden (show-null _) (-> Null Text) "null") -(do-template [ ] - [(def: (-> Text) )] - - [show-boolean Boolean (:: bool;Codec encode)] - [show-number Number (:: number;Codec encode)] - [show-string String text;encode]) - -(def: (show-array show-json elems) - (-> (-> JSON Text) (-> Array Text)) - ($_ text/append "[" - (|> elems (Vector/map show-json) vector;to-list (text;join-with ",")) - "]")) - -(def: (show-object show-json object) - (-> (-> JSON Text) (-> Object Text)) - ($_ text/append "{" - (|> object - d;entries - (L/map (function [[key value]] ($_ text/append (show-string key) ":" (show-json value)))) - (text;join-with ",")) - "}")) - -(def: (show-json json) - (-> JSON Text) - (case json - (^template [ ] - ( value) - ( value)) - ([#Null show-null] - [#Boolean show-boolean] - [#Number show-number] - [#String show-string] - [#Array (show-array show-json)] - [#Object (show-object show-json)]) - )) - (def: #export null {#;doc "The null JSON value."} JSON @@ -167,10 +123,10 @@ (#R;Success value) #;None - (#R;Error ($_ text/append "Missing field " (show-string key) " on object."))) + (#R;Error ($_ text/append "Missing field \"" key "\" on object."))) _ - (#R;Error ($_ text/append "Cannot get field " (show-string key) " of a non-object.")))) + (#R;Error ($_ text/append "Cannot get field \"" key "\" of a non-object.")))) (def: #export (set key value json) {#;doc "A JSON object field setter."} @@ -180,7 +136,7 @@ (#R;Success (#Object (d;put key value obj))) _ - (#R;Error ($_ text/append "Cannot set field " (show-string key) " of a non-object.")))) + (#R;Error ($_ text/append "Cannot set field \"" key "\" of a non-object.")))) (do-template [ ] [(def: #export ( key json) @@ -191,7 +147,7 @@ (#R;Success value) (#R;Success _) - (#R;Error ($_ text/append "Wrong value type at key " (show-string key))) + (#R;Error ($_ text/append "Wrong value type at key: " key)) (#R;Error error) (#R;Error error)))] @@ -206,404 +162,24 @@ (do-template [ ] [(def: #export ( value) {#;doc (#;TextA ($_ text/append "A JSON generator for " "."))} - (Gen ) + (-> JSON) ( value))] - [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"] + [boolean Boolean #Boolean "booleans"] + [number Number #Number "numbers"] + [string String #String "strings"] + [array Array #Array "arrays"] + [object Object #Object "objects"] ) -(def: #export (gen-nullable gen) +(def: #export (nullable writer) {#;doc "Builds a JSON generator for potentially inexistent values."} - (All [a] (-> (Gen a) (Gen (Maybe a)))) + (All [a] (-> (-> a JSON) (-> (Maybe a) JSON))) (function [elem] (case elem #;None #Null - (#;Some value) (gen value)))) - -## Lexers -(def: space~ - (l;Lexer Text) - (l;some l;space)) - -(def: data-sep - (l;Lexer [Text Unit Text]) - ($_ p;seq space~ (l;this ",") space~)) - -(def: null~ - (l;Lexer Null) - (do p;Monad - [_ (l;this "null")] - (wrap []))) - -(do-template [ ] - [(def: - (l;Lexer Boolean) - (do p;Monad - [_ (l;this )] - (wrap )))] - - [t~ "true" true] - [f~ "false" false] - ) - -(def: boolean~ - (l;Lexer Boolean) - (p;either t~ f~)) - -(def: number~ - (l;Lexer Number) - (do p;Monad - [signed? (l;this? "-") - digits (l;many l;decimal) - decimals (p;default "0" - (do @ - [_ (l;this ".")] - (l;many l;decimal))) - exp (p;default "" - (do @ - [mark (l;one-of "eE") - signed?' (l;this? "-") - offset (l;many l;decimal)] - (wrap ($_ text/append mark (if signed?' "-" "") offset))))] - (case (real/decode ($_ text/append (if signed? "-" "") digits "." decimals exp)) - (#R;Error message) - (p;fail message) - - (#R;Success value) - (wrap value)))) - -(def: escaped~ - (l;Lexer Text) - ($_ p;either - (p;after (l;this "\\t") (p/wrap "\t")) - (p;after (l;this "\\b") (p/wrap "\b")) - (p;after (l;this "\\n") (p/wrap "\n")) - (p;after (l;this "\\r") (p/wrap "\r")) - (p;after (l;this "\\f") (p/wrap "\f")) - (p;after (l;this "\\\"") (p/wrap "\"")) - (p;after (l;this "\\\\") (p/wrap "\\")))) - -(def: string~ - (l;Lexer String) - (<| (l;enclosed ["\"" "\""]) - (loop [_ []] - (do p;Monad - [chars (l;some (l;none-of "\\\"")) - stop l;peek] - (if (text/= "\\" stop) - (do @ - [escaped escaped~ - next-chars (recur [])] - (wrap ($_ text/append chars escaped next-chars))) - (wrap chars)))))) - -(def: (kv~ json~) - (-> (-> Unit (l;Lexer JSON)) (l;Lexer [String JSON])) - (do p;Monad - [key string~ - _ space~ - _ (l;this ":") - _ space~ - value (json~ [])] - (wrap [key value]))) - -(do-template [ ] - [(def: ( json~) - (-> (-> Unit (l;Lexer JSON)) (l;Lexer )) - (do p;Monad - [_ (l;this ) - _ space~ - elems (p;sep-by data-sep ) - _ space~ - _ (l;this )] - (wrap ( elems))))] - - [array~ Array "[" "]" (json~ []) vector;from-list] - [object~ Object "{" "}" (kv~ json~) (d;from-list text;Hash)] - ) - -(def: (json~' _) - (-> Unit (l;Lexer JSON)) - ($_ p;alt null~ boolean~ number~ string~ (array~ json~') (object~ json~'))) - -## [Structures] -(struct: #export _ (Functor Parser) - (def: (map f ma) - (function [json] - (case (ma json) - (#R;Error msg) - (#R;Error msg) - - (#R;Success a) - (#R;Success (f a)))))) - -(struct: #export _ (Applicative Parser) - (def: functor Functor) - - (def: (wrap x json) - (#R;Success x)) - - (def: (apply ff fa) - (function [json] - (case (ff json) - (#R;Success f) - (case (fa json) - (#R;Success a) - (#R;Success (f a)) - - (#R;Error msg) - (#R;Error msg)) - - (#R;Error msg) - (#R;Error msg))))) - -(struct: #export _ (Monad Parser) - (def: applicative Applicative) - - (def: (join mma) - (function [json] - (case (mma json) - (#R;Error msg) - (#R;Error msg) - - (#R;Success ma) - (ma json))))) - -## [Values] -## Syntax -(do-template [
]
-  [(def: #export ( json)
-     {#;doc (#;TextA ($_ text/append "Reads a JSON value as "  "."))}
-     (Parser )
-     (case json
-       ( value)
-       (#R;Success (
 value))
-
-       _
-       (#R;Error ($_ text/append "JSON value is not "  ": " (show-json json)))))]
-
-  [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 [       
]
-  [(def: #export ( test json)
-     {#;doc (#;TextA ($_ text/append "Asks whether a JSON value is a "  "."))}
-     (->  (Parser Bool))
-     (case json
-       ( value)
-       (#R;Success (::  = test (
 value)))
-
-       _
-       (#R;Error ($_ text/append "JSON value is not a "  ": " (show-json json)))))
-
-   (def: #export ( test json)
-     {#;doc (#;TextA ($_ text/append "Ensures a JSON value is a "  "."))}
-     (->  (Parser Unit))
-     (case json
-       ( value)
-       (let [value (
 value)]
-         (if (::  = test value)
-           (#R;Success [])
-           (#R;Error ($_ text/append "Value mismatch: "
-                         ( test) "=/=" ( value)))))
-
-       _
-       (#R;Error ($_ text/append "JSON value is not a "  ": " (show-json json)))))]
-
-  [bool? bool! Bool bool;Eq   (:: bool;Codec encode)   #Boolean "boolean" id]
-  [int?  int!  Int  number;Eq  (:: number;Codec encode)  #Number  "number"  real-to-int]
-  [real? real! Real number;Eq (:: number;Codec encode) #Number  "number"  id]
-  [text? text! Text text;Eq   text;encode                         #String  "string"  id]
-  )
-
-(def: #export (nullable parser)
-  {#;doc "A parser that can handle the presence of null values."}
-  (All [a] (-> (Parser a) (Parser (Maybe a))))
-  (function [json]
-    (case json
-      #Null
-      (#R;Success #;None)
-      
-      _
-      (case (parser json)
-        (#R;Error error)
-        (#R;Error error)
-
-        (#R;Success value)
-        (#R;Success (#;Some value)))
-      )))
-
-(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))))
-  (function [json]
-    (case json
-      (#Array values)
-      (do R;Monad
-        [elems (M;map @ parser (vector;to-list values))]
-        (wrap elems))
-
-      _
-      (#R;Error ($_ text/append "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 (d;Dict String a))))
-  (function [json]
-    (case json
-      (#Object fields)
-      (do R;Monad
-        [kvs (M;map @
-                    (function [[key val']]
-                      (do @
-                        [val (parser val')]
-                        (wrap [key val])))
-                    (d;entries fields))]
-        (wrap (d;from-list text;Hash kvs)))
-
-      _
-      (#R;Error ($_ text/append "JSON value is not an object: " (show-json json))))))
+      (#;Some value) (writer value))))
 
-(def: #export (nth idx parser)
-  {#;doc "Parses an element inside a JSON array."}
-  (All [a] (-> Nat (Parser a) (Parser a)))
-  (function [json]
-    (case json
-      (#Array values)
-      (case (vector;nth idx values)
-        (#;Some value)
-        (case (parser value)
-          (#R;Success output)
-          (#R;Success output)
-
-          (#R;Error error)
-          (#R;Error ($_ text/append "JSON array index [" (nat/encode idx) "]: (" error ") @ " (show-json json))))
-
-        #;None
-        (#R;Error ($_ text/append "JSON array does not have index " (nat/encode idx) " @ " (show-json json))))
-      
-      _
-      (#R;Error ($_ text/append "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)))
-  (function [json]
-    (case (get field-name json)
-      (#;Some value)
-      (case (parser value)
-        (#R;Success output)
-        (#R;Success output)
-
-        (#R;Error error)
-        (#R;Error ($_ text/append "Failed to get JSON object field " (show-string field-name) ": (" error ") @ " (show-json json))))
-
-      (#R;Error _)
-      (#R;Error ($_ text/append "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)
-  (function [json]
-    (#R;Success json)))
-
-(def: #export (seq pa pb)
-  {#;doc "Sequencing combinator."}
-  (All [a b] (-> (Parser a) (Parser b) (Parser [a b])))
-  (do Monad
-    [=a pa
-     =b pb]
-    (wrap [=a =b])))
-
-(def: #export (alt pa pb)
-  {#;doc "Heterogeneous alternative combinator."}
-  (All [a b] (-> (Parser a) (Parser b) (Parser (| a b))))
-  (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 message1)
-        (#R;Error message0)))))
-
-(def: #export (either pl pr)
-  {#;doc "Homogeneous alternative combinator."}
-  (All [a] (-> (Parser a) (Parser a) (Parser a)))
-  (function [json]
-    (case (pl json)
-      (#R;Success x)
-      (#R;Success x)
-
-      _
-      (pr json))))
-
-(def: #export (opt p)
-  {#;doc "Optionality combinator."}
-  (All [a]
-    (-> (Parser a) (Parser (Maybe a))))
-  (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)
-  {#;doc "Only parses a JSON if it passes a test (which is also a parser)."}
-  (All [a] (-> (Parser Unit) (Parser a) (Parser a)))
-  (function [json]
-    (case (test json)
-      (#R;Success _)
-      (parser json)
-
-      (#R;Error error)
-      (#R;Error error))))
-
-(def: #export (array-size! size)
-  {#;doc "Ensures a JSON array has the specified size."}
-  (-> Nat (Parser Unit))
-  (function [json]
-    (case json
-      (#Array parts)
-      (if (n.= size (vector;size parts))
-        (#R;Success [])
-        (#R;Error ($_ text/append "JSON array does no have size " (nat/encode size) " " (show-json json))))
-
-      _
-      (#R;Error ($_ text/append "JSON value is not an array: " (show-json 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))
-  (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 wanted-fields)
-                              actual-fields))
-          (#R;Success [])
-          (#R;Error ($_ text/append "JSON object has wrong field-set. Expected: [" (text;join-with ", " wanted-fields) "]. Actual: [" (text;join-with ", " actual-fields) "]"))))
-
-      _
-      (#R;Error ($_ text/append "JSON value is not an object: " (show-json json))))))
-
-## [Structures]
 (struct: #export _ (Eq JSON)
   (def: (= x y)
     (case [x y]
@@ -641,451 +217,3 @@
       
       _
       false)))
-
-(struct: #export _ (Codec Text JSON)
-  (def: encode show-json)
-  (def: decode (function [input] (l;run input (json~' [])))))
-
-## [Syntax]
-(type: Shape
-  (#ArrayShape (List Code))
-  (#ObjectShape (List [Text Code])))
-
-(def: _shape^
-  (s;Syntax Shape)
-  (p;alt (s;tuple (p;some s;any))
-         (s;record (p;some (p;seq s;text s;any)))))
-
-(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)
-          parsers (|> parts
-                      (list;zip2 (list;indices array-size))
-                      (L/map (function [[idx parser]]
-                               (` (nth (~ (code;nat idx)) (~ parser))))))]
-      (wrap (list (` ($_ seq (~@ parsers))))))
-
-    (#ObjectShape kvs)
-    (let [fields (L/map product;left kvs)
-          parsers (L/map (function [[field-name parser]]
-                           (` (field (~ (code;text field-name)) (~ parser))))
-                         kvs)]
-      (wrap (list (` ($_ seq (~@ parsers))))))
-    ))
-
-(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)
-          parsers (|> parts
-                      (list;zip2 (list;indices array-size))
-                      (L/map (function [[idx parser]]
-                               (` (nth (~ (code;nat idx)) (~ parser))))))]
-      (wrap (list (` (ensure (array-size! (~ (code;nat array-size)))
-                             ($_ seq (~@ parsers)))))))
-
-    (#ObjectShape kvs)
-    (let [fields (L/map product;left kvs)
-          parsers (L/map (function [[field-name parser]]
-                           (` (field (~ (code;text field-name)) (~ parser))))
-                         kvs)]
-      (wrap (list (` (ensure (object-fields! (list (~@ (L/map code;text fields))))
-                             ($_ seq (~@ parsers)))))))
-    ))
-
-## [Polytypism]
-(def: #hidden _map_
-  (All [a b] (-> (-> a b) (List a) (List b)))
-  L/map)
-
-(def: #hidden (rec-encode non-rec)
-  (All [a] (-> (-> (-> a JSON)
-                   (-> a JSON))
-               (-> a JSON)))
-  (function [input]
-    (non-rec (rec-encode non-rec) input)))
-
-(poly: #hidden (Codec//encode env :x:)
-  (let [->Codec//encode (: (-> Code Code)
-                           (function [.type.] (` (-> (~ .type.) JSON))))]
-    (with-expansions
-      [ (do-template [  ]
-                 [(do @ [_ ( :x:)] (wrap (` (: (~ (->Codec//encode (` ))) ))))]
-
-                 [Unit poly;unit (function [(~ (code;symbol ["" "0"]))] #Null)]
-                 [Bool poly;bool ;;gen-boolean]
-                 [Int  poly;int  (|>. ;int-to-real ;;gen-number)]
-                 [Real poly;real ;;gen-number]
-                 [Text poly;text ;;gen-string])]
-      ($_ macro;either
-          
-          (with-gensyms [g!input g!key g!val]
-            (do @
-              [[:key: :val:] (poly;apply-2 (ident-for d;Dict) :x:)
-               _ (poly;text :key:)
-               .val. (Codec//encode env :val:)]
-              (wrap (` (: (~ (->Codec//encode (poly;to-ast env :x:)))
-                          (function [(~ g!input)]
-                            (|> (~ g!input)
-                                d;entries
-                                (;;_map_ (: (-> [Text (~ (poly;to-ast env :val:))]
-                                                [Text JSON])
-                                            (function [[(~ g!key) (~ g!val)]]
-                                              [(~ g!key)
-                                               ((~ .val.) (~ g!val))])))
-                                (d;from-list text;Hash)
-                                #;;Object))
-                          )))))
-          (do @
-            [:sub: (poly;apply-1 (ident-for ;Maybe) :x:)
-             .sub. (Codec//encode env :sub:)]
-            (wrap (` (: (~ (->Codec//encode (poly;to-ast env :x:)))
-                        (;;gen-nullable (~ .sub.))))))
-          (do @
-            [:sub: (poly;apply-1 (ident-for ;List) :x:)
-             .sub. (Codec//encode env :sub:)]
-            (wrap (` (: (~ (->Codec//encode (poly;to-ast env :x:)))
-                        (|>. (;;_map_ (~ .sub.)) vector;from-list ;;gen-array)))))
-          (with-gensyms [g!type-fun g!case g!input]
-            (do @
-              [members (poly;sum+ :x:)
-               pattern-matching (M;map @
-                                       (function [[tag :case:]]
-                                         (do @
-                                           [g!encode (Codec//encode env :case:)]
-                                           (wrap (list (` ((~ (code;nat tag)) (~ g!case)))
-                                                       (` (;;json [(~ (code;int (nat-to-int tag)))
-                                                                   ((~ g!encode) (~ g!case))]))))))
-                                       (list;enumerate members))]
-              (wrap (` (: (~ (->Codec//encode (poly;to-ast env :x:)))
-                          (function [(~ g!input)]
-                            (case (~ g!input)
-                              (~@ (L/join pattern-matching)))))))))
-          (with-gensyms [g!type-fun g!case g!input]
-            (do @
-              [[g!vars members] (poly;variant :x:)
-               #let [new-env (poly;extend-env [:x: g!type-fun]
-                                              (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
-                                              env)]
-               pattern-matching (M;map @
-                                       (function [[name :case:]]
-                                         (do @
-                                           [#let [tag (code;tag name)]
-                                            encoder (Codec//encode new-env :case:)]
-                                           (wrap (list (` ((~ tag) (~ g!case)))
-                                                       (` (;;json [(~ (code;text (product;right name)))
-                                                                   ((~ encoder) (~ g!case))]))))))
-                                       members)
-               #let [:x:+ (case g!vars
-                            #;Nil
-                            (->Codec//encode (poly;to-ast env :x:))
-
-                            _
-                            (` (All (~ g!type-fun) [(~@ g!vars)]
-                                 (-> (~@ (L/map ->Codec//encode g!vars))
-                                     (~ (->Codec//encode (` ((~ (poly;to-ast env :x:)) (~@ g!vars)))))))))]]
-              (wrap (` (: (~ :x:+)
-                          (function [(~@ g!vars) (~ g!input)]
-                            (case (~ g!input)
-                              (~@ (L/join pattern-matching))))
-                          )))))
-          (with-gensyms [g!type-fun g!case g!input]
-            (do @
-              [[g!vars members] (poly;record :x:)
-               #let [new-env (poly;extend-env [:x: g!type-fun]
-                                              (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
-                                              env)]
-               synthesis (M;map @
-                                (function [[name :slot:]]
-                                  (do @
-                                    [encoder (Codec//encode new-env :slot:)]
-                                    (wrap [(` (~ (code;text (product;right name))))
-                                           (` ((~ encoder) (get@ (~ (code;tag name)) (~ g!input))))])))
-                                members)
-               #let [:x:+ (case g!vars
-                            #;Nil
-                            (->Codec//encode (poly;to-ast env :x:))
-
-                            _
-                            (` (All (~ g!type-fun) [(~@ g!vars)]
-                                 (-> (~@ (L/map ->Codec//encode g!vars))
-                                     (~ (->Codec//encode (` ((~ (poly;to-ast env :x:)) (~@ g!vars)))))))))]]
-              (wrap (` (: (~ :x:+)
-                          (function [(~@ g!vars) (~ g!input)]
-                            (;;json (~ (code;record synthesis))))
-                          )))))
-          (with-gensyms [g!type-fun g!case]
-            (do @
-              [[g!vars members] (poly;tuple :x:)
-               #let [new-env (poly;extend-env [:x: g!type-fun]
-                                              (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
-                                              env)]
-               pattern-matching (M;map @
-                                       (function [:member:]
-                                         (do @
-                                           [g!member (macro;gensym "g!member")
-                                            encoder (Codec//encode new-env :member:)]
-                                           (wrap [g!member encoder])))
-                                       members)
-               #let [:x:+ (case g!vars
-                            #;Nil
-                            (->Codec//encode (poly;to-ast env :x:))
-
-                            _
-                            (` (All (~ g!type-fun) [(~@ g!vars)]
-                                 (-> (~@ (L/map ->Codec//encode g!vars))
-                                     (~ (->Codec//encode (` ((~ (poly;to-ast env :x:)) (~@ g!vars)))))))))]
-               #let [.tuple. (` [(~@ (L/map product;left pattern-matching))])]]
-              (wrap (` (: (~ :x:+)
-                          (function [(~@ g!vars) (~ .tuple.)]
-                            (;;json [(~@ (L/map (function [[g!member g!encoder]]
-                                                  (` ((~ g!encoder) (~ g!member))))
-                                                pattern-matching))]))
-                          )))
-              ))
-          ## Type recursion
-          (with-gensyms [g!rec]
-            (do @
-              [:non-rec: (poly;recursive :x:)
-               #let [new-env (poly;extend-env [:x: g!rec] (list [:x: (` (;undefined))]) env)]
-               .non-rec. (Codec//encode new-env :non-rec:)]
-              (wrap (` (: (~ (poly;gen-type new-env ->Codec//encode g!rec (list) :x:))
-                          (rec-encode (;function [(~ g!rec)]
-                                        (~ .non-rec.))))))))
-          (poly;self env :x:)
-          (poly;recursion env :x:)
-          ## Type applications
-          (do @
-            [[:func: :args:] (poly;apply :x:)
-             .func. (Codec//encode env :func:)
-             .args. (M;map @ (Codec//encode env) :args:)]
-            (wrap (` (: (~ (->Codec//encode (poly;to-ast env :x:)))
-                        ((~ .func.) (~@ .args.))))))
-          ## Bound type-vars
-          (poly;bound env :x:)
-          ## If all else fails...
-          (macro;fail ($_ text/append "Cannot create JSON encoder for: " (type;to-text :x:)))
-          ))))
-
-(def: #hidden (rec-decode non-rec)
-  (All [a] (-> (-> (-> JSON (R;Result a))
-                   (-> JSON (R;Result a)))
-               (-> JSON (R;Result a))))
-  (function [input]
-    (non-rec (rec-decode non-rec) input)))
-
-(poly: #hidden (Codec//decode env :x:)
-  (let [->Codec//decode (: (-> Code Code)
-                           (function [.type.] (` (-> JSON (R;Result (~ .type.))))))]
-    (with-expansions
-      [ (do-template [  ]
-                 [(do @ [_ ( :x:)] (wrap (` (: (~ (->Codec//decode (` ))) ))))]
-
-                 [Unit poly;unit ;;unit]
-                 [Bool poly;bool ;;bool]
-                 [Int  poly;int  ;;int]
-                 [Real poly;real ;;real]
-                 [Text poly;text ;;text])
-        (do-template [  ]
-                   [(do @
-                      [:sub: ( :x:)
-                       .sub. (Codec//decode env :sub:)]
-                      (wrap (` (: (~ (->Codec//decode (poly;to-ast env :x:)))
-                                  ( (~ .sub.))))))]
-
-                   [Maybe (poly;apply-1 (ident-for ;Maybe)) ;;nullable]
-                   [List  (poly;apply-1 (ident-for ;List))  ;;array])]
-      ($_ macro;either
-          
-          (with-gensyms [g!input g!output g!key g!val]
-            (do @
-              [[:key: :val:] (poly;apply-2 (ident-for d;Dict) :x:)
-               _ (poly;text :key:)
-               .val. (Codec//decode env :val:)]
-              (wrap (` (: (~ (->Codec//decode (poly;to-ast env :x:)))
-                          (function [(~ g!input)]
-                            (do R;Monad
-                              [(~ g!key) (;;fields (~ g!input))
-                               (~ g!output) (M;map R;Monad
-                                                   (function [(~ g!key)]
-                                                     (do R;Monad
-                                                       [(~ g!val) (;;get (~ g!key) (~ g!input))
-                                                        (~ g!val) (;;run (~ g!val) (~ .val.))]
-                                                       ((~ (' wrap)) [(~ g!key) (~ g!val)])))
-                                                   (~ g!key))]
-                              ((~' wrap) (d;from-list text;Hash (~ g!output)))))
-                          )))
-              ))
-          
-          (with-gensyms [g!type-fun g!case g!input  g!_]
-            (do @
-              [members (poly;sum+ :x:)
-               pattern-matching (M;map @
-                                       (function [[tag :case:]]
-                                         (do @
-                                           [g!decode (Codec//decode env :case:)]
-                                           (wrap (list (` (do Monad
-                                                            [(~ g!_) (;;nth +0 (;;int! (~ (code;int (nat-to-int tag)))))
-                                                             (~ g!_) (;;nth +1 (~ g!decode))]
-                                                            ((~' wrap) ((~ (code;nat tag)) (~ g!_)))))))))
-                                       (list;enumerate members))]
-              (wrap (` (: (~ (->Codec//decode (poly;to-ast env :x:)))
-                          ($_ ;;either
-                              (~@ (L/join pattern-matching))))))))
-          (with-gensyms [g!type-fun g!_]
-            (do @
-              [[g!vars members] (poly;variant :x:)
-               #let [new-env (poly;extend-env [:x: g!type-fun]
-                                              (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
-                                              env)]
-               pattern-matching (M;map @
-                                       (function [[name :case:]]
-                                         (do @
-                                           [#let [tag (code;tag name)]
-                                            decoder (Codec//decode new-env :case:)]
-                                           (wrap (list (` (do Monad
-                                                            [(~ g!_) (;;nth +0 (;;text! (~ (code;text (product;right name)))))
-                                                             (~ g!_) (;;nth +1 (~ decoder))]
-                                                            ((~ (' wrap)) ((~ tag) (~ g!_)))))))))
-                                       members)
-               #let [:x:+ (case g!vars
-                            #;Nil
-                            (->Codec//decode (poly;to-ast env :x:))
-
-                            _
-                            (` (All (~ g!type-fun) [(~@ g!vars)]
-                                 (-> (~@ (L/map ->Codec//decode g!vars))
-                                     (~ (->Codec//decode (` ((~ (poly;to-ast env :x:)) (~@ g!vars)))))))))
-                     base-parser (` ($_ ;;either
-                                        (~@ (L/join pattern-matching))))
-                     parser (case g!vars
-                              #;Nil
-                              base-parser
-
-                              _
-                              (` (function [(~@ g!vars)] (~ base-parser))))]]
-              (wrap (` (: (~ :x:+) (~ parser))))
-              ))
-          (with-gensyms [g!type-fun g!case g!input]
-            (do @
-              [[g!vars members] (poly;record :x:)
-               #let [new-env (poly;extend-env [:x: g!type-fun]
-                                              (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
-                                              env)]
-               extraction (M;map @
-                                 (function [[name :slot:]]
-                                   (do @
-                                     [#let [g!member (code;symbol ["" (product;right name)])]
-                                      decoder (Codec//decode new-env :slot:)]
-                                     (wrap (list g!member
-                                                 (` (;;get (~ (code;text (product;right name))) (~ g!input)))
-                                                 g!member
-                                                 (` ((~ decoder) (~ g!member)))))))
-                                 members)
-               #let [:x:+ (case g!vars
-                            #;Nil
-                            (->Codec//decode (poly;to-ast env :x:))
-
-                            _
-                            (` (All (~ g!type-fun) [(~@ g!vars)]
-                                 (-> (~@ (L/map ->Codec//decode g!vars))
-                                     (~ (->Codec//decode (` ((~ (poly;to-ast env :x:)) (~@ g!vars)))))))))]]
-              (wrap (` (: (~ :x:+)
-                          (function [(~@ g!vars) (~ g!input)]
-                            (do R;Monad
-                              [(~@ (L/join extraction))]
-                              ((~ (' wrap)) (~ (code;record (L/map (function [[name :slot:]]
-                                                                     [(code;tag name) (code;symbol ["" (product;right name)])])
-                                                                   members))))))
-                          )))))
-          (with-gensyms [g!type-fun g!case g!input]
-            (do @
-              [[g!vars members] (poly;tuple :x:)
-               #let [new-env (poly;extend-env [:x: g!type-fun]
-                                              (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
-                                              env)]
-               pattern-matching (M;map @
-                                       (function [:member:]
-                                         (do @
-                                           [g!member (macro;gensym "g!member")
-                                            decoder (Codec//decode new-env :member:)]
-                                           (wrap [g!member decoder])))
-                                       members)
-               #let [:x:+ (case g!vars
-                            #;Nil
-                            (->Codec//decode (poly;to-ast env :x:))
-
-                            _
-                            (` (All (~ g!type-fun) [(~@ g!vars)]
-                                 (-> (~@ (L/map ->Codec//decode g!vars))
-                                     (~ (->Codec//decode (` ((~ (poly;to-ast env :x:)) (~@ g!vars)))))))))]
-               #let [.decoder. (case g!vars
-                                 #;Nil
-                                 (` (;;shape [(~@ (L/map product;right pattern-matching))]))
-
-                                 _
-                                 (` (function [(~@ g!vars)]
-                                      (;;shape [(~@ (L/map product;right pattern-matching))]))))]]
-              (wrap (` (: (~ :x:+) (~ .decoder.))))
-              ))
-          ## Type recursion
-          (with-gensyms [g!rec]
-            (do @
-              [:non-rec: (poly;recursive :x:)
-               #let [new-env (poly;extend-env [:x: g!rec] (list [:x: (` (;undefined))]) env)]
-               .non-rec. (Codec//decode new-env :non-rec:)]
-              (wrap (` (: (~ (poly;gen-type new-env ->Codec//decode g!rec (list) :x:))
-                          (rec-decode (;function [(~ g!rec)]
-                                        (~ .non-rec.))))))))
-          (poly;self env :x:)
-          (poly;recursion env :x:)
-          ## Type applications
-          (do @
-            [[:func: :args:] (poly;apply :x:)
-             .func. (Codec//decode env :func:)
-             .args. (M;map @ (Codec//decode env) :args:)]
-            (wrap (` (: (~ (->Codec//decode (poly;to-ast env :x:)))
-                        ((~ .func.) (~@ .args.))))))
-          ## Bound type-vars
-          (do @
-            [g!bound (poly;bound env :x:)]
-            (wrap g!bound))
-          ## If all else fails...
-          (macro;fail ($_ text/append "Cannot create JSON decoder for: " (type;to-text :x:)))
-          ))))
-
-(syntax: #export (Codec :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
-                 #text Text
-                 #maybe (Maybe Int)
-                 #list (List Int)
-                 #variant Variant
-                 #tuple [Int Real Text]
-                 #dict (Dict Text Int)})
-
-              (derived: (Codec Record)))}
-  (wrap (list (` (: (Codec JSON (~ :x:))
-                    (struct (def: (~ (' encode)) (Codec//encode (~ :x:)))
-                            (def: (~ (' decode)) (Codec//decode (~ :x:)))
-                            ))))))
diff --git a/stdlib/source/lux/data/format/json/codec.lux b/stdlib/source/lux/data/format/json/codec.lux
new file mode 100644
index 000000000..2bd298419
--- /dev/null
+++ b/stdlib/source/lux/data/format/json/codec.lux
@@ -0,0 +1,536 @@
+(;module: {#;doc "Codecs for values in the JSON format.
+
+                  For more information, please see: http://www.json.org/"}
+  lux
+  (lux (control functor
+                applicative
+                ["M" monad #+ do Monad]
+                [eq #+ Eq]
+                codec
+                ["p" parser "p/" Monad])
+       (data [bool]
+             [text "text/" Eq Monoid]
+             (text ["l" lexer])
+             [number "real/" Codec "nat/" Codec]
+             maybe
+             ["R" result]
+             [sum]
+             [product]
+             (coll [list "L/" Fold Monad]
+                   [vector #+ Vector vector "Vector/" Monad]
+                   ["d" dict]))
+       [macro #+ Monad with-gensyms]
+       (macro ["s" syntax #+ syntax:]
+              [code]
+              [poly #+ poly:])
+       [type]
+       )
+  [.. #+ JSON]
+  [../reader])
+
+## [Values]
+(def: #hidden (show-null _) (-> ..;Null Text) "null")
+(do-template [  ]
+  [(def:  (->  Text) )]
+
+  [show-boolean ..;Boolean (:: bool;Codec encode)]
+  [show-number  ..;Number (:: number;Codec encode)]
+  [show-string  ..;String text;encode])
+
+(def: (show-array show-json elems)
+  (-> (-> JSON Text) (-> ..;Array Text))
+  ($_ text/append "["
+      (|> elems (Vector/map show-json) vector;to-list (text;join-with ","))
+      "]"))
+
+(def: (show-object show-json object)
+  (-> (-> JSON Text) (-> ..;Object Text))
+  ($_ text/append "{"
+      (|> object
+          d;entries
+          (L/map (function [[key value]] ($_ text/append (show-string key) ":" (show-json value))))
+          (text;join-with ","))
+      "}"))
+
+(def: (show-json json)
+  (-> JSON Text)
+  (case json
+    (^template [ ]
+      ( value)
+      ( value))
+    ([#..;Null    show-null]
+     [#..;Boolean show-boolean]
+     [#..;Number  show-number]
+     [#..;String  show-string]
+     [#..;Array   (show-array show-json)]
+     [#..;Object  (show-object show-json)])
+    ))
+
+(def: space~
+  (l;Lexer Text)
+  (l;some l;space))
+
+(def: data-sep
+  (l;Lexer [Text Unit Text])
+  ($_ p;seq space~ (l;this ",") space~))
+
+(def: null~
+  (l;Lexer ..;Null)
+  (do p;Monad
+    [_ (l;this "null")]
+    (wrap [])))
+
+(do-template [  ]
+  [(def: 
+     (l;Lexer ..;Boolean)
+     (do p;Monad
+       [_ (l;this )]
+       (wrap )))]
+
+  [t~ "true"  true]
+  [f~ "false" false]
+  )
+
+(def: boolean~
+  (l;Lexer ..;Boolean)
+  (p;either t~ f~))
+
+(def: number~
+  (l;Lexer ..;Number)
+  (do p;Monad
+    [signed? (l;this? "-")
+     digits (l;many l;decimal)
+     decimals (p;default "0"
+                (do @
+                  [_ (l;this ".")]
+                  (l;many l;decimal)))
+     exp (p;default ""
+           (do @
+             [mark (l;one-of "eE")
+              signed?' (l;this? "-")
+              offset (l;many l;decimal)]
+             (wrap ($_ text/append mark (if signed?' "-" "") offset))))]
+    (case (real/decode ($_ text/append (if signed? "-" "") digits "." decimals exp))
+      (#R;Error message)
+      (p;fail message)
+      
+      (#R;Success value)
+      (wrap value))))
+
+(def: escaped~
+  (l;Lexer Text)
+  ($_ p;either
+      (p;after (l;this "\\t") (p/wrap "\t"))
+      (p;after (l;this "\\b") (p/wrap "\b"))
+      (p;after (l;this "\\n") (p/wrap "\n"))
+      (p;after (l;this "\\r") (p/wrap "\r"))
+      (p;after (l;this "\\f") (p/wrap "\f"))
+      (p;after (l;this "\\\"") (p/wrap "\""))
+      (p;after (l;this "\\\\") (p/wrap "\\"))))
+
+(def: string~
+  (l;Lexer ..;String)
+  (<| (l;enclosed ["\"" "\""])
+      (loop [_ []]
+        (do p;Monad
+          [chars (l;some (l;none-of "\\\""))
+           stop l;peek]
+          (if (text/= "\\" stop)
+            (do @
+              [escaped escaped~
+               next-chars (recur [])]
+              (wrap ($_ text/append chars escaped next-chars)))
+            (wrap chars))))))
+
+(def: (kv~ json~)
+  (-> (-> Unit (l;Lexer JSON)) (l;Lexer [..;String JSON]))
+  (do p;Monad
+    [key string~
+     _ space~
+     _ (l;this ":")
+     _ space~
+     value (json~ [])]
+    (wrap [key value])))
+
+(do-template [     ]
+  [(def: ( json~)
+     (-> (-> Unit (l;Lexer JSON)) (l;Lexer ))
+     (do p;Monad
+       [_ (l;this )
+        _ space~
+        elems (p;sep-by data-sep )
+        _ space~
+        _ (l;this )]
+       (wrap ( elems))))]
+
+  [array~  ..;Array  "[" "]" (json~ [])  vector;from-list]
+  [object~ ..;Object "{" "}" (kv~ json~) (d;from-list text;Hash)]
+  )
+
+(def: (json~' _)
+  (-> Unit (l;Lexer JSON))
+  ($_ p;alt null~ boolean~ number~ string~ (array~ json~') (object~ json~')))
+
+(struct: #export _ (Codec Text JSON)
+  (def: encode show-json)
+  (def: decode (function [input] (l;run input (json~' [])))))
+
+## [Polytypism]
+(def: #hidden _map_
+  (All [a b] (-> (-> a b) (List a) (List b)))
+  L/map)
+
+(def: tag
+  (-> Nat Real)
+  (|>. nat-to-int int-to-real))
+
+(def: #hidden (rec-encode non-rec)
+  (All [a] (-> (-> (-> a JSON)
+                   (-> a JSON))
+               (-> a JSON)))
+  (function [input]
+    (non-rec (rec-encode non-rec) input)))
+
+(poly: #hidden (Codec//encode env :x:)
+  (let [->Codec//encode (: (-> Code Code)
+                           (function [.type.] (` (-> (~ .type.) ..;JSON))))]
+    (with-expansions
+      [ (do-template [  ]
+                 [(do @ [_ ( :x:)] (wrap (` (: (~ (->Codec//encode (` ))) ))))]
+
+                 [Unit poly;unit (function [(~ (code;symbol ["" "0"]))] #..;Null)]
+                 [Bool poly;bool ..;boolean]
+                 [Real poly;real ..;number]
+                 [Text poly;text ..;string])]
+      ($_ macro;either
+          
+          (with-gensyms [g!input g!key g!val]
+            (do @
+              [[:key: :val:] (poly;apply-2 (ident-for d;Dict) :x:)
+               _ (poly;text :key:)
+               .val. (Codec//encode env :val:)]
+              (wrap (` (: (~ (->Codec//encode (poly;to-ast env :x:)))
+                          (function [(~ g!input)]
+                            (|> (~ g!input)
+                                d;entries
+                                (;;_map_ (: (-> [Text (~ (poly;to-ast env :val:))]
+                                                [Text ..;JSON])
+                                            (function [[(~ g!key) (~ g!val)]]
+                                              [(~ g!key)
+                                               ((~ .val.) (~ g!val))])))
+                                (d;from-list text;Hash)
+                                #..;Object))
+                          )))))
+          (do @
+            [:sub: (poly;apply-1 (ident-for ;Maybe) :x:)
+             .sub. (Codec//encode env :sub:)]
+            (wrap (` (: (~ (->Codec//encode (poly;to-ast env :x:)))
+                        (..;nullable (~ .sub.))))))
+          (do @
+            [:sub: (poly;apply-1 (ident-for ;List) :x:)
+             .sub. (Codec//encode env :sub:)]
+            (wrap (` (: (~ (->Codec//encode (poly;to-ast env :x:)))
+                        (|>. (;;_map_ (~ .sub.)) vector;from-list ..;array)))))
+          (with-gensyms [g!type-fun g!case g!input]
+            (do @
+              [members (poly;sum+ :x:)
+               pattern-matching (M;map @
+                                       (function [[tag :case:]]
+                                         (do @
+                                           [g!encode (Codec//encode env :case:)]
+                                           (wrap (list (` ((~ (code;nat tag)) (~ g!case)))
+                                                       (` (..;json [(~ (code;real (;;tag tag)))
+                                                                    ((~ g!encode) (~ g!case))]))))))
+                                       (list;enumerate members))]
+              (wrap (` (: (~ (->Codec//encode (poly;to-ast env :x:)))
+                          (function [(~ g!input)]
+                            (case (~ g!input)
+                              (~@ (L/join pattern-matching)))))))))
+          (with-gensyms [g!type-fun g!case g!input]
+            (do @
+              [[g!vars members] (poly;variant :x:)
+               #let [new-env (poly;extend-env [:x: g!type-fun]
+                                              (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
+                                              env)]
+               pattern-matching (M;map @
+                                       (function [[name :case:]]
+                                         (do @
+                                           [#let [tag (code;tag name)]
+                                            encoder (Codec//encode new-env :case:)]
+                                           (wrap (list (` ((~ tag) (~ g!case)))
+                                                       (` (..;json [(~ (code;text (product;right name)))
+                                                                    ((~ encoder) (~ g!case))]))))))
+                                       members)
+               #let [:x:+ (case g!vars
+                            #;Nil
+                            (->Codec//encode (poly;to-ast env :x:))
+
+                            _
+                            (` (All (~ g!type-fun) [(~@ g!vars)]
+                                 (-> (~@ (L/map ->Codec//encode g!vars))
+                                     (~ (->Codec//encode (` ((~ (poly;to-ast env :x:)) (~@ g!vars)))))))))]]
+              (wrap (` (: (~ :x:+)
+                          (function [(~@ g!vars) (~ g!input)]
+                            (case (~ g!input)
+                              (~@ (L/join pattern-matching))))
+                          )))))
+          (with-gensyms [g!type-fun g!case g!input]
+            (do @
+              [[g!vars members] (poly;record :x:)
+               #let [new-env (poly;extend-env [:x: g!type-fun]
+                                              (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
+                                              env)]
+               synthesis (M;map @
+                                (function [[name :slot:]]
+                                  (do @
+                                    [encoder (Codec//encode new-env :slot:)]
+                                    (wrap [(` (~ (code;text (product;right name))))
+                                           (` ((~ encoder) (get@ (~ (code;tag name)) (~ g!input))))])))
+                                members)
+               #let [:x:+ (case g!vars
+                            #;Nil
+                            (->Codec//encode (poly;to-ast env :x:))
+
+                            _
+                            (` (All (~ g!type-fun) [(~@ g!vars)]
+                                 (-> (~@ (L/map ->Codec//encode g!vars))
+                                     (~ (->Codec//encode (` ((~ (poly;to-ast env :x:)) (~@ g!vars)))))))))]]
+              (wrap (` (: (~ :x:+)
+                          (function [(~@ g!vars) (~ g!input)]
+                            (..;json (~ (code;record synthesis))))
+                          )))))
+          (with-gensyms [g!type-fun g!case]
+            (do @
+              [[g!vars members] (poly;tuple :x:)
+               #let [new-env (poly;extend-env [:x: g!type-fun]
+                                              (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
+                                              env)]
+               pattern-matching (M;map @
+                                       (function [:member:]
+                                         (do @
+                                           [g!member (macro;gensym "g!member")
+                                            encoder (Codec//encode new-env :member:)]
+                                           (wrap [g!member encoder])))
+                                       members)
+               #let [:x:+ (case g!vars
+                            #;Nil
+                            (->Codec//encode (poly;to-ast env :x:))
+
+                            _
+                            (` (All (~ g!type-fun) [(~@ g!vars)]
+                                 (-> (~@ (L/map ->Codec//encode g!vars))
+                                     (~ (->Codec//encode (` ((~ (poly;to-ast env :x:)) (~@ g!vars)))))))))]
+               #let [.tuple. (` [(~@ (L/map product;left pattern-matching))])]]
+              (wrap (` (: (~ :x:+)
+                          (function [(~@ g!vars) (~ .tuple.)]
+                            (..;json [(~@ (L/map (function [[g!member g!encoder]]
+                                                   (` ((~ g!encoder) (~ g!member))))
+                                                 pattern-matching))]))
+                          )))
+              ))
+          ## Type recursion
+          (with-gensyms [g!rec]
+            (do @
+              [:non-rec: (poly;recursive :x:)
+               #let [new-env (poly;extend-env [:x: g!rec] (list [:x: (` (;undefined))]) env)]
+               .non-rec. (Codec//encode new-env :non-rec:)]
+              (wrap (` (: (~ (poly;gen-type new-env ->Codec//encode g!rec (list) :x:))
+                          (;;rec-encode (;function [(~ g!rec)]
+                                          (~ .non-rec.))))))))
+          (poly;self env :x:)
+          (poly;recursion env :x:)
+          ## Type applications
+          (do @
+            [[:func: :args:] (poly;apply :x:)
+             .func. (Codec//encode env :func:)
+             .args. (M;map @ (Codec//encode env) :args:)]
+            (wrap (` (: (~ (->Codec//encode (poly;to-ast env :x:)))
+                        ((~ .func.) (~@ .args.))))))
+          ## Bound type-vars
+          (poly;bound env :x:)
+          ## If all else fails...
+          (macro;fail ($_ text/append "Cannot create JSON encoder for: " (type;to-text :x:)))
+          ))))
+
+(poly: #hidden (Codec//decode env :x:)
+  (let [->Codec//decode (: (-> Code Code)
+                           (function [.type.] (` (..;Reader (~ .type.)))))]
+    (with-expansions
+      [ (do-template [  ]
+                 [(do @ [_ ( :x:)] (wrap (` (: (~ (->Codec//decode (` ))) ))))]
+
+                 [Unit poly;unit ../reader;null]
+                 [Bool poly;bool ../reader;boolean]
+                 [Real poly;real ../reader;number]
+                 [Text poly;text ../reader;string])]
+      ($_ macro;either
+          
+          (do @
+            [[:key: :val:] (poly;apply-2 (ident-for d;Dict) :x:)
+             _ (poly;text :key:)
+             .val. (Codec//decode env :val:)]
+            (wrap (` (: (~ (->Codec//decode (poly;to-ast env :x:)))
+                        (../reader;object (~ .val.))))))
+          (do @
+            [:sub: (poly;apply-1 (ident-for ;Maybe) :x:)
+             .sub. (Codec//decode env :sub:)]
+            (wrap (` (: (~ (->Codec//decode (poly;to-ast env :x:)))
+                        (../reader;nullable (~ .sub.))))))
+          (do @
+            [:sub: (poly;apply-1 (ident-for ;List) :x:)
+             .sub. (Codec//decode env :sub:)]
+            (wrap (` (: (~ (->Codec//decode (poly;to-ast env :x:)))
+                        (../reader;array (p;some (~ .sub.)))))))
+          (with-gensyms [g!type-fun g!case  g!_]
+            (do @
+              [members (poly;sum+ :x:)
+               pattern-matching (M;map @
+                                       (function [[tag :case:]]
+                                         (do @
+                                           [g!decode (Codec//decode env :case:)]
+                                           (wrap (list (` (|> (~ g!decode)
+                                                              (p;after (../reader;number! (~ (code;real (;;tag tag)))))
+                                                              ../reader;array))))))
+                                       (list;enumerate members))]
+              (wrap (` (: (~ (->Codec//decode (poly;to-ast env :x:)))
+                          ($_ p;alt
+                              (~@ (L/join pattern-matching))))))))
+          (with-gensyms [g!type-fun g!_]
+            (do @
+              [[g!vars members] (poly;variant :x:)
+               #let [new-env (poly;extend-env [:x: g!type-fun]
+                                              (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
+                                              env)]
+               pattern-matching (M;map @
+                                       (function [[name :case:]]
+                                         (do @
+                                           [g!decode (Codec//decode new-env :case:)]
+                                           (wrap (list (` (|> (~ g!decode)
+                                                              (:: p;Monad (~' map) (|>. (~ (code;tag name))))
+                                                              (p;after (../reader;string! (~ (code;text (product;right name)))))
+                                                              ../reader;array))))))
+                                       members)
+               #let [:x:+ (case g!vars
+                            #;Nil
+                            (->Codec//decode (poly;to-ast env :x:))
+
+                            _
+                            (` (All (~ g!type-fun) [(~@ g!vars)]
+                                 (-> (~@ (L/map ->Codec//decode g!vars))
+                                     (~ (->Codec//decode (` ((~ (poly;to-ast env :x:)) (~@ g!vars)))))))))
+                     base-parser (` ($_ p;either
+                                        (~@ (L/join pattern-matching))))
+                     parser (case g!vars
+                              #;Nil
+                              base-parser
+
+                              _
+                              (` (function [(~@ g!vars)] (~ base-parser))))]]
+              (wrap (` (: (~ :x:+) (~ parser))))
+              ))
+          (with-gensyms [g!type-fun g!case]
+            (do @
+              [[g!vars members] (poly;record :x:)
+               #let [new-env (poly;extend-env [:x: g!type-fun]
+                                              (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
+                                              env)]
+               extraction (M;map @
+                                 (function [[name :slot:]]
+                                   (do @
+                                     [g!decoder (Codec//decode new-env :slot:)]
+                                     (wrap (` (../reader;field (~ (code;text (product;right name)))
+                                                               (~ g!decoder))))))
+                                 members)
+               #let [:x:+ (case g!vars
+                            #;Nil
+                            (->Codec//decode (poly;to-ast env :x:))
+
+                            _
+                            (` (All (~ g!type-fun) [(~@ g!vars)]
+                                 (-> (~@ (L/map ->Codec//decode g!vars))
+                                     (~ (->Codec//decode (` ((~ (poly;to-ast env :x:)) (~@ g!vars)))))))))]]
+              (case g!vars
+                #;Nil
+                (wrap (` (: (~ :x:+)
+                            (|> ($_ p;seq (~@ extraction))
+                                (p;before ../reader;any)))))
+
+                _
+                (wrap (` (: (~ :x:+)
+                            (function [(~@ g!vars)]
+                              (|> ($_ p;seq (~@ extraction))
+                                  (p;before ../reader;any)))))))))
+          (with-gensyms [g!type-fun g!case]
+            (do @
+              [[g!vars members] (poly;tuple :x:)
+               #let [new-env (poly;extend-env [:x: g!type-fun]
+                                              (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
+                                              env)]
+               pattern-matching (M;map @ (Codec//decode new-env) members)
+               #let [:x:+ (case g!vars
+                            #;Nil
+                            (->Codec//decode (poly;to-ast env :x:))
+
+                            _
+                            (` (All (~ g!type-fun) [(~@ g!vars)]
+                                 (-> (~@ (L/map ->Codec//decode g!vars))
+                                     (~ (->Codec//decode (` ((~ (poly;to-ast env :x:)) (~@ g!vars)))))))))]
+               #let [.decoder. (case g!vars
+                                 #;Nil
+                                 (` (../reader;array ($_ p;seq (~@ pattern-matching))))
+
+                                 _
+                                 (` (function [(~@ g!vars)]
+                                      (../reader;array ($_ p;seq (~@ pattern-matching))))))]]
+              (wrap (` (: (~ :x:+) (~ .decoder.))))
+              ))
+          ## Type recursion
+          (with-gensyms [g!rec]
+            (do @
+              [:non-rec: (poly;recursive :x:)
+               #let [new-env (poly;extend-env [:x: g!rec] (list [:x: (` (;undefined))]) env)]
+               .non-rec. (Codec//decode new-env :non-rec:)]
+              (wrap (` (: (~ (poly;gen-type new-env ->Codec//decode g!rec (list) :x:))
+                          (p;rec (;function [(~ g!rec)]
+                                   (~ .non-rec.))))))))
+          (poly;self env :x:)
+          (poly;recursion env :x:)
+          ## Type applications
+          (do @
+            [[:func: :args:] (poly;apply :x:)
+             .func. (Codec//decode env :func:)
+             .args. (M;map @ (Codec//decode env) :args:)]
+            (wrap (` (: (~ (->Codec//decode (poly;to-ast env :x:)))
+                        ((~ .func.) (~@ .args.))))))
+          ## Bound type-vars
+          (do @
+            [g!bound (poly;bound env :x:)]
+            (wrap g!bound))
+          ## If all else fails...
+          (macro;fail ($_ text/append "Cannot create JSON decoder for: " (type;to-text :x:)))
+          ))))
+
+(syntax: #export (Codec :x:)
+  {#;doc (doc "A macro for automatically producing JSON codecs."
+              (type: Variant
+                (#Case0 Bool)
+                (#Case1 Text)
+                (#Case2 Real))
+
+              (type: Record
+                {#unit Unit
+                 #bool Bool
+                 #real Real
+                 #text Text
+                 #maybe (Maybe Real)
+                 #list (List Real)
+                 #variant Variant
+                 #tuple [Bool Real Text]
+                 #dict (Dict Text Real)})
+
+              (derived: (Codec Record)))}
+  (with-gensyms [g!inputs]
+    (wrap (list (` (: (Codec ..;JSON (~ :x:))
+                      (struct (def: (~' encode) (Codec//encode (~ :x:)))
+                              (def: ((~' decode) (~ g!inputs)) (../reader;run (~ g!inputs) (Codec//decode (~ :x:))))
+                              )))))))
diff --git a/stdlib/source/lux/data/format/json/reader.lux b/stdlib/source/lux/data/format/json/reader.lux
new file mode 100644
index 000000000..83713bcf3
--- /dev/null
+++ b/stdlib/source/lux/data/format/json/reader.lux
@@ -0,0 +1,177 @@
+(;module: {#;doc "Functionality for reading values in the JSON format.
+
+                  For more information, please see: http://www.json.org/"}
+  lux
+  (lux (control [monad #+ do Monad]
+                [eq #+ Eq]
+                codec
+                ["p" parser "p/" Monad])
+       (data [bool]
+             [text "text/" Monoid]
+             [number "real/" Codec "nat/" Codec]
+             ["R" result]
+             (coll [list]
+                   [vector]
+                   ["d" dict]))
+       )
+  [.. #+ JSON Reader])
+
+(def: unconsumed-input-error Text "Unconsumed JSON.")
+
+(def: #export (run json parser)
+  (All [a] (-> JSON (Reader a) (R;Result a)))
+  (case (p;run (list json) parser)
+    (#R;Success [remainder output])
+    (case remainder
+      #;Nil
+      (#R;Success output)
+
+      _
+      (#R;Error unconsumed-input-error))
+    
+    (#R;Error error)
+    (#R;Error error)))
+
+(def: #export (fail error)
+  (All [a] (-> Text (Reader a)))
+  (function [inputs]
+    (#R;Error error)))
+
+(def: #export any
+  {#;doc "Just returns the JSON input without applying any logic."}
+  (Reader JSON)
+  (<| (function [inputs])
+      (case inputs
+        #;Nil
+        (#R;Error "Empty JSON stream.")
+        
+        (#;Cons head tail)
+        (#R;Success [tail head]))))
+
+(do-template [   ]
+  [(def: #export 
+     {#;doc (#;TextA ($_ text/append "Reads a JSON value as "  "."))}
+     (Reader )
+     (do p;Monad
+       [head any]
+       (case head
+         ( value)
+         (wrap value)
+
+         _
+         (fail ($_ text/append "JSON value is not "  ".")))))]
+
+  [null    Unit #..;Null    "null"]
+  [boolean Bool #..;Boolean "boolean"]
+  [number  Real #..;Number  "number"]
+  [string  Text #..;String  "string"]
+  )
+
+(do-template [       
]
+  [(def: #export ( test)
+     {#;doc (#;TextA ($_ text/append "Asks whether a JSON value is a "  "."))}
+     (->  (Reader Bool))
+     (do p;Monad
+       [head any]
+       (case head
+         ( value)
+         (wrap (::  = test (
 value)))
+
+         _
+         (fail ($_ text/append "JSON value is not "  ".")))))
+
+   (def: #export ( test)
+     {#;doc (#;TextA ($_ text/append "Ensures a JSON value is a "  "."))}
+     (->  (Reader Unit))
+     (do p;Monad
+       [head any]
+       (case head
+         ( value)
+         (let [value (
 value)]
+           (if (::  = test value)
+             (wrap [])
+             (fail ($_ text/append "Value mismatch: " ( test) "=/=" ( value)))))
+
+         _
+         (fail ($_ text/append "JSON value is not a "  ".")))))]
+
+  [boolean? boolean! Bool bool;Eq   (:: bool;Codec encode)   #..;Boolean "boolean" id]
+  [number?  number!  Real number;Eq (:: number;Codec encode) #..;Number  "number"  id]
+  [string?  string!  Text text;Eq   text;encode                         #..;String  "string"  id]
+  )
+
+(def: #export (nullable parser)
+  (All [a] (-> (Reader a) (Reader (Maybe a))))
+  (p;alt null
+         parser))
+
+(def: #export (array parser)
+  {#;doc "Parses a JSON array, assuming that every element can be parsed the same way."}
+  (All [a] (-> (Reader a) (Reader a)))
+  (do p;Monad
+    [head any]
+    (case head
+      (#..;Array values)
+      (case (p;run (vector;to-list values) parser)
+        (#R;Error error)
+        (fail error)
+
+        (#R;Success [remainder output])
+        (case remainder
+          #;Nil
+          (wrap output)
+
+          _
+          (fail unconsumed-input-error)))
+
+      _
+      (fail "JSON value is not an array."))))
+
+(def: #export (object parser)
+  {#;doc "Parses a JSON object, assuming that every element can be parsed the same way."}
+  (All [a] (-> (Reader a) (Reader (d;Dict Text a))))
+  (do p;Monad
+    [head any]
+    (case head
+      (#..;Object object)
+      (case (do R;Monad
+              []
+              (|> (d;entries object)
+                  (monad;map @ (function [[key val]]
+                                 (do @
+                                   [val (run val parser)]
+                                   (wrap [key val]))))
+                  (:: @ map (d;from-list text;Hash))))
+        (#R;Success table)
+        (wrap table)
+
+        (#R;Error error)
+        (fail error))
+
+      _
+      (fail "JSON value is not an array."))))
+
+(def: #export (field field-name parser)
+  {#;doc "Parses a field inside a JSON object."}
+  (All [a] (-> Text (Reader a) (Reader a)))
+  (do p;Monad
+    [head any]
+    (case head
+      (#..;Object object)
+      (case (d;get field-name object)
+        (#;Some value)
+        (case (run value parser)
+          (#R;Success output)
+          (function [tail]
+            (#R;Success [(#;Cons (#..;Object (d;remove field-name object))
+                                 tail)
+                         output]))
+
+          (#R;Error error)
+          (fail error))
+
+        _
+        (fail ($_ text/append "JSON object does not have field \"" field-name "\".")))
+
+      _
+      (fail "JSON value is not an object."))))
diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux
index 88ea5ecc0..37e5e7cb6 100644
--- a/stdlib/source/lux/data/text/format.lux
+++ b/stdlib/source/lux/data/text/format.lux
@@ -8,7 +8,8 @@
              [ident]
              (coll [list "L/" Monad])
              (format [xml]
-                     [json]))
+                     [json]
+                     [json/codec]))
        (time [instant]
              [duration]
              [date])
@@ -50,7 +51,7 @@
   [%oct      Nat               (:: number;Octal@Codec encode)]
   [%hex      Nat               (:: number;Hex@Codec encode)]
   [%xml      xml;XML           (:: xml;Codec encode)]
-  [%json     json;JSON         (:: json;Codec encode)]
+  [%json     json;JSON         (:: json/codec;Codec encode)]
   [%instant  instant;Instant   (:: instant;Codec encode)]
   [%duration duration;Duration (:: duration;Codec encode)]
   [%date     date;Date         (:: date;Codec encode)]
diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux
index 6372b26f1..68e1427ee 100644
--- a/stdlib/test/test/lux/data/format/json.lux
+++ b/stdlib/test/test/lux/data/format/json.lux
@@ -4,14 +4,17 @@
        (control [monad #+ do Monad]
                 codec
                 [eq #+ Eq]
-                pipe)
+                pipe
+                ["p" parser])
        (data [text "Text/" Monoid]
              text/format
              ["R" result]
              [bool]
              [maybe]
              [number "i/" Number]
-             (format ["&" json])
+             (format ["@" json]
+                     (json ["@;" reader]
+                           ["@;" codec]))
              (coll [vector #+ vector]
                    ["d" dict]
                    [list]))
@@ -25,7 +28,7 @@
   )
 
 (def: gen-json
-  (r;Random &;JSON)
+  (r;Random @;JSON)
   (r;rec (function [gen-json]
            (do r;Monad
              [size (:: @ map (n.% +2) r;nat)]
@@ -40,16 +43,16 @@
 
 (context: "JSON"
   [sample gen-json
-   #let [(^open "&/") &;Eq
-         (^open "&/") &;Codec]]
+   #let [(^open "@/") @;Eq
+         (^open "@/") @codec;Codec]]
   ($_ seq
       (test "Every JSON is equal to itself."
-            (&/= sample sample))
+            (@/= sample sample))
 
       (test "Can encode/decode JSON."
-            (|> sample &/encode &/decode
+            (|> sample @/encode @/decode
                 (case> (#;Right result)
-                       (&/= sample result)
+                       (@/= sample result)
 
                        (#;Left _)
                        false)))
@@ -57,7 +60,7 @@
 
 (type: Variant
   (#Case0 Bool)
-  (#Case1 Int)
+  (#Case1 Text)
   (#Case2 Real))
 
 (type: #rec Recursive
@@ -67,14 +70,13 @@
 (type: Record
   {#unit Unit
    #bool Bool
-   #int Int
    #real Real
    #text Text
-   #maybe (Maybe Int)
-   #list (List Int)
+   #maybe (Maybe Real)
+   #list (List Real)
    #variant Variant
-   #tuple [Int Real Text]
-   #dict (d;Dict Text Int)
+   #tuple [Bool Real Text]
+   #dict (d;Dict Text Real)
    #recursive Recursive})
 
 (def: gen-recursive
@@ -88,23 +90,21 @@
 (def: gen-record
   (r;Random Record)
   (do r;Monad
-    [size (:: @ map (n.% +2) r;nat)
-     #let [gen-int (|> r;int (:: @ map (|>. i/abs (i.% 1_000_000))))]]
+    [size (:: @ map (n.% +2) r;nat)]
     ($_ r;seq
         (:: @ wrap [])
         r;bool
-        gen-int
         r;real
         (r;text size)
-        (r;maybe gen-int)
-        (r;list size gen-int)
-        ($_ r;alt r;bool gen-int r;real)
-        ($_ r;seq gen-int r;real (r;text size))
-        (r;dict text;Hash size (r;text size) gen-int)
+        (r;maybe r;real)
+        (r;list size r;real)
+        ($_ r;alt r;bool (r;text size) r;real)
+        ($_ r;seq r;bool r;real (r;text size))
+        (r;dict text;Hash size (r;text size) r;real)
         gen-recursive
         )))
 
-(derived: (&;Codec Record))
+(derived: (@codec;Codec Record))
 
 (struct: _ (Eq Record)
   (def: (= recL recR)
@@ -114,7 +114,7 @@
                         (:: bool;Eq = left' right')
                         
                         [(#Case1 left') (#Case1 right')]
-                        (i.= left' right')
+                        (:: text;Eq = left' right')
                         
                         [(#Case2 left') (#Case2 right')]
                         (r.= left' right')
@@ -122,29 +122,28 @@
                         _
                         false))]
       (and (:: bool;Eq = (get@ #bool recL) (get@ #bool recR))
-           (i.= (get@ #int recL) (get@ #int recR))
            (r.= (get@ #real recL) (get@ #real recR))
            (:: text;Eq = (get@ #text recL) (get@ #text recR))
-           (:: (maybe;Eq number;Eq) = (get@ #maybe recL) (get@ #maybe recR))
-           (:: (list;Eq number;Eq) = (get@ #list recL) (get@ #list recR))
+           (:: (maybe;Eq number;Eq) = (get@ #maybe recL) (get@ #maybe recR))
+           (:: (list;Eq number;Eq) = (get@ #list recL) (get@ #list recR))
            (variant/= (get@ #variant recL) (get@ #variant recR))
            (let [[tL0 tL1 tL2] (get@ #tuple recL)
                  [tR0 tR1 tR2] (get@ #tuple recR)]
-             (and (i.= tL0 tR0)
+             (and (:: bool;Eq = tL0 tR0)
                   (r.= tL1 tR1)
                   (:: text;Eq = tL2 tR2)))
-           (:: (d;Eq i.=) = (get@ #dict recL) (get@ #dict recR))
+           (:: (d;Eq number;Eq) = (get@ #dict recL) (get@ #dict recR))
            (:: Eq = (get@ #recursive recL) (get@ #recursive recR))
            ))))
 
 (context: "Polytypism"
   [sample gen-record
-   #let [(^open "&/") Eq
-         (^open "&/") Codec]]
+   #let [(^open "@/") Eq
+         (^open "@/") Codec]]
   (test "Can encode/decode arbitrary types."
-        (|> sample &/encode &/decode
-            (case> (#;Right result)
-                   (&/= sample result)
+        (|> sample @/encode @/decode
+            (case> (#R;Success result)
+                   (@/= sample result)
 
-                   (#;Left _)
+                   (#R;Error error)
                    false))))
-- 
cgit v1.2.3