;; Copyright (c) Rich Hickey All rights reserved. The use and
;; distribution terms for this software are covered by the Eclipse Public
;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can be found
;; in the file epl-v10.html at the root of this distribution. By using this
;; software in any fashion, you are agreeing to be bound by the terms of
;; this license. You must not remove this notice, or any other, from this
;; software.

;; Originally contributed by Stephen C. Gilardi

(ns ^{:doc "Top-level main function for Clojure REPL and scripts."
       :author "Stephen C. Gilardi and Rich Hickey"}
  clojure.main
  (:refer-clojure :exclude [with-bindings]))

(declare main)

;;;;;;;;;;;;;;;;;;; redundantly copied from clojure.repl to avoid dep ;;;;;;;;;;;;;;
(defn demunge
  "Given a string representation of a fn type,
  as in a stack trace element, returns a readable version."
  {:added "1.3"}
  [fn-name]
  fn-name)

(defn info [x k default]
  (let [info (nth x 3)]
    (k info default)))

(defn filename [x]
  (erlang/iolist_to_binary (info x :file "NO_SOURCE_FILE")))

(defn line-number [x]
  (info x :line "?"))

(defn module [x]
  (erlang/atom_to_binary (first x) :utf8))

(defn function [x]
  (erlang/atom_to_binary (second x) :utf8))

(defn arg-count [x]
  (let [maybe-arg-count (nth x 2)]
    (when (list? maybe-arg-count)
      (count maybe-arg-count))))

(defn stack-element-str
  "Returns a (possibly unmunged) string representation of a StackTraceElement"
  {:added "1.3"}
  [el]
  (let [^clojerl.String file (filename el)
        clojure-fn? (and file (or (.ends_with file ".clje")
                                  (.ends_with file ".cljc")
                                  (= file "NO_SOURCE_FILE")))]
    (str (if clojure-fn? (demunge (module el)) (module el))
         "/" (function el)
         (when-let [arg-count (arg-count el)] (str " " arg-count))
         " (" (filename el) ":" (line-number el) ")")))

;;;;;;;;;;;;;;;;;;; end of redundantly copied from clojure.repl to avoid dep ;;;;;;;;;;;;;;

(defn getenv [name default]
  (-> (erlang/binary_to_list name)
      (os/getenv (erlang/binary_to_list default))
      erlang/list_to_binary))

(defn compile-path []
  (getenv "clojerl.compile.path" "ebin"))

(defn compile-protocols-path []
  (getenv "clojerl.compile.protocols.path" (compile-path)))

