(.require
 [library
  [lux (.except symbol)
   [abstract
    ["[0]" monad (.only do)]]
   [control
    ["//" parser (.use "[1]#[0]" functor)]
    ["[0]" try (.only Try)]
    ["[0]" exception (.only Exception)]]
   [data
    ["[0]" bit]
    ["[0]" text (.use "[1]#[0]" equivalence monoid)]
    [collection
     ["[0]" list (.use "[1]#[0]" functor)]
     ["[0]" sequence]
     ["[0]" dictionary (.only Dictionary)]]]
   [math
    [number
     ["[0]" frac]]]
   [meta
    ["[0]" code]]]]
 [\\library
  ["[0]" / (.only JSON)]])

(type .public (Parser a)
  (//.Parser (List JSON) a))

(exception.def .public (unconsumed_input input)
  (Exception (List JSON))
  (exception.report
   (list ["Input" (exception.listing /.format input)])))

(exception.def .public empty_input)

(def .public (result parser json)
  (All (_ a) (-> (Parser a) JSON (Try a)))
  (when (//.result parser (list json))
    {try.#Success [remainder output]}
    (when remainder
      {.#End}
      {try.#Success output}

      _
      (exception.except ..unconsumed_input remainder))
    
    {try.#Failure error}
    {try.#Failure error}))

(def .public any
  (Parser JSON)
  (<| (function (_ inputs))
      (when inputs
        {.#End}
        (exception.except ..empty_input [])
        
        {.#Item head tail}
        {try.#Success [tail head]})))

(exception.def .public (unexpected_value value)
  (Exception JSON)
  (exception.report
   (list ["Value" (/.format value)])))

(with_template [<name> <type> <tag>]
  [(def .public <name>
     (Parser <type>)
     (do //.monad
       [head ..any]
       (when head
         {<tag> value}
         (in value)

         _
         (//.failure (exception.error ..unexpected_value [head])))))]

  [null    /.Null    /.#Null]
  [boolean /.Boolean /.#Boolean]
  [number  /.Number  /.#Number]
  [string  /.String  /.#String]
  )

(exception.def .public (value_mismatch [reference sample])
  (Exception [JSON JSON])
  (exception.report
   (list ["Reference" (/.format reference)]
         ["Sample" (/.format sample)])))

(with_template [<test> <check> <type> <equivalence> <tag>]
  [(def .public (<test> test)
     (-> <type> (Parser Bit))
     (do //.monad
       [head ..any]
       (when 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]
       (when 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]
    (when head
      {/.#Array values}
      (when (//.result parser (sequence.list values))
        {try.#Failure error}
        (//.failure error)

        {try.#Success [remainder output]}
        (when 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]
    (when head
      {/.#Object kvs}
      (when (|> 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]}
        (when 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)
    (when inputs
      (list.partial {/.#String key} value inputs')
      (if (text#= key field_name)
        (when (//.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))))