New "parser" hierarchy. [Part 3]

3 files changed, 4 insertions, 349 deletions

diff --git a/stdlib/source/library/lux/control/parser/json.lux b/stdlib/source/library/lux/control/parser/json.lux
deleted file mode 100644
index 308c8c918..000000000
--- a/stdlib/source/library/lux/control/parser/json.lux
+++ /dev/null
@@ -1,199 +0,0 @@
-(.using
- [library
-  [lux (.except symbol)
-   [abstract
-    ["[0]" monad (.only do)]]
-   [control
-    ["[0]" try (.only Try)]
-    ["[0]" exception (.only exception:)]]
-   [data
-    ["[0]" bit]
-    ["[0]" text (.open: "[1]#[0]" equivalence monoid)]
-    [collection
-     ["[0]" list (.open: "[1]#[0]" functor)]
-     ["[0]" sequence]
-     ["[0]" dictionary (.only Dictionary)]]
-    [format
-     ["/" json (.only JSON)]]]
-   [macro
-    ["[0]" code]]
-   [math
-    [number
-     ["[0]" frac]]]]]
- ["[0]" // (.open: "[1]#[0]" functor)])
-
-(type: .public (Parser a)
-  (//.Parser (List JSON) a))
-
-(exception: .public (unconsumed_input [input (List JSON)])
-  (exception.report
-   "Input" (exception.listing /.format input)))
-
-(exception: .public empty_input)
-
-(def .public (result parser json)
-  (All (_ a) (-> (Parser a) JSON (Try a)))
-  (case (//.result parser (list json))
-    {try.#Success [remainder output]}
-    (case remainder
-      {.#End}
-      {try.#Success output}
-
-      _
-      (exception.except ..unconsumed_input remainder))
-    
-    {try.#Failure error}
-    {try.#Failure error}))
-
-(def .public any
-  (Parser JSON)
-  (<| (function (_ inputs))
-      (case inputs
-        {.#End}
-        (exception.except ..empty_input [])
-        
-        {.#Item head tail}
-        {try.#Success [tail head]})))
-
-(exception: .public (unexpected_value [value JSON])
-  (exception.report
-   "Value" (/.format value)))
-
-(with_template [<name> <type> <tag>]
-  [(def .public <name>
-     (Parser <type>)
-     (do //.monad
-       [head ..any]
-       (case head
-         {<tag> value}
-         (in value)
-
-         _
-         (//.failure (exception.error ..unexpected_value [head])))))]
-
-  [null    /.Null    /.#Null]
-  [boolean /.Boolean /.#Boolean]
-  [number  /.Number  /.#Number]
-  [string  /.String  /.#String]
-  )
-
-(exception: .public [a] (value_mismatch [reference JSON
-                                         sample JSON])
-  (exception.report
-   "Reference" (/.format reference)
-   "Sample" (/.format sample)))
-
-(with_template [<test> <check> <type> <equivalence> <tag>]
-  [(def .public (<test> test)
-     (-> <type> (Parser Bit))
-     (do //.monad
-       [head ..any]
-       (case head
-         {<tag> value}
-         (in (at <equivalence> = test value))
-
-         _
-         (//.failure (exception.error ..unexpected_value [head])))))
-
-   (def .public (<check> test)
-     (-> <type> (Parser Any))
-     (do //.monad
-       [head ..any]
-       (case head
-         {<tag> value}
-         (if (at <equivalence> = test value)
-           (in [])
-           (//.failure (exception.error ..value_mismatch [{<tag> test} {<tag> value}])))
-
-         _
-         (//.failure (exception.error ..unexpected_value [head])))))]
-
-  [boolean? this_boolean /.Boolean bit.equivalence  /.#Boolean]
-  [number?  this_number  /.Number  frac.equivalence /.#Number]
-  [string?  this_string  /.String  text.equivalence /.#String]
-  )
-
-(def .public (nullable parser)
-  (All (_ a) (-> (Parser a) (Parser (Maybe a))))
-  (//.or ..null
-         parser))
-
-(def .public (array parser)
-  (All (_ a) (-> (Parser a) (Parser a)))
-  (do //.monad
-    [head ..any]
-    (case head
-      {/.#Array values}
-      (case (//.result parser (sequence.list values))
-        {try.#Failure error}
-        (//.failure error)
-
-        {try.#Success [remainder output]}
-        (case remainder
-          {.#End}
-          (in output)
-
-          _
-          (//.failure (exception.error ..unconsumed_input remainder))))
-
-      _
-      (//.failure (exception.error ..unexpected_value [head])))))
-
-(def .public (object parser)
-  (All (_ a) (-> (Parser a) (Parser a)))
-  (do //.monad
-    [head ..any]
-    (case head
-      {/.#Object kvs}
-      (case (|> kvs
-                dictionary.entries
-                (list#each (function (_ [key value])
-                             (list {/.#String key} value)))
-                list.together
-                (//.result parser))
-        {try.#Failure error}
-        (//.failure error)
-
-        {try.#Success [remainder output]}
-        (case remainder
-          {.#End}
-          (in output)
-
-          _
-          (//.failure (exception.error ..unconsumed_input remainder))))
-      
-      _
-      (//.failure (exception.error ..unexpected_value [head])))))
-
-(def .public (field field_name parser)
-  (All (_ a) (-> Text (Parser a) (Parser a)))
-  (function (again inputs)
-    (case inputs
-      (pattern (list.partial {/.#String key} value inputs'))
-      (if (text#= key field_name)
-        (case (//.result parser (list value))
-          {try.#Success [{.#End} output]}
-          {try.#Success [inputs' output]}
-
-          {try.#Success [inputs'' _]}
-          (exception.except ..unconsumed_input inputs'')
-
-          {try.#Failure error}
-          {try.#Failure error})
-        (do try.monad
-          [[inputs'' output] (again inputs')]
-          (in [(list.partial {/.#String key} value inputs'')
-               output])))
-
-      {.#End}
-      (exception.except ..empty_input [])
-
-      _
-      (exception.except ..unconsumed_input inputs))))
-
-(def .public dictionary
-  (All (_ a) (-> (Parser a) (Parser (Dictionary Text a))))
-  (|>> (//.and ..string)
-       //.some
-       ..object
-       (//#each (dictionary.of_list text.hash))))
diff --git a/stdlib/source/library/lux/control/parser/xml.lux b/stdlib/source/library/lux/control/parser/xml.lux
deleted file mode 100644
index 16802de51..000000000
--- a/stdlib/source/library/lux/control/parser/xml.lux
+++ /dev/null
@@ -1,145 +0,0 @@
-(.using
- [library
-  [lux (.except)
-   [abstract
-    [monad (.only do)]]
-   [control
-    ["[0]" try (.only Try) (.open: "[1]#[0]" functor)]
-    ["[0]" exception (.only exception:)]]
-   [data
-    ["[0]" text
-     ["%" \\format (.only format)]]
-    [collection
-     ["[0]" list]
-     ["[0]" dictionary]]
-    [format
-     ["/" xml (.only Attribute Attrs Tag XML)]]]
-   [meta
-    ["[0]" symbol (.open: "[1]#[0]" equivalence codec)]]]]
- ["[0]" //])
-
-(type: .public (Parser a)
-  (//.Parser [Attrs (List XML)] a))
-
-(exception: .public empty_input)
-(exception: .public unexpected_input)
-
-(exception: .public (wrong_tag [expected Tag
-                                actual Tag])
-  (exception.report
-   "Expected" (%.text (/.tag expected))
-   "Actual" (%.text (/.tag actual))))
-
-(exception: .public (unknown_attribute [expected Attribute
-                                        available (List Attribute)])
-  (exception.report
-   "Expected" (%.text (/.attribute expected))
-   "Available" (exception.listing (|>> /.attribute %.text) available)))
-
-(exception: .public (unconsumed_inputs [inputs (List XML)])
-  (exception.report
-   "Inputs" (exception.listing (at /.codec encoded) inputs)))
-
-(def (result' parser attrs documents)
-  (All (_ a) (-> (Parser a) Attrs (List XML) (Try a)))
-  (case (//.result parser [attrs documents])
-    {try.#Success [[attrs' remaining] output]}
-    (if (list.empty? remaining)
-      {try.#Success output}
-      (exception.except ..unconsumed_inputs remaining))
-    
-    {try.#Failure error}
-    {try.#Failure error}))
-
-(def .public (result parser documents)
-  (All (_ a) (-> (Parser a) (List XML) (Try a)))
-  (..result' parser /.attributes documents))
-
-(def .public text
-  (Parser Text)
-  (function (_ [attrs documents])
-    (case documents
-      {.#End}
-      (exception.except ..empty_input [])
-      
-      {.#Item head tail}
-      (case head
-        {/.#Text value}
-        {try.#Success [[attrs tail] value]}
-        
-        {/.#Node _}
-        (exception.except ..unexpected_input [])))))
-
-(def .public tag
-  (Parser Tag)
-  (function (_ [attrs documents])
-    (case documents
-      {.#End}
-      (exception.except ..empty_input [])
-      
-      {.#Item head _}
-      (case head
-        {/.#Text _}
-        (exception.except ..unexpected_input [])
-        
-        {/.#Node tag _ _}
-        {try.#Success [[attrs documents] tag]}))))
-
-(def .public (attribute name)
-  (-> Attribute (Parser Text))
-  (function (_ [attrs documents])
-    (case (dictionary.value name attrs)
-      {.#None}
-      (exception.except ..unknown_attribute [name (dictionary.keys attrs)])
-      
-      {.#Some value}
-      {try.#Success [[attrs documents] value]})))
-
-(def .public (node expected parser)
-  (All (_ a) (-> Tag (Parser a) (Parser a)))
-  (function (_ [attrs documents])
-    (case documents
-      {.#End}
-      (exception.except ..empty_input [])
-      
-      {.#Item head tail}
-      (case head
-        {/.#Text _}
-        (exception.except ..unexpected_input [])
-        
-        {/.#Node actual attrs' children}
-        (if (symbol#= expected actual)
-          (|> children
-              (..result' parser attrs')
-              (try#each (|>> [[attrs tail]])))
-          (exception.except ..wrong_tag [expected actual]))))))
-
-(def .public any
-  (Parser XML)
-  (function (_ [attrs documents])
-    (case documents
-      {.#End}
-      (exception.except ..empty_input [])
-      
-      {.#Item head tail}
-      {try.#Success [[attrs tail] head]})))
-
-(exception: .public nowhere)
-
-(def .public (somewhere parser)
-  (All (_ a) (-> (Parser a) (Parser a)))
-  (function (again [attrs input])
-    (case (//.result parser [attrs input])
-      {try.#Success [[attrs remaining] output]}
-      {try.#Success [[attrs remaining] output]}
-      
-      {try.#Failure error}
-      (case input
-        {.#End}
-        (exception.except ..nowhere [])
-        
-        {.#Item head tail}
-        (do try.monad
-          [[[attrs tail'] output] (again [attrs tail])]
-          (in [[attrs {.#Item head tail'}]
-               output]))))))
diff --git a/stdlib/source/library/lux/world/net/http/request.lux b/stdlib/source/library/lux/world/net/http/request.lux
index d3a970d14..13c57ed23 100644
--- a/stdlib/source/library/lux/world/net/http/request.lux
+++ b/stdlib/source/library/lux/world/net/http/request.lux
@@ -8,17 +8,16 @@
     ["[0]" try (.only Try)]
     [concurrency
      ["[0]" async (.only Async)]
-     ["[0]" frp]]
-    [parser
-     ["<[0]>" json]]]
+     ["[0]" frp]]]
    [data
     ["[0]" number
      ["n" nat]]
     ["[0]" text
      ["[0]" encoding]]
     [format
-     ["[0]" json (.only JSON)]
-     ["[0]" context (.only Context Property)]]
+     ["[0]" context (.only Context Property)]
+     ["[0]" json (.only JSON)
+      ["<[1]>" \\parser]]]
     [collection
      ["[0]" list (.open: "[1]#[0]" functor mix)]
      ["[0]" dictionary]]]