(.module:
  [library
   [lux #*
    [abstract
     ["." monad (#+ do)]]
    [control
     ["." try (#+ Try)]
     ["." exception (#+ exception:)]]
    [data
     ["." bit]
     ["." text ("#\." equivalence monoid)]
     [collection
      ["." list ("#\." functor)]
      ["." row]
      ["." dictionary (#+ Dictionary)]]
     [format
      ["/" json (#+ JSON)]]]
    [macro
     ["." code]]
    [math
     [number
      ["." frac]]]]]
  ["." // ("#\." functor)])

(type: #export (Parser a)
  {#.doc "A JSON parser."}
  (//.Parser (List JSON) a))

(exception: #export (unconsumed_input {input (List JSON)})
  (exception.report
   ["Input" (exception.enumerate /.format input)]))

(exception: #export empty_input)

(def: #export (run parser json)
  {#.doc (doc "Executes the parser against a JSON object."
              "Verifies that all of the JSON was consumed by the parser.")}
  (All [a] (-> (Parser a) JSON (Try a)))
  (case (//.run 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: #export any
  {#.doc "Just returns the JSON input without applying any logic."}
  (Parser JSON)
  (<| (function (_ inputs))
      (case inputs
        #.End
        (exception.except ..empty_input [])
        
        (#.Item head tail)
        (#try.Success [tail head]))))

(exception: #export (unexpected_value {value JSON})
  (exception.report
   ["Value" (/.format value)]))

(template [<name> <type> <tag> <desc>]
  [(def: #export <name>
     {#.doc (code.text ($_ text\compose "Reads a JSON value as " <desc> "."))}
     (Parser <type>)
     (do //.monad
       [head ..any]
       (case head
         (<tag> value)
         (in value)

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

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

(exception: #export [a] (value_mismatch {reference JSON} {sample JSON})
  (exception.report
   ["Reference" (/.format reference)]
   ["Sample" (/.format sample)]))

(template [<test> <check> <type> <equivalence> <tag> <desc>]
  [(def: #export (<test> test)
     {#.doc (code.text ($_ text\compose "Asks whether a JSON value is a " <desc> "."))}
     (-> <type> (Parser Bit))
     (do //.monad
       [head ..any]
       (case head
         (<tag> value)
         (in (\ <equivalence> = test value))

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

   (def: #export (<check> test)
     {#.doc (code.text ($_ text\compose "Ensures a JSON value is a " <desc> "."))}
     (-> <type> (Parser Any))
     (do //.monad
       [head ..any]
       (case head
         (<tag> value)
         (if (\ <equivalence> = test value)
           (in [])
           (//.failure (exception.construct ..value_mismatch [(<tag> test) (<tag> value)])))

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

  [boolean? boolean! /.Boolean bit.equivalence  #/.Boolean "boolean"]
  [number?  number!  /.Number  frac.equivalence #/.Number  "number"]
  [string?  string!  /.String  text.equivalence #/.String  "string"]
  )

(def: #export (nullable parser)
  {#.doc (doc "Enhances parser by adding NULL-handling.")}
  (All [a] (-> (Parser a) (Parser (Maybe a))))
  (//.or ..null
         parser))

(def: #export (array parser)
  {#.doc "Parses the contents of a JSON array."}
  (All [a] (-> (Parser a) (Parser a)))
  (do //.monad
    [head ..any]
    (case head
      (#/.Array values)
      (case (//.run parser (row.to_list values))
        (#try.Failure error)
        (//.failure error)

        (#try.Success [remainder output])
        (case remainder
          #.End
          (in output)

          _
          (//.failure (exception.construct ..unconsumed_input remainder))))

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

(def: #export (object parser)
  {#.doc (doc "Parses the contents of a JSON object."
              "Use this with the 'field' combinator.")}
  (All [a] (-> (Parser a) (Parser a)))
  (do //.monad
    [head ..any]
    (case head
      (#/.Object kvs)
      (case (|> kvs
                dictionary.entries
                (list\map (function (_ [key value])
                            (list (#/.String key) value)))
                list.concat
                (//.run parser))
        (#try.Failure error)
        (//.failure error)

        (#try.Success [remainder output])
        (case remainder
          #.End
          (in output)

          _
          (//.failure (exception.construct ..unconsumed_input remainder))))
      
      _
      (//.failure (exception.construct ..unexpected_value [head])))))

(def: #export (field field_name parser)
  {#.doc (doc "Parses a field inside a JSON object."
              "Use this inside the 'object' combinator.")}
  (All [a] (-> Text (Parser a) (Parser a)))
  (function (recur inputs)
    (case inputs
      (^ (list& (#/.String key) value inputs'))
      (if (text\= key field_name)
        (case (//.run 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] (recur inputs')]
          (in [(list& (#/.String key) value inputs'')
               output])))

      #.End
      (exception.except ..empty_input [])

      _
      (exception.except ..unconsumed_input inputs))))

(def: #export dictionary
  {#.doc "Parses a dictionary-like JSON object."}
  (All [a] (-> (Parser a) (Parser (Dictionary Text a))))
  (|>> (//.and ..string)
       //.some
       ..object
       (//\map (dictionary.of_list text.hash))))