(;module:
  lux
  (lux [macro #+ with-gensyms]
       (control [monad #+ do Monad]
                [eq #+ Eq]
                ["p" parser])
       (data [bool]
             [number]
             [text "text/" Monoid<Text>]
             [ident]
             (coll [list "list/" Functor<List>])
             [product]
             [maybe]
             ["R" result]))
  (.. [code "code/" Eq<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                (#R;Error "There are no tokens to parse!")
      (#;Cons [t tokens']) (#R;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'])
         (#R;Success [tokens' x])

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

  [  bool  Bool   #;Bool   bool;Eq<Bool> "bool"]
  [   nat   Nat    #;Nat  number;Eq<Nat> "nat"]
  [   int   Int    #;Int  number;Eq<Int> "int"]
  [  deg    Deg    #;Deg  number;Eq<Deg> "deg"]
  [  frac  Frac   #;Frac number;Eq<Frac> "frac"]
  [  text  Text   #;Text   text;Eq<Text> "text"]
  [symbol Ident #;Symbol ident;Eq<Ident> "symbol"]
  [   tag Ident    #;Tag ident;Eq<Ident> "tag"]
  )

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

      _
      (#R;Success [tokens false]))))

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

      _
      (#R;Error "There are no tokens to parse!"))))

(do-template [<name> <comp> <error>]
  [(def: #export <name>
     (Syntax Int)
     (do p;Monad<Parser>
       [n int
        _ (p;assert <error> (<comp> 0 n))]
       (wrap n)))]

  [pos-int i.> "Expected a positive integer: N > 0"]
  [neg-int i.< "Expected a negative integer: N < 0"]
  )

(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'])
         (#R;Success [tokens' x])

         _
         (#R;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)
           (#R;Success [#;Nil x]) (#R;Success [tokens' x])
           _                   (#R;Error ($_ text/compose "Syntax was expected to fully consume " <desc> (remaining-inputs tokens))))

         _
         (#R;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))
        (#R;Success [#;Nil x]) (#R;Success [tokens' x])
        _                   (#R;Error ($_ text/compose "Syntax was expected to fully consume record" (remaining-inputs tokens))))

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

(def: #export end!
  {#;doc "Ensures there are no more inputs."}
  (Syntax Unit)
  (function [tokens]
    (case tokens
      #;Nil (#R;Success [tokens []])
      _     (#R;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 Bool)
  (function [tokens]
    (case tokens
      #;Nil (#R;Success [tokens true])
      _     (#R;Success [tokens false]))))

(def: #export (on compiler action)
  {#;doc "Run a Lux operation as if it was a Syntax parser."}
  (All [a] (-> Compiler (Lux a) (Syntax a)))
  (function [input]
    (case (macro;run compiler action)
      (#R;Error error)
      (#R;Error error)

      (#R;Success value)
      (#R;Success [input value])
      )))

(def: #export (local 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-inputs]
    (case (syntax local-inputs)
      (#R;Error error)
      (#R;Error error)

      (#R;Success [unconsumed-inputs value])
      (case unconsumed-inputs
        #;Nil
        (#R;Success [real-inputs value])

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

## [Syntax]
(def: #hidden text.join-with text;join-with)

(def: #hidden _run_ p;run)
(def: #hidden _Monad<Parser>_ p;Monad<Parser>)

(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<Lux>, 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 (` (;_lux_proc ["jvm" (~ (code;text def-code))] [])))))))}
  (let [[exported? tokens] (case tokens
                             (^ (list& [_ (#;Tag ["" "hidden"])] tokens'))
                             [(#;Some #;Left) tokens']

                             (^ (list& [_ (#;Tag ["" "export"])] tokens'))
                             [(#;Some #;Right) tokens']

                             _
                             [#;None 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!msg]
        (do macro;Monad<Lux>
          [vars+parsers (monad;map @
                                   (: (-> Code (Lux [Code Code]))
                                      (function [arg]
                                        (case arg
                                          (^ [_ (#;Tuple (list var parser))])
                                          (wrap [var parser])

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

                                          _
                                          (macro;fail "Syntax pattern expects tuples or symbols."))))
                                   args)
           #let [g!state (code;symbol ["" "*compiler*"])
                 g!end (code;symbol ["" ""])
                 error-msg (code;text (text/compose "Wrong syntax for " name))
                 export-ast (: (List Code) (case exported?
                                             (#;Some #R;Error)
                                             (list (' #hidden))

                                             (#;Some #R;Success)
                                             (list (' #export))

                                             _
                                             (list)))]]
          (wrap (list (` (macro: (~@ export-ast) ((~ (code;symbol ["" name])) (~ g!tokens))
                           (~ meta)
                           (function [(~ g!state)]
                             (;_lux_case (;;_run_ (~ g!tokens)
                                                  (: (Syntax (Lux (List Code)))
                                                     (do ;;_Monad<Parser>_
                                                       [(~@ (join-pairs vars+parsers))
                                                        (~ g!end) end!]
                                                       ((~' wrap) (do macro;Monad<Lux>
                                                                    []
                                                                    (~ body))))))
                               (#R;Success [(~ g!tokens) (~ g!body)])
                               ((~ g!body) (~ g!state))

                               (#R;Error (~ g!msg))
                               (#R;Error (text.join-with ": " (list (~ error-msg) (~ g!msg))))))))))))
      
      _
      (macro;fail "Wrong syntax for syntax:"))))