(.module:
  [library
   [lux (#- nat int rev local)
    [abstract
     ["." monad (#+ do)]]
    [control
     ["." try (#+ Try)]]
    [data
     ["." bit]
     ["." text ("#\." monoid)]
     ["." name]
     [collection
      ["." list ("#\." functor)]]]
    [macro
     ["." code ("#\." equivalence)]]
    [math
     [number
      ["." nat]
      ["." int]
      ["." rev]
      ["." frac]]]]]
  ["." //])

(def: (un_paired pairs)
  (All [a] (-> (List [a a]) (List a)))
  (case pairs
    #.End                   #.End
    (#.Item [[x y] pairs']) (list& x y (un_paired pairs'))))

(type: .public Parser
  {#.doc "A Lux code parser."}
  (//.Parser (List Code)))

(def: (remaining_inputs codes)
  (-> (List Code) Text)
  ($_ text\compose text.new_line "Remaining input: "
      (|> codes (list\map code.format) (list.interposed " ") (text.join_with ""))))

(def: .public any
  {#.doc "Yields the next input without applying any logic."}
  (Parser Code)
  (function (_ tokens)
    (case tokens
      #.End
      (#try.Failure "There are no tokens to parse!")
      
      (#.Item [t tokens'])
      (#try.Success [tokens' t]))))

(template [<query> <check> <type> <tag> <eq> <desc>]
  [(with_expansions [<failure> (as_is (#try.Failure ($_ text\compose "Cannot parse " <desc> (remaining_inputs tokens))))]
     (def: .public <query>
       {#.doc (code.text ($_ text\compose "Parses the next " <desc> " input."))}
       (Parser <type>)
       (function (_ tokens)
         (case tokens
           (#.Item [[_ (<tag> x)] tokens'])
           (#try.Success [tokens' x])

           _
           <failure>)))

     (def: .public (<check> expected)
       {#.doc (code.text ($_ text\compose "Checks for a specific " <desc> " input."))}
       (-> <type> (Parser Any))
       (function (_ tokens)
         (case tokens
           (#.Item [[_ (<tag> actual)] tokens'])
           (if (\ <eq> = expected actual)
             (#try.Success [tokens' []])
             <failure>)

           _
           <failure>))))]

  [bit        bit!        Bit  #.Bit        bit.equivalence  "bit"]
  [nat        nat!        Nat  #.Nat        nat.equivalence  "nat"]
  [int        int!        Int  #.Int        int.equivalence  "int"]
  [rev        rev!        Rev  #.Rev        rev.equivalence  "rev"]
  [frac       frac!       Frac #.Frac       frac.equivalence "frac"]
  [text       text!       Text #.Text       text.equivalence "text"]
  [identifier identifier! Name #.Identifier name.equivalence "identifier"]
  [tag        tag!        Name #.Tag        name.equivalence "tag"]
  )

(def: .public (this! code)
  {#.doc "Ensures the given Code is the next input."}
  (-> Code (Parser Any))
  (function (_ tokens)
    (case tokens
      (#.Item [token tokens'])
      (if (code\= code token)
        (#try.Success [tokens' []])
        (#try.Failure ($_ text\compose "Expected a " (code.format code) " but instead got " (code.format token)
                          (remaining_inputs tokens))))

      _
      (#try.Failure "There are no tokens to parse!"))))

(template [<query> <check> <tag> <eq> <desc>]
  [(with_expansions [<failure> (as_is (#try.Failure ($_ text\compose "Cannot parse " <desc> (remaining_inputs tokens))))]
     (def: .public <query>
       {#.doc (code.text ($_ text\compose "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))}
       (Parser Text)
       (function (_ tokens)
         (case tokens
           (#.Item [[_ (<tag> ["" x])] tokens'])
           (#try.Success [tokens' x])

           _
           <failure>)))

     (def: .public (<check> expected)
       {#.doc (code.text ($_ text\compose "Checks for a specific local " <desc> " (a " <desc> " that has no module prefix)."))}
       (-> Text (Parser Any))
       (function (_ tokens)
         (case tokens
           (#.Item [[_ (<tag> ["" actual])] tokens'])
           (if (\ <eq> = expected actual)
             (#try.Success [tokens' []])
             <failure>)

           _
           <failure>))))]

  [local_identifier local_identifier! #.Identifier text.equivalence "local identifier"]
  [       local_tag        local_tag! #.Tag        text.equivalence "local tag"]
  )

(template [<name> <tag> <desc>]
  [(def: .public (<name> p)
     {#.doc (code.text ($_ text\compose "Parses the contents of a " <desc> "."))}
     (All [a]
       (-> (Parser a) (Parser a)))
     (function (_ tokens)
       (case tokens
         (#.Item [[_ (<tag> members)] tokens'])
         (case (p members)
           (#try.Success [#.End x]) (#try.Success [tokens' x])
           _                          (#try.Failure ($_ text\compose "Parser was expected to fully consume " <desc> (remaining_inputs tokens))))

         _
         (#try.Failure ($_ text\compose "Cannot parse " <desc> (remaining_inputs tokens))))))]

  [ form  #.Form "form"]
  [tuple #.Tuple "tuple"]
  )

(def: .public (record p)
  {#.doc "Parses the contents of a record."}
  (All [a]
    (-> (Parser a) (Parser a)))
  (function (_ tokens)
    (case tokens
      (#.Item [[_ (#.Record pairs)] tokens'])
      (case (p (un_paired pairs))
        (#try.Success [#.End x]) (#try.Success [tokens' x])
        _                          (#try.Failure ($_ text\compose "Parser was expected to fully consume record" (remaining_inputs tokens))))

      _
      (#try.Failure ($_ text\compose "Cannot parse record" (remaining_inputs tokens))))))

(def: .public end!
  {#.doc "Verifies there are no more inputs."}
  (Parser Any)
  (function (_ tokens)
    (case tokens
      #.End (#try.Success [tokens []])
      _     (#try.Failure ($_ text\compose "Expected list of tokens to be empty!" (remaining_inputs tokens))))))

(def: .public end?
  {#.doc "Checks whether there are no more inputs."}
  (Parser Bit)
  (function (_ tokens)
    (#try.Success [tokens (case tokens
                            #.End true
                            _     false)])))

(def: .public (result parser inputs)
  {#.doc (example "Executes a parser against a stream of code, and verifies all the inputs are consumed.")}
  (All [a] (-> (Parser a) (List Code) (Try a)))
  (case (parser inputs)
    (#try.Failure error)
    (#try.Failure error)

    (#try.Success [unconsumed value])
    (case unconsumed
      #.End
      (#try.Success value)

      _
      (#try.Failure (text\compose "Unconsumed inputs: "
                                  (|> (list\map code.format unconsumed)
                                      (text.join_with ", ")))))))

(def: .public (local inputs parser)
  {#.doc "Runs parser against the given list of inputs."}
  (All [a] (-> (List Code) (Parser a) (Parser a)))
  (function (_ real)
    (do try.monad
      [value (..result parser inputs)]
      (in [real value]))))