Moved the JSON parser under "lux/control/parser/".

1 files changed, 24 insertions, 218 deletions

diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index 162cf8387..417db04b6 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -2,25 +2,23 @@
                        "For more information, please see: http://www.json.org/")}
   [lux #*
    [abstract
-    ["." monad (#+ Monad do)]
+    ["." monad (#+ do)]
     [equivalence (#+ Equivalence)]
     codec]
    [control
     pipe
     ["p" parser ("#@." monad)
-     ["l" text (#+ Parser)]]
-    ["ex" exception (#+ exception:)]]
+     ["l" text (#+ Parser)]]]
    [data
     ["." bit]
     ["." maybe]
     ["." error (#+ Error)]
-    ["." sum]
     ["." product]
     [number
      ["." frac ("#@." decimal)]]
     ["." text ("#@." equivalence monoid)]
     [collection
-     ["." list ("#@." fold monad)]
+     ["." list ("#@." fold functor)]
      ["." row (#+ Row row) ("#@." monad)]
      ["." dictionary (#+ Dictionary)]]]
    ["." macro (#+ monad with-gensyms)
@@ -51,10 +49,6 @@
   [Object  (Dictionary String JSON)]
   )
 
-(type: #export (Reader a)
-  {#.doc "JSON reader."}
-  (p.Parser (List JSON) a))
-
 (syntax: #export (json token)
   {#.doc (doc "A simple way to produce JSON literals."
               (json #1)
@@ -194,14 +188,16 @@
 ############################################################
 ############################################################
 
-(def: encode-boolean
-  (-> Bit Text)
+(def: (format-null _) (-> Null Text) "null")
+
+(def: format-boolean
+  (-> Boolean Text)
   (|>> (case>
         #0 "false"
         #1 "true")))
 
-(def: encode-number
-  (-> Frac Text)
+(def: format-number
+  (-> Number Text)
   (|>> (case>
         +0.0 "0.0"
         -0.0 "0.0"
@@ -210,231 +206,41 @@
                   raw
                   (|> raw (text.split 1) maybe.assume product.right))))))
 
-(def: (show-null _) (-> Null Text) "null")
-
-(template [<name> <type> <codec>]
-  [(def: <name> (-> <type> Text) <codec>)]
-
-  [show-boolean Boolean ..encode-boolean]
-  [show-number  Number  ..encode-number]
-  [show-string  String  text.encode]
-  )
+(def: format-string (-> String Text) text.encode)
 
-(def: (show-array show-json elems)
+(def: (format-array format elems)
   (-> (-> JSON Text) (-> Array Text))
   ($_ text@compose "["
-      (|> elems (row@map show-json) row.to-list (text.join-with ","))
+      (|> elems (row@map format) row.to-list (text.join-with ","))
       "]"))
 
-(def: (show-object show-json object)
+(def: (format-object format object)
   (-> (-> JSON Text) (-> Object Text))
   ($_ 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 (format-string key) ":" (format value))))
           (text.join-with ","))
       "}"))
 
-(def: (show-json json)
+(def: #export (format json)
   (-> JSON Text)
   (case json
-    (^template [<tag> <show>]
+    (^template [<tag> <format>]
       (<tag> value)
-      (<show> value))
-    ([#Null    show-null]
-     [#Boolean show-boolean]
-     [#Number  show-number]
-     [#String  show-string]
-     [#Array   (show-array show-json)]
-     [#Object  (show-object show-json)])
+      (<format> value))
+    ([#Null    format-null]
+     [#Boolean format-boolean]
+     [#Number  format-number]
+     [#String  format-string]
+     [#Array   (format-array format)]
+     [#Object  (format-object format)])
     ))
 
 ############################################################
 ############################################################
 ############################################################
 
-(exception: #export (unconsumed-input {input (List JSON)})
-  (|> input
-      (list@map show-json)
-      (text.join-with text.new-line)))
-
-(exception: #export (empty-input)
-  "")
-
-(def: #export (run json parser)
-  (All [a] (-> JSON (Reader a) (Error a)))
-  (case (p.run (list json) parser)
-    (#error.Success [remainder output])
-    (case remainder
-      #.Nil
-      (#error.Success output)
-
-      _
-      (ex.throw unconsumed-input remainder))
-    
-    (#error.Failure error)
-    (#error.Failure error)))
-
-(def: #export (fail error)
-  (All [a] (-> Text (Reader a)))
-  (function (_ inputs)
-    (#error.Failure error)))
-
-(def: #export any
-  {#.doc "Just returns the JSON input without applying any logic."}
-  (Reader JSON)
-  (<| (function (_ inputs))
-      (case inputs
-        #.Nil
-        (ex.throw empty-input [])
-        
-        (#.Cons head tail)
-        (#error.Success [tail head]))))
-
-(template [<name> <type> <tag> <desc>]
-  [(def: #export <name>
-     {#.doc (code.text ($_ text@compose "Reads a JSON value as " <desc> "."))}
-     (Reader <type>)
-     (do p.monad
-       [head any]
-       (case head
-         (<tag> value)
-         (wrap value)
-
-         _
-         (fail ($_ text@compose "JSON value is not " <desc> ".")))))]
-
-  [null    Any  #Null    "null"]
-  [boolean Bit  #Boolean "boolean"]
-  [number  Frac #Number  "number"]
-  [string  Text #String  "string"]
-  )
-
-(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> "."))}
-     (-> <type> (Reader Bit))
-     (do p.monad
-       [head any]
-       (case head
-         (<tag> value)
-         (wrap (:: <eq> = test value))
-
-         _
-         (fail ($_ text@compose "JSON value is not " <desc> ".")))))
-
-   (def: #export (<check> test)
-     {#.doc (code.text ($_ text@compose "Ensures a JSON value is a " <desc> "."))}
-     (-> <type> (Reader Any))
-     (do p.monad
-       [head any]
-       (case head
-         (<tag> value)
-         (if (:: <eq> = test value)
-           (wrap [])
-           (fail ($_ text@compose "Value mismatch: " (<encoder> test) " =/= " (<encoder> value))))
-
-         _
-         (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"]
-  [string?  string!  Text text.equivalence text.encode              #String  "string"]
-  )
-
-(def: #export (nullable parser)
-  (All [a] (-> (Reader a) (Reader (Maybe a))))
-  (p.or null
-        parser))
-
-(def: #export (array parser)
-  {#.doc "Parses a JSON array."}
-  (All [a] (-> (Reader a) (Reader a)))
-  (do p.monad
-    [head any]
-    (case head
-      (#Array values)
-      (case (p.run (row.to-list values) parser)
-        (#error.Failure error)
-        (fail error)
-
-        (#error.Success [remainder output])
-        (case remainder
-          #.Nil
-          (wrap output)
-
-          _
-          (fail (ex.construct unconsumed-input remainder))))
-
-      _
-      (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."}
-  (All [a] (-> (Reader a) (Reader a)))
-  (do p.monad
-    [head any]
-    (case head
-      (#Object kvs)
-      (case (p.run (|> kvs
-                       dictionary.entries
-                       (list@map (function (_ [key value])
-                                   (list (#String key) value)))
-                       list.concat)
-                   parser)
-        (#error.Failure error)
-        (fail error)
-
-        (#error.Success [remainder output])
-        (case remainder
-          #.Nil
-          (wrap output)
-
-          _
-          (fail (ex.construct unconsumed-input remainder))))
-      
-      _
-      (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."}
-  (All [a] (-> Text (Reader a) (Reader a)))
-  (function (recur inputs)
-    (case inputs
-      (^ (list& (#String key) value inputs'))
-      (if (text@= key field-name)
-        (case (p.run (list value) parser)
-          (#error.Success [#.Nil output])
-          (#error.Success [inputs' output])
-
-          (#error.Success [inputs'' _])
-          (ex.throw unconsumed-input inputs'')
-
-          (#error.Failure error)
-          (#error.Failure error))
-        (do error.monad
-          [[inputs'' output] (recur inputs')]
-          (wrap [(list& (#String key) value inputs'')
-                 output])))
-
-      #.Nil
-      (ex.throw empty-input [])
-
-      _
-      (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))))
-
-############################################################
-############################################################
-############################################################
-
 (def: space~
   (Parser Text)
   (l.some l.space))
@@ -548,5 +354,5 @@
   ($_ p.or null~ boolean~ number~ string~ (array~ json~') (object~ json~')))
 
 (structure: #export codec (Codec Text JSON)
-  (def: encode show-json)
+  (def: encode ..format)
   (def: decode (function (_ input) (l.run input (json~' [])))))