(defmacro with-bindings
  "Executes body in the context of thread-local bindings for several vars
  that often need to be set!: *ns* *warn-on-infer* *math-context*
  *print-meta* *print-length* *print-level* *compile-path*
  *compile-protocols-path* *command-line-args* *1 *2 *3 *e *stacktrace"
  [& body]
  `(binding [*ns* *ns*
             *print-meta* *print-meta*
             *print-length* *print-length*
             *print-level* *print-level*
             *print-namespace-maps* true
             *read-eval* *read-eval*
             *warn-on-infer* *warn-on-infer*
             *data-readers* *data-readers*
             *default-data-reader-fn* *default-data-reader-fn*
             *compile-path* (compile-path)
             *compile-protocols-path* (compile-protocols-path)
             *command-line-args* *command-line-args*
             *assert* *assert*
             *in* (new erlang.io.PushbackReader *in*)
             *1 nil
             *2 nil
             *3 nil
             *e nil
             *stacktrace nil]
     ~@body))

(defn repl-prompt
  "Default :prompt hook for repl"
  []
  (printf "~s=> " (str (ns-name *ns*))))

(defn skip-if-eol
  "If the next character on stream s is a newline, skips it, otherwise
  leaves the stream untouched. Returns :line-start, :stream-end, or :body
  to indicate the relative location of the next character on s. The stream
  must either be an instance of LineNumberingPushbackReader or duplicate
  its behavior of both supporting .unread and collapsing all of CR, LF, and
  CRLF to a single \\newline."
  [^erlang.io.PushbackReader s]
  (let [c (.read s)]
    (cond
     (= c \newline) :line-start
     (= c :eof) :stream-end
     :else (do (.unread s c) :body))))

(defn whitespace? [x]
  (or (= " " x) (= x "\n") (= x "\r") (= x "\t")))

(defn skip-whitespace
  "Skips whitespace characters on stream s. Returns :line-start, :stream-end,
  or :body to indicate the relative location of the next character on s.
  Interprets comma as whitespace and semicolon as comment to end of line.
  Does not interpret #! as comment to end of line because only one
  character of lookahead is available. The stream must either be an
  instance of LineNumberingPushbackReader or duplicate its behavior of both
  supporting .unread and collapsing all of CR, LF, and CRLF to a single
  \\newline."
  [^erlang.io.PushbackReader s]
  (loop [c (.read s)]
    (cond
     (= c \newline) :line-start
     (= c :eof) :stream-end
     (= c \;) (do (.read_line s) :line-start)
     (or (whitespace? c) (= c \,)) (recur (.read s))
     :else (do (.unread s c) :body))))

(defn repl-read
  "Default :read hook for repl. Reads from *in* which must either be an
  instance of LineNumberingPushbackReader or duplicate its behavior of both
  supporting .unread and collapsing all of CR, LF, and CRLF into a single
  \\newline. repl-read:
    - skips whitespace, then
      - returns request-prompt on start of line, or
      - returns request-exit on end of stream, or
      - reads an object from the input stream, then
        - skips the next input character if it's end of line, then
        - returns the object."
  [request-prompt request-exit]
  (or ({:line-start request-prompt :stream-end request-exit}
       (skip-whitespace *in*))
      (let [input (read {:read-cond :allow} *in*)]
        input)))

(defn repl-exception
  "Returns the exception and its stacktrace"
  []
  (when *e
    {:exception *e
     :stacktrace *stacktrace}))

(defn repl-caught
  "Default :caught hook for repl"
  [ex & [tr]]
  (binding [*out* *err*]
    (println ex)
    (doseq [x tr]
      (-> x stack-element-str println))))

(def ^{:doc "A sequence of lib specs that are applied to `require`
by default when a new command-line REPL is started."} repl-requires
  '[[clojure.repl :refer (source apropos dir pst doc find-doc)]
    #_[clojure.erlang.doc :refer (erlang-doc)]
    [clojure.pprint :refer (pp pprint)]])

(defmacro with-read-known
  "Evaluates body with *read-eval* set to a \"known\" value,
   i.e. substituting true for :unknown if necessary."
  [& body]
  `(binding [*read-eval* (if (= :unknown *read-eval*) true *read-eval*)]
     ~@body))

