(.module:
  [lux #*
   ["." meta (#+ with_gensyms)]
   [abstract
    ["." monad (#+ do)]]
   [control
    ["." try]
    ["<>" parser
     ["</>" code (#+ Parser)]]]
   [data
    ["." maybe]
    ["." text ("#\." monoid)]
    [collection
     ["." list ("#\." functor)]]]
   [math
    [number
     ["." nat]
     ["." int]
     ["." rev]
     ["." frac]]]]
  [//
   ["." code]])

(def: (self_documenting binding parser)
  (All [a] (-> Code (Parser a) (Parser a)))
  (function (_ tokens)
    (case (parser tokens)
      (#try.Success [tokens output])
      (#try.Success [tokens output])
      
      (#try.Failure error)
      (#try.Failure ($_ text\compose
                        "Failed to parse: " (code.format binding) text.new_line
                        error)))))

(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'))))

(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 Meta monad, 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& [_ (#.Identifier ["" name])] args))]
                             body))
                    (#.Some name args (` {}) body)

                    (^ (list [_ (#.Form (list& [_ (#.Identifier ["" 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 {! meta.monad}
          [vars+parsers (monad.map !
                                   (: (-> Code (Meta [Code Code]))
                                      (function (_ arg)
                                        (case arg
                                          (^ [_ (#.Record (list [var parser]))])
                                          (case var
                                            [_ (#.Tag ["" "let"])]
                                            (wrap [var parser])

                                            _
                                            (wrap [var
                                                   (` ((~! ..self_documenting) (' (~ var))
                                                       (~ parser)))]))

                                          [_ (#.Identifier var_name)]
                                          (wrap [arg
                                                 (` ((~! ..self_documenting) (' (~ arg))
                                                     (~! </>.any)))])

                                          _
                                          (meta.fail "Syntax pattern expects records or identifiers."))))
                                   args)
           this_module meta.current_module_name
           #let [g!state (code.identifier ["" "*compiler*"])
                 error_msg (code.text (meta.wrong_syntax_error [this_module name]))
                 export_ast (: (List Code)
                               (if exported?
                                 (list (' #export))
                                 (list)))]]
          (wrap (list (` (macro: (~+ export_ast) ((~ (code.identifier ["" name])) (~ g!tokens) (~ g!state))
                           (~ meta)
                           ({(#.Right (~ g!body))
                             ((~ g!body) (~ g!state))

                             (#.Left (~ g!error))
                             (#.Left ((~! text.join_with) (~! text.new_line) (list (~ error_msg) (~ g!error))))}
                            ((~! </>.run)
                             (: ((~! </>.Parser) (Meta (List Code)))
                                ((~! do) (~! <>.monad)
                                 [(~+ (..join_pairs vars+parsers))]
                                 ((~' wrap) (~ body))))
                             (~ g!tokens)))))))))
      
      _
      (meta.fail (meta.wrong_syntax_error (name_of ..syntax:))))))