(.module:
  [lux (#- nat int rev)
   [control
    ["." monad (#+ do Monad)]
    [equivalence (#+ Equivalence)]
    ["p" parser]]
   [data
    ["." bit]
    ["." ident]
    ["." maybe]
    ["." error (#+ Error)]
    ["." number]
    ["." text ("text/." Monoid<Text>)]
    [collection
     ["." list ("list/." Functor<List>)]]]]
  ["." // (#+ with-gensyms)
   ["." code ("code/." Equivalence<Code>)]])

## [Utils]
(def: (join-pairs pairs)
  (All [a] (-> (List [a a]) (List a)))
  (case pairs
    #.Nil                   #.Nil
    (#.Cons [[x y] pairs']) (list& x y (join-pairs pairs'))))

## [Types]
(type: #export Syntax
  {#.doc "A Lux syntax parser."}
  (p.Parser (List Code)))

## [Utils]
(def: (remaining-inputs asts)
  (-> (List Code) Text)
  ($_ text/compose "\nRemaining input: "
      (|> asts (list/map code.to-text) (list.interpose " ") (text.join-with ""))))

## [Syntaxs]
(def: #export any
  {#.doc "Just returns the next input without applying any logic."}
  (Syntax Code)
  (function (_ tokens)
    (case tokens
      #.Nil                (#error.Error "There are no tokens to parse!")
      (#.Cons [t tokens']) (#error.Success [tokens' t]))))

(do-template [<get-name> <type> <tag> <eq> <desc>]
  [(def: #export <get-name>
     {#.doc (code.text ($_ text/compose "Parses the next " <desc> " input Code."))}
     (Syntax <type>)
     (function (_ tokens)
       (case tokens
         (#.Cons [[_ (<tag> x)] tokens'])
         (#error.Success [tokens' x])

         _
         (#error.Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))]

  [   bit   Bit    #.Bit     bit.Equivalence<Bit> "bit"]
  [   nat   Nat    #.Nat  number.Equivalence<Nat> "nat"]
  [   int   Int    #.Int  number.Equivalence<Int> "int"]
  [   rev   Rev    #.Rev  number.Equivalence<Rev> "rev"]
  [  frac  Frac   #.Frac number.Equivalence<Frac> "frac"]
  [  text  Text   #.Text   text.Equivalence<Text> "text"]
  [symbol Ident #.Symbol ident.Equivalence<Ident> "symbol"]
  [   tag Ident    #.Tag ident.Equivalence<Ident> "tag"]
  )

(def: #export (this? ast)
  {#.doc "Asks if the given Code is the next input."}
  (-> Code (Syntax Bit))
  (function (_ tokens)
    (case tokens
      (#.Cons [token tokens'])
      (let [is-it? (code/= ast token)
            remaining (if is-it?
                        tokens'
                        tokens)]
        (#error.Success [remaining is-it?]))

      _
      (#error.Success [tokens #0]))))

(def: #export (this ast)
  {#.doc "Ensures the given Code is the next input."}
  (-> Code (Syntax Any))
  (function (_ tokens)
    (case tokens
      (#.Cons [token tokens'])
      (if (code/= ast token)
        (#error.Success [tokens' []])
        (#error.Error ($_ text/compose "Expected a " (code.to-text ast) " but instead got " (code.to-text token)
                          (remaining-inputs tokens))))

      _
      (#error.Error "There are no tokens to parse!"))))

(do-template [<name> <tag> <desc>]
  [(def: #export <name>
     {#.doc (code.text ($_ text/compose "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))}
     (Syntax Text)
     (function (_ tokens)
       (case tokens
         (#.Cons [[_ (<tag> ["" x])] tokens'])
         (#error.Success [tokens' x])

         _
         (#error.Error ($_ text/compose "Cannot parse local " <desc> (remaining-inputs tokens))))))]

  [local-symbol #.Symbol "symbol"]
  [   local-tag #.Tag    "tag"]
  )

(do-template [<name> <tag> <desc>]
  [(def: #export (<name> p)
     {#.doc (code.text ($_ text/compose "Parse inside the contents of a " <desc> " as if they were the input Codes."))}
     (All [a]
       (-> (Syntax a) (Syntax a)))
     (function (_ tokens)
       (case tokens
         (#.Cons [[_ (<tag> members)] tokens'])
         (case (p members)
           (#error.Success [#.Nil x]) (#error.Success [tokens' x])
           _                          (#error.Error ($_ text/compose "Syntax was expected to fully consume " <desc> (remaining-inputs tokens))))

         _
         (#error.Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))]

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

(def: #export (record p)
  {#.doc (code.text ($_ text/compose "Parse inside the contents of a record as if they were the input Codes."))}
  (All [a]
    (-> (Syntax a) (Syntax a)))
  (function (_ tokens)
    (case tokens
      (#.Cons [[_ (#.Record pairs)] tokens'])
      (case (p (join-pairs pairs))
        (#error.Success [#.Nil x]) (#error.Success [tokens' x])
        _                          (#error.Error ($_ text/compose "Syntax was expected to fully consume record" (remaining-inputs tokens))))

      _
      (#error.Error ($_ text/compose "Cannot parse record" (remaining-inputs tokens))))))

(def: #export end!
  {#.doc "Ensures there are no more inputs."}
  (Syntax Any)
  (function (_ tokens)
    (case tokens
      #.Nil (#error.Success [tokens []])
      _     (#error.Error ($_ text/compose "Expected list of tokens to be empty!" (remaining-inputs tokens))))))

(def: #export end?
  {#.doc "Checks whether there are no more inputs."}
  (Syntax Bit)
  (function (_ tokens)
    (case tokens
      #.Nil (#error.Success [tokens #1])
      _     (#error.Success [tokens #0]))))

(def: #export (lift outcome)
  (All [a] (-> (Error a) (Syntax a)))
  (function (_ input)
    (case outcome
      (#error.Error error)
      (#error.Error error)

      (#error.Success value)
      (#error.Success [input value])
      )))

(def: #export (run inputs syntax)
  (All [a] (-> (List Code) (Syntax a) (Error a)))
  (case (syntax inputs)
    (#error.Error error)
    (#error.Error error)

    (#error.Success [unconsumed value])
    (case unconsumed
      #.Nil
      (#error.Success value)

      _
      (#error.Error (text/compose "Unconsumed inputs: "
                                  (|> (list/map code.to-text unconsumed)
                                      (text.join-with ", ")))))))

(def: #export (local inputs syntax)
  {#.doc "Run a syntax parser with the given list of inputs, instead of the real ones."}
  (All [a] (-> (List Code) (Syntax a) (Syntax a)))
  (function (_ real)
    (do error.Monad<Error>
      [value (run inputs syntax)]
      (wrap [real value]))))

## [Syntax]
(macro: #export (syntax: tokens)
  {#.doc (doc "A more advanced way to define macros than \"macro:\"."
              "The inputs to the macro can be parsed in complex ways through the use of syntax parsers."
              "The macro body is also (implicitly) run in the Monad<Meta>, to save some typing."
              "Also, the compiler state can be accessed through the *compiler* binding."
              (syntax: #export (object {#let [imports (class-imports *compiler*)]}
                                 {#let [class-vars (list)]}
                                 {super (opt (super-class-decl^ imports class-vars))}
                                 {interfaces (tuple (some (super-class-decl^ imports class-vars)))}
                                 {constructor-args (constructor-args^ imports class-vars)}
                                 {methods (some (overriden-method-def^ imports))})
                (let [def-code ($_ text/compose "anon-class:"
                                   (spaced (list (super-class-decl$ (maybe.default object-super-class super))
                                                 (with-brackets (spaced (list/map super-class-decl$ interfaces)))
                                                 (with-brackets (spaced (list/map constructor-arg$ constructor-args)))
                                                 (with-brackets (spaced (list/map (method-def$ id) methods))))))]
                  (wrap (list (` ((~ (code.text def-code)))))))))}
  (let [[exported? tokens] (: [Bit (List Code)]
                              (case tokens
                                (^ (list& [_ (#.Tag ["" "export"])] tokens'))
                                [#1 tokens']

                                _
                                [#0 tokens]))
        ?parts (: (Maybe [Text (List Code) Code Code])
                  (case tokens
                    (^ (list [_ (#.Form (list& [_ (#.Symbol ["" name])] args))]
                             body))
                    (#.Some name args (` {}) body)

                    (^ (list [_ (#.Form (list& [_ (#.Symbol ["" name])] args))]
                             meta-data
                             body))
                    (#.Some name args meta-data body)

                    _
                    #.None))]
    (case ?parts
      (#.Some [name args meta body])
      (with-gensyms [g!tokens g!body g!error]
        (do //.Monad<Meta>
          [vars+parsers (monad.map @
                                   (: (-> Code (Meta [Code Code]))
                                      (function (_ arg)
                                        (case arg
                                          (^ [_ (#.Record (list [var parser]))])
                                          (wrap [var parser])

                                          [_ (#.Symbol var-name)]
                                          (wrap [(code.symbol var-name) (` any)])

                                          _
                                          (//.fail "Syntax pattern expects records or symbols."))))
                                   args)
           #let [g!state (code.symbol ["" "*compiler*"])
                 error-msg (code.text (text/compose "Wrong syntax for " name))
                 export-ast (: (List Code)
                               (if exported?
                                 (list (' #export))
                                 (list)))]]
          (wrap (list (` (macro: (~+ export-ast) ((~ (code.symbol ["" name])) (~ g!tokens) (~ g!state))
                           (~ meta)
                           ({(#error.Success (~ g!body))
                             ((~ g!body) (~ g!state))

                             (#error.Error (~ g!error))
                             (#error.Error ((~! text.join-with) ": " (list (~ error-msg) (~ g!error))))}
                            (..run (~ g!tokens)
                                   (: (..Syntax (Meta (List Code)))
                                      ((~! do) (~! p.Monad<Parser>)
                                       [(~+ (join-pairs vars+parsers))]
                                       ((~' wrap) ((~! do) (~! //.Monad<Meta>)
                                                   []
                                                   (~ body)))))))))))))
      
      _
      (//.fail "Wrong syntax for syntax:"))))