diff --git a/README.md b/README.md index 75641eb..69a03f2 100644 --- a/README.md +++ b/README.md @@ -183,7 +183,8 @@ If no `--git/tag` or `--git/sha` is provided, the latest tag from the Git repo w **List installed scripts** - By default, this shows all installed scripts in a human readable table. -- When piping this output to another program, e.g. `bbin ls | wc -l`, the table header is omitted, git shas are shown in full and no escape characters are used. Flag `--plain` shows what this looks like. +- Depending on the width of the terminal, values (i.e. git shas, script locations) may be truncated. +- When piping this output to another program, e.g. `bbin ls | wc -l`, the table header is omitted, no escape characters are used and script locations and git shas are shown in full. Flag `--plain` shows what this looks like. **Supported Options:** diff --git a/bbin b/bbin index 987b24f..c27f139 100755 --- a/bbin +++ b/bbin @@ -59,6 +59,18 @@ :exit (= 0))) +(defn terminal-dimensions + "Yields e.g. `{:cols 30 :rows 120}`" + [] + (-> + (p/process ["stty" "size"] {:inherit true :out :string}) + deref + :out + str/trim + (str/split #" ") + (->> (map #(Integer/parseInt %)) + (zipmap [:rows :cols])))) + (defn user-home [] (System/getProperty "user.home")) @@ -77,28 +89,69 @@ (some-> (System/getenv "BABASHKA_BBIN_FLAG_UPGRADE") edn/read-string)) +(defn truncate + "Truncates `s` when it exceeds length `truncate-to` by inserting `omission` at the given `omission-position`. + + The result's length will equal `truncate-to`, unless `truncate-to` < `omission`-length, in which case the result equals `omission`. + + Examples: + ```clojure + (truncate \"1234567\" {:truncate-to 7}) + # => \"1234567\" + + (truncate \"1234567\" {:truncate-to 5}) + # => \"12...\" + + (truncate \"1234567\" {:truncate-to 5 :omission \"(continued)\"}) + # => \"(continued)\" + + (truncate \"example.org/path/to/release/v1.2.3/server.jar\" + {:omission \"…\" :truncate-to 35 :omission-position :center}) + # => \"example.org/path/…v1.2.3/server.jar\" + ``` + + Options: + - `truncate-to` (`30`) length above which truncating will occur. The resulting string will have this length (assuming `(> truncate-to (count omission))`). + - `omission` (`\"...\"`) what to use as omission. + - `omission-position` (`:end`) where to put omission. Options: `#{:center :end}`. + " + [s {:keys [omission truncate-to omission-position] + :or {omission "..." truncate-to 30 omission-position :end}}] + (if-not (> (count s) truncate-to) + s + (let [truncated-s-length (max 0 (- truncate-to (count omission))) + [lsub-len rsub-len] (case omission-position + :end [truncated-s-length 0] + :center (if (even? truncated-s-length) + [(/ truncated-s-length 2) (/ truncated-s-length 2)] + [(/ (inc truncated-s-length) 2) (/ (dec truncated-s-length) 2)]))] + (str (subs s 0 lsub-len) + omission + (subs s (- (count s) rsub-len) (count s)))))) + (defn print-table "Print table to stdout. Examples: - ;; extract columns from rows + ```clojure + ;; Extract columns from rows (print-table [{:a \"one\" :b \"two\"}]) a b ─── ─── one two - ;; provide columns (as b is an empty column, it will be skipped) + ;; Provide columns (as b is an empty column, it will be skipped) (print-table [:a :b] [{:a \"one\" :b nil}]) a ─── one - ;; ensure all columns being shown: + ;; Ensure all columns being shown: (print-table [:a :b] [{:a \"one\"}] {:show-empty-columns true}) - ;; provide columns with labels and apply column coercion + ;; Provide columns with labels and apply column coercion (print-table {:a \"option A\" :b \"option B\"} [{:a \"one\" :b nil}] {:column-coercions {:b (fnil boolean false)}}) @@ -106,21 +159,51 @@ ──────── ──────── one false + ;; Provide `max-width` and `:width-reduce-column` to try to make the table fit smaller screens. + (print-table {:a \"123456\"} {:max-width 5 :width-reduce-column :a}) + + a + ───── + 12... + + ;; A custom `width-reduce-fn` can be provided. See options for details. + (print-table {:a \"123456\"} {:max-width 5 + :width-reduce-column :a + :width-reduce-fn #(subs %1 0 %2)}) + a + ───── + 12345 + + ``` Options: - `column-coercions` (`{}`) fn that given a key `k` yields an fn to be applied to every `(k row)` *iff* row contains key `k`. See example above. - `skip-header` (`false`) don't print column names and divider (typically use this when stdout is no tty). - `show-empty-columns` (`false`) print every column, even if it results in empty columns. - - `no-color` (`false`) prevent printing escape characters to stdout." - ([rows] (print-table (keys (first rows)) rows nil)) - ([ks rows] (print-table ks rows nil)) - ([ks rows {:keys [show-empty-columns skip-header no-color column-coercions] + - `no-color` (`false`) prevent printing escape characters to stdout. + - `max-width` (`nil`) when width of the table exceeds this value, `width-reduce-fn` will be applied to all cells of column `width-reduce-column`. NOTE: providing this, requires `width-reduce-column` to be provided as well. + - `width-reduce-column` (`nil`) column that `width-reduce-fn` will be applied to when table width exceeds `max-width`. + - `width-reduce-fn` (`#(truncate %1 {:truncate-to %2})`) function that is applied to all cells of column `width-reduce-column` when the table exceeds width `max-width`. + The function should have 2-arity: a string (representing the cell value) and an integer (representing the max size of the cell contents in order for the table to stay within `max-width`)." + ([rows] + (print-table rows {})) + ([ks-rows rows-opts] + (let [rows->ks #(-> % first keys) + [ks rows opts] (if (map? rows-opts) + [(rows->ks ks-rows) ks-rows rows-opts] + [ks-rows rows-opts {}])] + (print-table ks rows opts))) + ([ks rows {:as opts + :keys [show-empty-columns skip-header no-color column-coercions + max-width width-reduce-column width-reduce-fn] :or {show-empty-columns false skip-header false no-color false column-coercions {}}}] + (assert (or (not max-width) (and max-width ((set ks) width-reduce-column))) + (str "Option :max-width requires option :width-reduce-column to be one of " (pr-str ks))) (let [wrap-bold (fn [s] (if no-color s (str "\033[1m" s "\033[0m"))) row-get (fn [row k] (when (contains? row k) - ((column-coercions k identity) (k row)))) + ((column-coercions k identity) (get row k)))) key->label (if (map? ks) ks #(subs (str (keyword %)) 1)) header-keys (if (map? ks) (keys ks) ks) ;; ensure all header-keys exist for every row and every value is a string @@ -130,25 +213,37 @@ header-keys (if show-empty-columns header-keys (let [non-empty-cols (remove - (fn [k] (every? str/blank? (map k rows))) + (fn [k] (every? str/blank? (map #(get % k) rows))) header-keys)] (filter (set non-empty-cols) header-keys))) header-labels (map key->label header-keys) column-widths (reduce (fn [acc k] - (let [val-widths (map count (cons (key->label k) (map k rows)))] + (let [val-widths (map count (cons (key->label k) + (map #(get % k) rows)))] (assoc acc k (apply max val-widths)))) {} header-keys) row-fmt (str/join " " (map #(str "%-" (column-widths %) "s") header-keys)) cells->formatted-row #(apply format row-fmt %) - header-row (wrap-bold - (cells->formatted-row header-labels)) + plain-header-row (cells->formatted-row header-labels) + required-width (count plain-header-row) + header-row (wrap-bold plain-header-row) + max-width-exceeded? (and max-width + (> required-width max-width)) div-row (wrap-bold (cells->formatted-row (map (fn [k] (apply str (take (column-widths k) (repeat \u2500)))) header-keys))) data-rows (map #(cells->formatted-row (map % header-keys)) rows)] - (when (seq header-keys) - (let [header (if skip-header (vector) (vector header-row div-row))] - (println (apply str (interpose \newline (into header data-rows))))))))) + (if-not max-width-exceeded? + (when (seq header-keys) + (let [header (if skip-header (vector) (vector header-row div-row))] + (println (apply str (interpose \newline (into header data-rows)))))) + (let [overflow (- required-width max-width) + max-column-width (max 0 (- (column-widths width-reduce-column) overflow)) + width-reduce-fn (or width-reduce-fn #(truncate %1 {:truncate-to %2})) + coercion-fn #(width-reduce-fn % max-column-width)] + (recur ks rows (assoc opts + :max-width nil + :column-coercions {width-reduce-column coercion-fn}))))))) (def help-commands (->> [{:command "bbin install" :doc "Install a script"} @@ -1040,22 +1135,42 @@ WARNING: - Set the BABASHKA_BBIN_BIN_DIR env variable to \"$HOME/.babashka/bbi (into {}))) (defn- printable-scripts [scripts] - (map (fn [[bin {coords :coords lib :lib}]] + (map (fn [[bin {{lroot :local/root + gtag :git/tag + gsha :git/sha + gurl :git/url + burl :bbin/url} :coords}]] (cond-> (assoc {} :bin bin) - lib (assoc :lib lib) - coords (merge coords))) + gurl (assoc :location gurl) + burl (assoc :location burl) + lroot (assoc :location (str "file://" lroot)) + gsha (assoc :version gsha) + gtag (assoc :version gtag))) scripts)) (defn- print-scripts [printable-scripts {:as _cli-opts :keys [no-color plain]}] - (let [piping? (not (util/is-tty 1 :out)) - skip-header? (or plain piping?) - no-color? (or plain no-color piping? - (System/getenv "NO_COLOR") (= "dumb" (System/getenv "TERM"))) - column-atts '(:bin :lib :bbin/url :local/root :git/url :git/tag :git/sha) - column-coercions {:git/sha #(if (or plain piping?) % (subs % 0 7))}] - (util/print-table column-atts (sort-by :bin printable-scripts) {:skip-header skip-header? - :column-coercions column-coercions - :no-color no-color?}))) + (let [tty? (util/is-tty 1 :out) + plain-mode? (or plain (not tty?)) + skip-header? plain-mode? + no-color? (or no-color plain-mode? + (System/getenv "NO_COLOR") (= "dumb" (System/getenv "TERM"))) + column-atts '(:bin :location :version) + column-coercions {:version #(if (or plain-mode? (not= 40 (count %))) + % + (subs % 0 7))} + max-width (when-not plain-mode? + (:cols (util/terminal-dimensions))) + location-truncate #(-> %1 + (str/replace #"^(file|https?):\/\/" "") + (util/truncate {:truncate-to %2 + :omission "…" + :omission-position :center}))] + (util/print-table column-atts (sort-by :bin printable-scripts) {:skip-header skip-header? + :max-width max-width + :width-reduce-column :location + :width-reduce-fn location-truncate + :column-coercions column-coercions + :no-color no-color?}))) (defn ls [cli-opts] (let [scripts (load-scripts cli-opts)] diff --git a/src/babashka/bbin/scripts.clj b/src/babashka/bbin/scripts.clj index 56265cf..529c7b7 100644 --- a/src/babashka/bbin/scripts.clj +++ b/src/babashka/bbin/scripts.clj @@ -39,22 +39,42 @@ (into {}))) (defn- printable-scripts [scripts] - (map (fn [[bin {coords :coords lib :lib}]] + (map (fn [[bin {{lroot :local/root + gtag :git/tag + gsha :git/sha + gurl :git/url + burl :bbin/url} :coords}]] (cond-> (assoc {} :bin bin) - lib (assoc :lib lib) - coords (merge coords))) + gurl (assoc :location gurl) + burl (assoc :location burl) + lroot (assoc :location (str "file://" lroot)) + gsha (assoc :version gsha) + gtag (assoc :version gtag))) scripts)) (defn- print-scripts [printable-scripts {:as _cli-opts :keys [no-color plain]}] - (let [piping? (not (util/is-tty 1 :out)) - skip-header? (or plain piping?) - no-color? (or plain no-color piping? - (System/getenv "NO_COLOR") (= "dumb" (System/getenv "TERM"))) - column-atts '(:bin :lib :bbin/url :local/root :git/url :git/tag :git/sha) - column-coercions {:git/sha #(if (or plain piping?) % (subs % 0 7))}] - (util/print-table column-atts (sort-by :bin printable-scripts) {:skip-header skip-header? - :column-coercions column-coercions - :no-color no-color?}))) + (let [tty? (util/is-tty 1 :out) + plain-mode? (or plain (not tty?)) + skip-header? plain-mode? + no-color? (or no-color plain-mode? + (System/getenv "NO_COLOR") (= "dumb" (System/getenv "TERM"))) + column-atts '(:bin :location :version) + column-coercions {:version #(if (or plain-mode? (not= 40 (count %))) + % + (subs % 0 7))} + max-width (when-not plain-mode? + (:cols (util/terminal-dimensions))) + location-truncate #(-> %1 + (str/replace #"^(file|https?):\/\/" "") + (util/truncate {:truncate-to %2 + :omission "…" + :omission-position :center}))] + (util/print-table column-atts (sort-by :bin printable-scripts) {:skip-header skip-header? + :max-width max-width + :width-reduce-column :location + :width-reduce-fn location-truncate + :column-coercions column-coercions + :no-color no-color?}))) (defn ls [cli-opts] (let [scripts (load-scripts cli-opts)] diff --git a/src/babashka/bbin/util.clj b/src/babashka/bbin/util.clj index 4f8b985..9e2c178 100644 --- a/src/babashka/bbin/util.clj +++ b/src/babashka/bbin/util.clj @@ -15,6 +15,18 @@ :exit (= 0))) +(defn terminal-dimensions + "Yields e.g. `{:cols 30 :rows 120}`" + [] + (-> + (p/process ["stty" "size"] {:inherit true :out :string}) + deref + :out + str/trim + (str/split #" ") + (->> (map #(Integer/parseInt %)) + (zipmap [:rows :cols])))) + (defn user-home [] (System/getProperty "user.home")) @@ -33,28 +45,69 @@ (some-> (System/getenv "BABASHKA_BBIN_FLAG_UPGRADE") edn/read-string)) +(defn truncate + "Truncates `s` when it exceeds length `truncate-to` by inserting `omission` at the given `omission-position`. + + The result's length will equal `truncate-to`, unless `truncate-to` < `omission`-length, in which case the result equals `omission`. + + Examples: + ```clojure + (truncate \"1234567\" {:truncate-to 7}) + # => \"1234567\" + + (truncate \"1234567\" {:truncate-to 5}) + # => \"12...\" + + (truncate \"1234567\" {:truncate-to 5 :omission \"(continued)\"}) + # => \"(continued)\" + + (truncate \"example.org/path/to/release/v1.2.3/server.jar\" + {:omission \"…\" :truncate-to 35 :omission-position :center}) + # => \"example.org/path/…v1.2.3/server.jar\" + ``` + + Options: + - `truncate-to` (`30`) length above which truncating will occur. The resulting string will have this length (assuming `(> truncate-to (count omission))`). + - `omission` (`\"...\"`) what to use as omission. + - `omission-position` (`:end`) where to put omission. Options: `#{:center :end}`. + " + [s {:keys [omission truncate-to omission-position] + :or {omission "..." truncate-to 30 omission-position :end}}] + (if-not (> (count s) truncate-to) + s + (let [truncated-s-length (max 0 (- truncate-to (count omission))) + [lsub-len rsub-len] (case omission-position + :end [truncated-s-length 0] + :center (if (even? truncated-s-length) + [(/ truncated-s-length 2) (/ truncated-s-length 2)] + [(/ (inc truncated-s-length) 2) (/ (dec truncated-s-length) 2)]))] + (str (subs s 0 lsub-len) + omission + (subs s (- (count s) rsub-len) (count s)))))) + (defn print-table "Print table to stdout. Examples: - ;; extract columns from rows + ```clojure + ;; Extract columns from rows (print-table [{:a \"one\" :b \"two\"}]) a b ─── ─── one two - ;; provide columns (as b is an empty column, it will be skipped) + ;; Provide columns (as b is an empty column, it will be skipped) (print-table [:a :b] [{:a \"one\" :b nil}]) a ─── one - ;; ensure all columns being shown: + ;; Ensure all columns being shown: (print-table [:a :b] [{:a \"one\"}] {:show-empty-columns true}) - ;; provide columns with labels and apply column coercion + ;; Provide columns with labels and apply column coercion (print-table {:a \"option A\" :b \"option B\"} [{:a \"one\" :b nil}] {:column-coercions {:b (fnil boolean false)}}) @@ -62,21 +115,51 @@ ──────── ──────── one false + ;; Provide `max-width` and `:width-reduce-column` to try to make the table fit smaller screens. + (print-table {:a \"123456\"} {:max-width 5 :width-reduce-column :a}) + + a + ───── + 12... + + ;; A custom `width-reduce-fn` can be provided. See options for details. + (print-table {:a \"123456\"} {:max-width 5 + :width-reduce-column :a + :width-reduce-fn #(subs %1 0 %2)}) + a + ───── + 12345 + + ``` Options: - `column-coercions` (`{}`) fn that given a key `k` yields an fn to be applied to every `(k row)` *iff* row contains key `k`. See example above. - `skip-header` (`false`) don't print column names and divider (typically use this when stdout is no tty). - `show-empty-columns` (`false`) print every column, even if it results in empty columns. - - `no-color` (`false`) prevent printing escape characters to stdout." - ([rows] (print-table (keys (first rows)) rows nil)) - ([ks rows] (print-table ks rows nil)) - ([ks rows {:keys [show-empty-columns skip-header no-color column-coercions] + - `no-color` (`false`) prevent printing escape characters to stdout. + - `max-width` (`nil`) when width of the table exceeds this value, `width-reduce-fn` will be applied to all cells of column `width-reduce-column`. NOTE: providing this, requires `width-reduce-column` to be provided as well. + - `width-reduce-column` (`nil`) column that `width-reduce-fn` will be applied to when table width exceeds `max-width`. + - `width-reduce-fn` (`#(truncate %1 {:truncate-to %2})`) function that is applied to all cells of column `width-reduce-column` when the table exceeds width `max-width`. + The function should have 2-arity: a string (representing the cell value) and an integer (representing the max size of the cell contents in order for the table to stay within `max-width`)." + ([rows] + (print-table rows {})) + ([ks-rows rows-opts] + (let [rows->ks #(-> % first keys) + [ks rows opts] (if (map? rows-opts) + [(rows->ks ks-rows) ks-rows rows-opts] + [ks-rows rows-opts {}])] + (print-table ks rows opts))) + ([ks rows {:as opts + :keys [show-empty-columns skip-header no-color column-coercions + max-width width-reduce-column width-reduce-fn] :or {show-empty-columns false skip-header false no-color false column-coercions {}}}] + (assert (or (not max-width) (and max-width ((set ks) width-reduce-column))) + (str "Option :max-width requires option :width-reduce-column to be one of " (pr-str ks))) (let [wrap-bold (fn [s] (if no-color s (str "\033[1m" s "\033[0m"))) row-get (fn [row k] (when (contains? row k) - ((column-coercions k identity) (k row)))) + ((column-coercions k identity) (get row k)))) key->label (if (map? ks) ks #(subs (str (keyword %)) 1)) header-keys (if (map? ks) (keys ks) ks) ;; ensure all header-keys exist for every row and every value is a string @@ -86,25 +169,37 @@ header-keys (if show-empty-columns header-keys (let [non-empty-cols (remove - (fn [k] (every? str/blank? (map k rows))) + (fn [k] (every? str/blank? (map #(get % k) rows))) header-keys)] (filter (set non-empty-cols) header-keys))) header-labels (map key->label header-keys) column-widths (reduce (fn [acc k] - (let [val-widths (map count (cons (key->label k) (map k rows)))] + (let [val-widths (map count (cons (key->label k) + (map #(get % k) rows)))] (assoc acc k (apply max val-widths)))) {} header-keys) row-fmt (str/join " " (map #(str "%-" (column-widths %) "s") header-keys)) cells->formatted-row #(apply format row-fmt %) - header-row (wrap-bold - (cells->formatted-row header-labels)) + plain-header-row (cells->formatted-row header-labels) + required-width (count plain-header-row) + header-row (wrap-bold plain-header-row) + max-width-exceeded? (and max-width + (> required-width max-width)) div-row (wrap-bold (cells->formatted-row (map (fn [k] (apply str (take (column-widths k) (repeat \u2500)))) header-keys))) data-rows (map #(cells->formatted-row (map % header-keys)) rows)] - (when (seq header-keys) - (let [header (if skip-header (vector) (vector header-row div-row))] - (println (apply str (interpose \newline (into header data-rows))))))))) + (if-not max-width-exceeded? + (when (seq header-keys) + (let [header (if skip-header (vector) (vector header-row div-row))] + (println (apply str (interpose \newline (into header data-rows)))))) + (let [overflow (- required-width max-width) + max-column-width (max 0 (- (column-widths width-reduce-column) overflow)) + width-reduce-fn (or width-reduce-fn #(truncate %1 {:truncate-to %2})) + coercion-fn #(width-reduce-fn % max-column-width)] + (recur ks rows (assoc opts + :max-width nil + :column-coercions {width-reduce-column coercion-fn}))))))) (def help-commands (->> [{:command "bbin install" :doc "Install a script"} diff --git a/test/babashka/bbin/test_runner.clj b/test/babashka/bbin/test_runner.clj index 16c6b78..f795a6c 100644 --- a/test/babashka/bbin/test_runner.clj +++ b/test/babashka/bbin/test_runner.clj @@ -4,11 +4,13 @@ (def test-namespaces '[babashka.bbin.cli-test - babashka.bbin.scripts-test]) + babashka.bbin.scripts-test + babashka.bbin.util-test]) (doseq [ns test-namespaces] (require ns)) + (defn run-tests [& {:keys [nses]}] (let [selected-tests (if nses (edn/read-string nses) diff --git a/test/babashka/bbin/util_test.clj b/test/babashka/bbin/util_test.clj new file mode 100644 index 0000000..20f5718 --- /dev/null +++ b/test/babashka/bbin/util_test.clj @@ -0,0 +1,80 @@ +(ns babashka.bbin.util-test + (:require [babashka.bbin.util :as util] + [clojure.string :as str] + [clojure.test :refer [deftest is testing are]])) + +(deftest truncate-test + (are [input opts expected] (= expected (util/truncate input opts)) + "123456" {:truncate-to 6} "123456" + "123456" {:truncate-to 5} "12..." + + "123456" {:truncate-to 5 :omission "longer than 5"} "longer than 5" + + "12345" {:truncate-to 3 :omission "…" :omission-position :center} "1…5")) + +(deftest print-table-test + (let [split-table (fn [table] + (let [[header div & data :as lines] (str/split-lines table)] + (if (re-find (re-pattern (str \u2500)) (str div)) + [header div data] + [nil nil lines]))) + print-table (fn + ([rows] + (with-out-str (util/print-table rows))) + ([ks-or-rows rows-or-opts] + (with-out-str (util/print-table ks-or-rows rows-or-opts))) + ([ks rows opts] + (with-out-str (util/print-table ks rows opts)))) + header-matches (fn [re table] + (let [[header & _r] (split-table table)] + (is (re-find re (str header)) + (str "expected header to match " (pr-str re))))) + contains-row-matching (fn [re table] + (let [[_header _div rows] (split-table table)] + (is (some #(re-find re %) rows) + (str "expected " (pr-str rows) " to contain a row matching " (pr-str re)))))] + (testing ":no-color skips escape characters" + (is (re-find #"^a\n─\n1\r?\n$" + (print-table [{:a 1}] {:no-color true})))) + (testing "header from rows or keys" + (header-matches #"a.+b" (print-table [{:a "12" :b "34"}])) + (header-matches #"b.+a" (print-table '(:b :a) [{:a "12" :b "34"}])) + (header-matches #"A" (print-table [{"A" 1}])) + (header-matches #"A" (print-table '("A") [{"A" 1}])) + (is (re-find #"^12 34\r?\n$" (print-table [{:a "12" :b "34"}] {:skip-header true})) + "prints only rows when :skip-header")) + (testing "naming columns" + (header-matches #"A.+B" (print-table {:a "A" :b "B"} + [{:a "12" :b "34"}]))) + (testing "skipping empty columns" + (is (empty? (print-table [{:a nil :b ""}]))) + (header-matches #"(?