utils.cljc

(ns cli-matic.utils
  "
  ### Utilities used in the project

  * the *general* section contains low-level
    stuff that could be anywhere
  * the *cli-matic* section contain low-level functions
    used by the parser and the help generators.


  "
  (:require [clojure.string :as str]
            [cli-matic.presets :as PRESETS]
            [cli-matic.specs :as S]
            [clojure.spec.alpha :as s]
            )
  )


; ================================================
;  GENERAL TOOLS
; ================================================



(defn asString
  "Turns a collection of strings into one string,
  or the string itself.

  If the collection includes multiple sub-arrays,
  those are flattened into lines as well.
  "
  [s]
  (if (string? s)
    s
    (str/join "\n" (flatten s))))


(defn asStrVec
  "Whatever we get in, we want a vector of strings out."
  [s]
           (cond
             (nil? s) []
             (string? s) [s]
             :else  s))


(defn indent-string
  "Indents a single string by one space."
  [s]
  (str " " s))

(defn indent
  "Indents a single string, or each string
  in a collection of strings."
  [s]
  (if (string? s)
    (indent-string s)
    (map indent-string (flatten s))))

(defn pad
  "Pads 's[, s1]' to so many characters"
  [s s1 len]
  (subs (str s
             (when s1
               (str ", " s1))
             "                   ")
        0 len))


(defn deep-merge
  "
  Merges a number of maps, considering values in inner maps.

  See https://gist.github.com/danielpcox/c70a8aa2c36766200a95#gistcomment-2308595
  "

  [& maps]
  (apply merge-with (fn [& args]
                      (if (every? map? args)
                        (apply deep-merge args)
                        (last args)))
         maps))


;
; String distance
; Patch by https://github.com/l3nz/cli-matic/pull/49/commits/07c392301a9e12c2f8ad76fd8a9115e0632e175a
;
(defn- deep-merge-with
  [f & maps]
  (apply
    (fn m [& maps]
      (if (every? map? maps)
        (apply merge-with m maps)
        (apply f maps)))
    maps))

(defn- levenshtein-distance
  "Ref https://en.wikipedia.org/wiki/Levenshtein_distance "
  [a b]
  (let [m (count a)
        n (count b)
        init (apply deep-merge-with (fn [a b] b)
                    (concat
                      (for [i (range 0 (+ 1 m))]
                        {i {0 i}})
                      (for [j (range 0 (+ 1 n))]
                        {0 {j j}})))
        table (reduce
                (fn [d [i j]]
                  (deep-merge-with
                    (fn [a b] b)
                    d
                    {i {j (if (= (nth a (- i 1))
                                 (nth b (- j 1)))
                            ((d (- i 1)) (- j 1))
                            (min
                              (+ ((d (- i 1))
                                   j) 1)
                              (+ ((d i)
                                   (- j 1)) 1)
                              (+ ((d (- i 1))
                                   (- j 1)) 1)))
                        }}))
                init
                (for [j (range 1 (+ 1 n))
                      i (range 1 (+ 1 m))] [i j]))]
    ((table m) n)))

(defn str-distance
  "Distance between two strings, as expressed in percentage
  of changes to the length of the longest string.

  "
  [a b]
  (/ (levenshtein-distance a b)
     (max (count a) (count b) 1)))


