Skip to content

Commit

Permalink
bbin ls prints human readable text (#54, #61)
Browse files Browse the repository at this point in the history
Resolves #54, resolves #61.

* Ensure `bbin ls` prints no namespace maps

* `bbin ls` now prints table, edn via flag --edn

* Ensure ls-table can fit smaller screens`

* Reorder the columns

* Add `BABASHKA_BBIN_FLAG_PRETTY_LS`

* Revert `README` changes

---------

Co-authored-by: Radford Smith <[email protected]>
  • Loading branch information
eval and rads authored Apr 8, 2023
1 parent 6c61002 commit 90ac56c
Show file tree
Hide file tree
Showing 5 changed files with 535 additions and 7 deletions.
229 changes: 226 additions & 3 deletions bbin
Original file line number Diff line number Diff line change
Expand Up @@ -51,6 +51,26 @@
[taoensso.timbre :as log]
[clojure.edn :as edn]))

(defn is-tty
[fd key]
(-> ["test" "-t" (str fd)]
(p/process {key :inherit :env {}})
deref
: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"))

Expand All @@ -62,12 +82,173 @@
(log/merge-config! {:min-level (if debug :debug :warn)}))

(defn pprint [x & _]
(pprint/pprint x))
(binding [*print-namespace-maps* false]
(pprint/pprint x)))

(defn upgrade-enabled? []
(some-> (System/getenv "BABASHKA_BBIN_FLAG_UPGRADE")
edn/read-string))

(defn pretty-ls-enabled? []
(some-> (System/getenv "BABASHKA_BBIN_FLAG_PRETTY_LS")
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:
```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)
(print-table [:a :b] [{:a \"one\" :b nil}])
a
───
one
;; Ensure all columns being shown:
(print-table [:a :b] [{:a \"one\"}] {:show-empty-columns true})
;; 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)}})
option A option B
──────── ────────
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.
- `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) (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
rows (map (fn [row]
(reduce (fn [acc k]
(assoc acc k (str (row-get row k)))) {} header-keys)) rows)
header-keys (if show-empty-columns
header-keys
(let [non-empty-cols (remove
(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 #(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 %)
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)]
(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"}
(when (upgrade-enabled?)
Expand Down Expand Up @@ -957,9 +1138,51 @@ WARNING: - Set the BABASHKA_BBIN_BIN_DIR env variable to \"$HOME/.babashka/bbi
(filter second)
(into {})))

(defn- printable-scripts [scripts]
(map (fn [[bin {{lroot :local/root
gtag :git/tag
gsha :git/sha
gurl :git/url
burl :bbin/url} :coords}]]
(cond-> (assoc {} :bin bin)
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 [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 :version :location)
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]
(-> (load-scripts cli-opts)
(util/pprint cli-opts)))
(let [scripts (load-scripts cli-opts)]
(if (util/pretty-ls-enabled?)
(if (:edn cli-opts)
(util/pprint scripts cli-opts)
(print-scripts (printable-scripts scripts) cli-opts))
(util/pprint scripts cli-opts))))

(defn bin [cli-opts]
(println (str (util/bin-dir cli-opts))))
Expand Down
46 changes: 44 additions & 2 deletions src/babashka/bbin/scripts.clj
Original file line number Diff line number Diff line change
Expand Up @@ -38,9 +38,51 @@
(filter second)
(into {})))

(defn- printable-scripts [scripts]
(map (fn [[bin {{lroot :local/root
gtag :git/tag
gsha :git/sha
gurl :git/url
burl :bbin/url} :coords}]]
(cond-> (assoc {} :bin bin)
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 [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 :version :location)
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]
(-> (load-scripts cli-opts)
(util/pprint cli-opts)))
(let [scripts (load-scripts cli-opts)]
(if (util/pretty-ls-enabled?)
(if (:edn cli-opts)
(util/pprint scripts cli-opts)
(print-scripts (printable-scripts scripts) cli-opts))
(util/pprint scripts cli-opts))))

(defn bin [cli-opts]
(println (str (util/bin-dir cli-opts))))
Expand Down
Loading

0 comments on commit 90ac56c

Please sign in to comment.