(.module:
  [lux #*
   [abstract
    [monad (#+ do)]]
   [control
    ["p" parser (#+ Parser)]
    [concurrency
     ["." process]]]
   [data
    [collection
     ["." list ("#@." monoid monad)]]
    ["." text ("#@." equivalence)
     format]
    ["." error (#+ Error)]]
   [macro (#+ with-gensyms)
    ["." code]
    ["s" syntax (#+ Syntax syntax:)]]
   [tool
    [compiler
     ["." host]]]
   ["." io]])

(type: #export (CLI a)
  {#.doc "A command-line interface parser."}
  (Parser (List Text) a))

(def: #export (run inputs parser)
  (All [a] (-> (List Text) (CLI a) (Error a)))
  (case (p.run inputs parser)
    (#error.Success [remaining output])
    (case remaining 
      #.Nil
      (#error.Success output)

      _
      (#error.Failure (format "Remaining CLI inputs: " (text.join-with " " remaining))))

    (#error.Failure error)
    (#error.Failure error)))

(def: #export any
  {#.doc "Just returns the next input without applying any logic."}
  (CLI Text)
  (function (_ inputs)
    (case inputs
      (#.Cons arg inputs')
      (#error.Success [inputs' arg])
      
      _
      (#error.Failure "Cannot parse empty arguments."))))

(def: #export (parse parser)
  {#.doc "Parses the next input with a parsing function."}
  (All [a] (-> (-> Text (Error a)) (CLI a)))
  (function (_ inputs)
    (do error.monad
      [[remaining raw] (any inputs)
       output (parser raw)]
      (wrap [remaining output]))))

(def: #export (this reference)
  {#.doc "Checks that a token is in the inputs."}
  (-> Text (CLI Any))
  (function (_ inputs)
    (do error.monad
      [[remaining raw] (any inputs)]
      (if (text@= reference raw)
        (wrap [remaining []])
        (error.fail (format "Missing token: '" reference "'"))))))

(def: #export (somewhere cli)
  {#.doc "Given a parser, tries to parse it somewhere in the inputs (i.e. not necessarily parsing the immediate inputs)."}
  (All [a] (-> (CLI a) (CLI a)))
  (function (_ inputs)
    (loop [immediate inputs]
      (case (p.run immediate cli)
        (#error.Success [remaining output])
        (#error.Success [remaining output])

        (#error.Failure error)
        (case immediate
          #.Nil
          (#error.Failure error)
          
          (#.Cons to-omit immediate')
          (do error.monad
            [[remaining output] (recur immediate')]
            (wrap [(#.Cons to-omit remaining)
                   output])))))))

(def: #export end
  {#.doc "Ensures there are no more inputs."}
  (CLI Any)
  (function (_ inputs)
    (case inputs
      #.Nil (#error.Success [inputs []])
      _     (#error.Failure (format "Unknown parameters: " (text.join-with " " inputs))))))

(def: #export (named name value)
  (All [a] (-> Text (CLI a) (CLI a)))
  (|> value
      (p.after (..this name))
      ..somewhere))

(def: #export (parameter [short long] value)
  (All [a] (-> [Text Text] (CLI a) (CLI a)))
  (|> value
      (p.after (p.either (..this short) (..this long)))
      ..somewhere))

(type: Program-Args
  (#Raw Text)
  (#Parsed (List [Code Code])))

(def: program-args^
  (Syntax Program-Args)
  (p.or s.local-identifier
        (s.tuple (p.some (p.either (do p.monad
                                     [name s.local-identifier]
                                     (wrap [(code.identifier ["" name]) (` any)]))
                                   (s.record (p.and s.any s.any)))))))

(syntax: #export (program:
                   {args program-args^}
                   body)
  {#.doc (doc "Defines the entry-point to a program (similar to the 'main' function/method in other programming languages)."
              "Can take a list of all the input parameters to the program, or can destructure them using CLI-option combinators from the lux/cli module."
              (program: all-args
                (do io.monad
                  [foo init-program
                   bar (do-something all-args)]
                  (wrap [])))

              (program: [name]
                (io (log! (text@compose "Hello, " name))))

              (program: [{config config^}]
                (do io.monad
                  [data (init-program config)]
                  (do-something data))))}
  (with-gensyms [g!program]
    (case args
      (#Raw args)
      (wrap (list (` ("lux def program"
                      (.function ((~ g!program) (~ (code.identifier ["" args])))
                        ((~! do) (~! io.monad)
                         []
                         (~ body)))))))
      
      (#Parsed args)
      (with-gensyms [g!args g!_ g!output g!message]
        (wrap (list (` ("lux def program"
                        (.function ((~ g!program) (~ g!args))
                          (case ((: (~! (..CLI (io.IO .Any)))
                                    ((~! do) (~! p.monad)
                                     [(~+ (|> args
                                              (list@map (function (_ [binding parser])
                                                          (list binding parser)))
                                              list@join))
                                      (~ g!_) ..end]
                                     ((~' wrap) ((~! do) (~! io.monad)
                                                 [(~ g!output) (~ body)
                                                  (~+ (`` (for {(~~ (static host.jvm))
                                                                (list)}
                                                               (list g!_
                                                                     (` process.run!)))))]
                                                 ((~' wrap) (~ g!output))))))
                                 (~ g!args))
                            (#error.Success [(~ g!_) (~ g!output)])
                            (~ g!output)

                            (#error.Failure (~ g!message))
                            (.error! (~ g!message))
                            ))))
                    )))
      )))