AI生成版 getopt

phel-getopt-chatgpt.phel

;; phel-getopt.phel
;; Simple getopt-like argument parser for Phel
;;
;; Features
;; - short / long options
;; - value options
;; - -f value / -fvalue
;; - --long value / --long=value
;; - "--" stops option parsing
;; - undefined options collected as errors
;; - missing value detected when next token is another option
;;

(ns phel\getopt)

;; ---------------------------------
;; utility
;; ---------------------------------

(defn str-length [s]
  (count s))

(defn str-subs [s start len]
  (substr s start len))

(defn starts-with? [s prefix]
  (= prefix (str-subs s 0 (str-length prefix))))

(defn find-eq-pos [s]
  (loop [i 0]
    (if (>= i (str-length s))
      nil
      (if (= (str-subs s i 1) "=")
        i
        (recur (+ i 1))))))

(defn split-long-eq [arg]
  ;; "--file=test.txt" => ["--file" "test.txt"]
  (let [pos (find-eq-pos arg)]
    (if pos
      [(str-subs arg 0 pos)
       (str-subs arg (+ pos 1) (- (str-length arg) (+ pos 1)))]
      nil)))

(defn find-option [spec arg]
  (first
    (filter
      (fn [opt]
        (or (= (:short opt) arg)
            (= (:long opt) arg)))
      spec)))

(defn find-short-with-value [spec arg]
  ;; -fvalue
  (first
    (filter
      (fn [opt]
        (and (:has-value opt)
             (= (:short opt) (str-subs arg 0 2))))
      spec)))

;; ---------------------------------
;; main parser
;; ---------------------------------

(defn parse-args [spec argv]
  ;; returns {:options {} :args [] :errors []}
  (loop [args argv
         result {}
         rest-args []
         errors []
         parsing? true]

    (if (empty? args)
      {:options result
       :args rest-args
       :errors errors}

      (let [arg (first args)
            more (rest args)]

        (cond
          ;; ---------------------------------
          ;; end of options: "--"
          ;; ---------------------------------
          (and parsing? (= arg "--"))
          (recur more
                 result
                 rest-args
                 errors
                 false)

          ;; ---------------------------------
          ;; after "--" everything is argument
          ;; ---------------------------------
          (not parsing?)
          (recur more
                 result
                 (conj rest-args arg)
                 errors
                 false)

          ;; ---------------------------------
          ;; long option
          ;; ---------------------------------
          (starts-with? arg "--")
          (let [pair (split-long-eq arg)]
            (if pair
              ;; --long=value
              (let [[opt-key opt-val] pair
                    opt (find-option spec opt-key)]
                (if opt
                  (recur more
                         (assoc result (:long opt) opt-val)
                         rest-args
                         errors
                         parsing?)
                  (recur more
                         result
                         rest-args
                         (conj errors (str "Unknown option: " opt-key))
                         parsing?)))

              ;; --long value | flag
              (let [opt (find-option spec arg)]
                (if opt
                  (if (:has-value opt)
                    (if (or (empty? more)
                            (starts-with? (first more) "-"))
                      (recur more
                             result
                             rest-args
                             (conj errors (str "Missing value for option: " arg))
                             parsing?)
                      (recur (rest more)
                             (assoc result (:long opt) (first more))
                             rest-args
                             errors
                             parsing?))
                    (recur more
                           (assoc result (:long opt) true)
                           rest-args
                           errors
                           parsing?))
                  (recur more
                         result
                         rest-args
                         (conj errors (str "Unknown option: " arg))
                         parsing?)))))

          ;; ---------------------------------
          ;; short option
          ;; ---------------------------------
          (starts-with? arg "-")
          (let [opt (find-option spec arg)]
            (if opt
              ;; -f value | flag
              (if (:has-value opt)
                (if (or (empty? more)
                        (starts-with? (first more) "-"))
                  (recur more
                         result
                         rest-args
                         (conj errors (str "Missing value for option: " arg))
                         parsing?)
                  (recur (rest more)
                         (assoc result (:long opt) (first more))
                         rest-args
                         errors
                         parsing?))
                (recur more
                       (assoc result (:long opt) true)
                       rest-args
                       errors
                       parsing?))

              ;; -fvalue
              (let [opt2 (find-short-with-value spec arg)]
                (if opt2
                  (recur more
                         (assoc result
                                (:long opt2)
                                (str-subs arg 2 (- (str-length arg) 2)))
                         rest-args
                         errors
                         parsing?)
                  (recur more
                         result
                         rest-args
                         (conj errors (str "Unknown option: " arg))
                         parsing?)))))

          ;; ---------------------------------
          ;; normal argument
          ;; ---------------------------------
          :else
          (recur more
                 result
                 (conj rest-args arg)
                 errors
                 parsing?))))))

;; ---------------------------------
;; Example
;; ---------------------------------
;;
;; (def spec
;;   [
;;    {:short "-h" :long "--help" :has-value false}
;;    {:short "-f" :long "--file" :has-value true}
;;   ])
;;
;; (parse-args spec *command-line-args*)
;;
;; ;; supported
;; ;; -f value
;; ;; -fvalue
;; ;; --file value
;; ;; --file=value
;; ;; -- stops option parsing