(defn repl
  "Generic, reusable, read-eval-print loop. By default, reads from *in*,
  writes to *out*, and prints exception summaries to *err*. If you use the
  default :read hook, *in* must either be an instance of
  LineNumberingPushbackReader or duplicate its behavior of both supporting
  unread and collapsing CR, LF, and CRLF into a single \\newline. Options
  are sequential keyword-value pairs. Available options and their defaults:

     - :init, function of no arguments, initialization hook called with
       bindings for set!-able vars in place.
       default: #()

     - :need-prompt, function of no arguments, called before each
       read-eval-print except the first, the user will be prompted if it
       returns true.
       default: (if (instance? LineNumberingPushbackReader *in*)
                  #(.atLineStart *in*)
                  #(identity true))

     - :prompt, function of no arguments, prompts for more input.
       default: repl-prompt

     - :flush, function of no arguments, flushes output
       default: flush

     - :read, function of two arguments, reads from *in*:
         - returns its first argument to request a fresh prompt
           - depending on need-prompt, this may cause the repl to prompt
             before reading again
         - returns its second argument to request an exit from the repl
         - else returns the next object read from the input stream
       default: repl-read

     - :eval, function of one argument, returns the evaluation of its
       argument
       default: eval

     - :print, function of one argument, prints its argument to the output
       default: prn

     - :caught, function of one argument, a throwable, called when
       read, eval, or print throws an exception or error
       default: repl-caught"
  [& options]
  (let [{:keys [init need-prompt prompt flush read eval print caught]
         :or {init        #()
              need-prompt #(if (instance? erlang.io.PushbackReader *in*)
                             (erlang.io.PushbackReader/at_line_start *in*)
                             true)
              prompt      repl-prompt
              flush       flush
              read        repl-read
              eval        eval
              print       prn
              caught      repl-caught}}
        (apply hash-map options)
        request-prompt (erlang/make_ref)
        request-exit (erlang/make_ref)
        read-eval-print
        (fn []
          (try
            (let [read-eval *read-eval*
                  input (with-read-known (read request-prompt request-exit))]
              (or (#{request-prompt request-exit} input)
                  (let [value (binding [*read-eval* read-eval] (eval input))]
                    (print value)
                    (set! *3 *2)
                    (set! *2 *1)
                    (set! *1 value))))
            (catch _ e :stack st
              (caught e)
              (set! *e e)
              (set! *stacktrace st))))]
    (with-bindings
      (try
        (init)
        (catch _ e :stack st
          (caught e)
          (set! *e e)
          (set! *stacktrace st)))
      (prompt)
      (flush)
      (loop []
        (when-not
            (try (identical? (read-eval-print) request-exit)
                 (catch _ e :stack st
                   (caught e)
                   (set! *e e)
                   (set! *stacktrace st)
                   nil))
          (when (need-prompt)
            (prompt)
            (flush))
          (recur))))))

(defn load-script
  "Loads Clojure source from a file or resource given its path. Paths
  beginning with @ or @/ are considered relative to codepath."
  [^clojerl.String path]
  (clj_compiler/load_file path))

(defn- init-opt
  "Load a script"
  [path]
  (load-script path))

(defn- eval-opt
  "Evals expressions in str, prints each non-nil result using prn"
  [str]
  (let [eof (erlang/make_ref)]
    (with-open [reader (-> (erlang.io.StringReader. str) erlang.io.PushbackReader.)]
      (loop [input (with-read-known (read reader false eof))]
        (when-not (= input eof)
          (let [value (eval input)]
            (when-not (nil? value)
              (prn value))
            (recur (with-read-known (read reader false eof)))))))))

(defn- init-dispatch
  "Returns the handler associated with an init opt"
  [opt]
  ({"-i"     init-opt
    "--init" init-opt
    "-e"     eval-opt
    "--eval" eval-opt} opt))

(defn- initialize
  "Common initialize routine for repl, script, and null opts"
  [args inits]
  (in-ns 'clje.user)
  (set! *command-line-args* args)
  (doseq [[opt arg] inits]
    ((init-dispatch opt) arg)))

(defn- main-opt
  "Call the -main function from a namespace with string arguments from
  the command line."
  [[_ main-ns & args] inits]
  (with-bindings
    (initialize args inits)
    (apply (ns-resolve (doto (symbol main-ns) require) '-main) args)))

(defn- repl-opt
  "Start a repl with args and inits. Print greeting if no eval options were
  present"
  [[_ & args] inits]
  (when-not (some #(= eval-opt (init-dispatch (first %))) inits)
    (println "Clojure" (clojure-version)))
  (repl :init (fn []
                (initialize args inits)
                (apply require repl-requires)))
  (prn)
  (erlang/halt 0))

(defn- script-opt
  "Run a script from a file, resource, or standard in with args and inits"
  [[path & args] inits]
  (with-bindings
    (initialize args inits)
    (if (= path "-")
      (load-reader *in*)
      (load-script path))))

(defn- null-opt
  "No repl or script opt present, just bind args and run inits"
  [args inits]
  (with-bindings
    (initialize args inits)))

(defn- help-opt
  "Print help text for main"
  [_ _]
  (println (:doc (meta (var main)))))

(defn- main-dispatch
  "Returns the handler associated with a main option"
  [opt]
  (or
   ({"-r"     repl-opt
     "--repl" repl-opt
     "-m"     main-opt
     "--main" main-opt
     nil      null-opt
     "-h"     help-opt
     "--help" help-opt
     "-?"     help-opt} opt)
   script-opt))

(defn main
  "Usage: erl -pa ebin -s clojure.main main [init-opt*] [main-opt] [arg*]

  With no options or args, runs an interactive Read-Eval-Print Loop

  init options:
    -i, --init path     Load a file or resource
    -e, --eval string   Evaluate expressions in string; print non-nil values

  main options:
    -m, --main ns-name  Call the -main function from a namespace with args
    -r, --repl          Run a repl
    path                Run a script from a file or resource
    -                   Run a script from standard input
    -h, -?, --help      Print this help message and exit

  operation:

    - Establishes thread-local bindings for commonly set!-able vars
    - Enters the user namespace
    - Binds *command-line-args* to a seq of strings containing command line
      args that appear after any main option
    - Runs all init options in order
    - Calls a -main function or runs a repl or script if requested

  The init options may be repeated and mixed freely, but must appear before
  any main option. The appearance of any eval option before running a repl
  suppresses the usual repl greeting message: \"Clojure ~(clojure-version)\".

  Paths may be absolute or relative in the filesystem or relative to
  codepath. Codepath-relative paths have prefix of @ or @/"
  [& args]
  (try
   (if args
     (loop [[opt arg & more :as args] args inits []]
       (if (init-dispatch opt)
         (recur more (conj inits [opt arg]))
         ((main-dispatch opt) args inits)))
     (repl-opt nil nil))
   (finally
     (flush))))