Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

bbin ls prints human readable text #54

Merged
merged 6 commits into from
Apr 8, 2023
Merged

bbin ls prints human readable text #54

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
439a58a
Ensure `bbin ls` prints no namespace maps
eval Feb 7, 2023
1e3057c
`bbin ls` now prints table, edn via flag --edn
eval Feb 23, 2023
938632b
Ensure ls-table can fit smaller screens`
eval Mar 24, 2023
17775b8
Reorder the columns
rads Apr 8, 2023
afd33ed
Add `BABASHKA_BBIN_FLAG_PRETTY_LS`
rads Apr 8, 2023
8b19c02
Revert `README` changes
rads Apr 8, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
229 changes: 226 additions & 3 deletions bbin
View file
Open in desktop
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
View file
Open in desktop
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