(defn candidate-suggestions
  "Returns candidate suggestions, in order of
  reliability."

  [candidates cmd max-str-distance]

  (let [valid (filter #(<= (str-distance % cmd) max-str-distance) candidates)]
    (sort-by (partial str-distance cmd) valid)))



; ==================================================================
; CLI-matic specific stuff
; ==================================================================


(defn assoc-new-multivalue
  "Associates a new multiple value to the
  current parameter map.
  If the current value is not a vector, creates
  a new vector with the new value."
  [parameter-map option v]
  (let [curr-val (get parameter-map option [])
        new-val (if (vector? curr-val)
                  (conj curr-val v)
                  [v])]
    (assoc parameter-map option new-val)))

(defn mk-env-name
  "Writes a description with the env name by the end."
  [description env for-parsing?]
  (if (and (not for-parsing?)
           (some? env))
    (str description " [$" env "]")
    description))

(defn mk-cli-option
  "Builds a tools.cli option out of our own format.

  If for-parsing is true, the option will be used for parsing;
  if false, for generating help messages.

  "
  [{:keys [option short as type default multiple env] :as cm-option}]

  (let [preset (get PRESETS/known-presets type :unknown)
        placeholder (str (:placeholder preset)
                         (if (= :present default) "*" ""))
        positional-opts [(if (string? short)
                           (str "-" short)
                           nil)
                         (str "--" option " " placeholder)
                         (mk-env-name as env false)]

        ;; step 1 - remove :placeholder
        opts-1 (dissoc preset :placeholder)

        ;; step 2 - add default if present and is not ":present"
        opts-2 (if (and (some? default)
                        (not= :present default))
                 (assoc opts-1 :default default)
                 opts-1)

        ;; step 3 - if multivalue, add correct assoc-fns
        opts-3 (if multiple
                 (assoc opts-2 :assoc-fn assoc-new-multivalue)
                 opts-2)]
    (apply
      conj positional-opts
      (flatten (seq opts-3)))))

(s/fdef mk-cli-option
        :args (s/cat :opts ::S/climatic-option)
        :ret some?)

(defn get-subcommand
  "Given args and the canonical name of a subcommand,
  returns the map describing it.
  "
  [climatic-args subcmd]
  (let [subcommands (:commands climatic-args)]
    (first (filter #(= (:command %) subcmd) subcommands))))

(s/fdef get-subcommand
        :args (s/cat :args ::S/climatic-cfg :subcmd string?)
        :ret ::S/a-command)

(defn all-subcommands-aliases
  "Maps all subcommands and subcommand aliases
  to their canonical name.
  E.g. {'add': 'add', 'a': 'add'}.

  We basically add them all, then remove
  nil keys.

  "

  [climatic-args]
  (let [subcommands (:commands climatic-args)]

    (dissoc
      (merge
        ;; a map of 'cmd' -> 'cmd'
        (into {}
              (map
                (fn [{:keys [command short]}]
                  [command command])
                subcommands))

        (into {}
              (map
                (fn [{:keys [command short]}]
                  [short command])
                subcommands)))
      nil)))

(s/fdef all-subcommands-aliases
        :args (s/cat :args ::S/climatic-cfg)
        :ret (s/map-of string? string?))

(defn all-subcommands
  "Returns all subcommands, as strings.
   We get all versions of all subcommands.
  "
  [climatic-args]
  (set (keys (all-subcommands-aliases climatic-args))))

(s/fdef all-subcommands
        :args (s/cat :args ::S/climatic-cfg)
        :ret set?)

(defn canonicalize-subcommand
  "Returns the 'canonical' name of a subcommand,
  i.e. the one that appears in :command, even
  if we pass an alias or short version."
  [commands subcmd]
  (get (all-subcommands-aliases commands) subcmd))

(s/fdef canonicalize-subcommand
        :args (s/cat :args ::S/climatic-cfg :sub string?)
        :ret string?)

(defn get-options-for
  "Gets specific :options for a subcommand or,
  if nil, for global."
  [climatic-args subcmd]
  (if (nil? subcmd)
    (:global-opts climatic-args)
    (:opts (get-subcommand climatic-args subcmd))))

;; Out of a cli-matic arg list,
;; generates a set of commands for tools.cli
(defn cm-opts->cli-opts
  "
  Out of a cli-matic arg list, generates a set of
  options for tools.cli.
  It also adds in the -? and --help options
  to trigger display of helpness.
  "
  [climatic-opts]
  (conj
    (mapv mk-cli-option climatic-opts)
    ["-?" "--help" "" :id :_help_trigger]))

(defn rewrite-opts
  "
  Out of a cli-matic arg list, generates a set of
  options for tools.cli.
  It also adds in the -? and --help options
  to trigger display of helpness.
  "
  [climatic-args subcmd]
  (cm-opts->cli-opts (get-options-for climatic-args subcmd)))

(s/fdef rewrite-opts
        :args (s/cat :args some?
                     :mode (s/or :common nil?
                                 :a-subcommand string?))
        :ret some?)



;; -------------------------------------------------------------
;; POSITIONAL PARAMETERS
; Positional parameters:
; 1- are only valid in subcommands
; 2- appear on help
; 3- capture from the "leftovers" vector :_arguments
;; --------------------------------------------------------------


(defn list-positional-parms
  "Extracts all positional parameters from the configuration."
  [cfg subcmd]
  ;;(prn "CFG" cfg "Sub" subcmd)
  (let [opts (get-options-for cfg subcmd)
        rv (filterv #(integer? (:short %)) opts)]
    ;;(prn "Subcmd" subcmd "OPTS" opts "RV" rv )
    rv))

(s/fdef
  list-positional-parms
  :args (s/cat :cfg ::S/climatic-cfg :cmd (s/or :cmd ::S/command :global nil?))
  :ret (s/coll-of ::S/climatic-option))

(defn a-positional-parm
  "Reads one positional parameter from the arguments.
  Returns a vector [parm value]
  The value is NOT solved, so it's always a string."
  [args option]
  (let [pos (:short option)
        lbl (:option option)
        val (get args pos nil)]
    [lbl val]))

(s/fdef
  a-positional-parm
  :args (s/cat :args sequential?
               :opt  ::S/climatic-option)
  :ret vector?)

(defn capture-positional-parms
  "Captures positional parameters in the remaining-args of
  a subcommand."
  [cfg subcmd remaining-args]
  (let [pp (list-positional-parms cfg subcmd)]
    (into {}
          (map (partial a-positional-parm remaining-args) pp))))

(s/fdef
  capture-positional-parms
  :args (s/cat :cfg ::S/climatic-cfg :cmd ::S/command :args sequential?)
  :ret ::S/mapOfCliParams)