Add ability to strip ANSI codes out of a string

Change column code to only accept a string, and work with its visual length

src/io/aviso/ansi.clj

@@ -1,5 +1,6 @@
 (ns io.aviso.ansi
   "Help with generating textual output that includes ANSI escape codes for formatting."
+  (:import [java.util.regex Pattern])
   (:require [clojure.string :as str]))
 
 (def ^:const csi
@@ -69,4 +70,16 @@
 
 (def ^:const bold-font (str csi 1 sgr))
 (def ^:const italic-font (str csi 3 sgr))
-(def ^:const inverse-font (str csi 7 sgr))
+(def ^:const inverse-font (str csi 7 sgr))
+
+(def ^:const ^:private ansi-pattern (Pattern/compile "\\e\\[.*?m"))
+
+(defn strip-ansi
+  "Removes ANSI codes from a string, returning just the raw text."
+  [string]
+  (str/replace string ansi-pattern ""))
+
+(defn visual-length
+  "Returns the length of the string, with ANSI codes stripped out."
+  [string]
+  (-> string strip-ansi .length))

src/io/aviso/columns.clj

@@ -3,71 +3,85 @@
   may be left or right justified. Generally, columns are sized to the largest item in the column.
   When a value is provided in a column, it may be associated with an explicit width which is helpful
   when the value contains non-printing characters (such as those defined in the io.aviso.ansi namespace)."
-  (:require [io.aviso.writer :as w]))
-
-(defn- string-length [^String s] (.length s))
-
-(defn- decompose
-  [column-value]
-  (if (vector? column-value)
-    ;; Ensure that the column value is, in fact, a string.
-    [(nth column-value 0) (-> (nth column-value 1) str)]
-    (let [as-string (str column-value)]
-      [(string-length as-string) as-string])))
+  (:require
+    [clojure.string :as str]
+    [io.aviso
+     [ansi :as ansi]
+     [writer :as w]]))
 
 (defn- indent
   "Indents sufficient to pad the column value to the column width."
   [writer indent-amount]
   (w/write writer (apply str (repeat indent-amount \space))))
 
 (defn- truncate
-    [justification ^String string amount]
+  [justification ^String string amount]
   (cond
     (nil? amount) string
     (zero? amount) string
-    (= :left justification) (.substring string 0 (- (string-length string) amount))
+    (= :left justification) (.substring string 0 (- (.length string) amount))
     (= :right justification) (.substring string amount)
     :else string))
 
-(defn- write-column-value
+(defn- write-none-column [writer current-indent column-value]
+  (loop [first-line true
+         lines (-> column-value str str/split-lines)]
+    (when-not (empty? lines)
+      (when-not first-line
+        (w/writeln writer)
+        (indent writer current-indent))
+      (w/write writer (first lines))
+      (recur false (rest lines))))
+  ;; :none columns don't have an explicit width, so just return the current indent.
+  ;; it shouldn't matter because :none should be the last consuming column.
+  current-indent)
+
+(defn- make-column-writer
   [justification width]
-  (fn column-writer [writer column-value]
-    (let [[value-width value-string] (decompose column-value)
-          indent-amount (and width (max 0 (- width value-width)))
-          truncate-amount (and width (max 0 (- value-width width)))
-          truncated (truncate justification value-string truncate-amount)]
-      (if (and indent-amount (= justification :right))
-        (indent writer indent-amount))
-      (w/write writer truncated)
-      (if (and indent-amount (= justification :left))
-        (indent writer indent-amount)))))
+  (if (= :none justification)
+    write-none-column
+    (fn column-writer [writer current-indent column-value]
+      (let [value-string (str column-value)
+            value-width (ansi/visual-length value-string)
+            indent-amount (max 0 (- width value-width))
+            truncate-amount (max 0 (- value-width width))
+            ;; This isn't aware of ANSI escape codes and will do the wrong thing when truncating a string with
+            ;; such codes.
+            truncated (truncate justification value-string truncate-amount)]
+        (if (= justification :right)
+          (indent writer indent-amount))
+        (w/write writer truncated)
+        (if (= justification :left)
+          (indent writer indent-amount)))
+      ;; Return the updated indent amount; a :none column doesn't compute
+      (+ current-indent width))))
 
 (defn- fixed-column
   [fixed-value]
-  (fn [writer column-data]
-    (w/write writer fixed-value)
-    column-data))
+  (let [value-length (ansi/visual-length fixed-value)]
+    (fn [writer indent column-data]
+      (w/write writer fixed-value)
+      [(+ indent value-length) column-data])))
 
 (defn- dynamic-column
   "Returns a function that consumes the next column data value and delegates to a column writer function
   to actually write the output for the column."
   [column-writer]
-  (fn [writer [column-value & remaining-column-data]]
-    (column-writer writer column-value)
-    remaining-column-data))
+  (fn [writer indent [column-value & remaining-column-values]]
+    [(column-writer writer indent column-value) remaining-column-values]))
 
 (defn- nil-column
-  "Does nothing and returns the column data unchanged."
-  [writer column-data]
-  column-data)
+  "Does nothing and returns the indent and column data unchanged."
+  [writer indent column-values]
+  [indent column-values])
 
 (defn- column-def-to-fn [column-def]
   (cond
     (string? column-def) (fixed-column column-def)
-    (number? column-def) (-> (write-column-value :left column-def) dynamic-column)
+    (number? column-def) (-> (make-column-writer :left column-def) dynamic-column)
     (nil? column-def) nil-column
-    (= :none column-def) (-> (write-column-value :none nil) dynamic-column)
-    :else (-> (apply write-column-value column-def) dynamic-column)))
+    (= :none column-def) (-> (make-column-writer :none nil) dynamic-column)
+    :else (-> (apply make-column-writer column-def) dynamic-column)))
 
 (defn format-columns
   "Converts a number of column definitions into a formatting function. Each column definition may be:
@@ -88,22 +102,27 @@
   and :right truncates from the left (e.g., discards initial characters, display trailing characters).
   Generally speaking, truncation does not occur because columns are sized to fit their contents.
 
-  Values are normally strings, but to support non-printing characters in the strings, a value may
-  be a two-element vector consisting of its effective width and the actual value to write. Non-string
-  values are converted to strings using str.
+  An column width is required for :left or :right. Column width is optional and ignored for :none.
+
+  Values are normally string, but any type is accepted and will be converted to a string.
+  This code is aware of ANSI codes and ignores them to calculate the length of a value for formatting and
+  identation purposes.
+
+  There will likely be problems if a long string with ANSI codes is truncated, however.
 
-  The returned function accepts a Writer and the column data and writes each column value, with appropriate
+  The returned function accepts a Writer and the column values and writes each column value, with appropriate
   padding, to the Writer."
   [& column-defs]
   (let [column-fns (map column-def-to-fn column-defs)]
-    (fn [writer & column-data]
-      (loop [column-fns column-fns
-             column-data column-data]
+    (fn [writer & column-values]
+      (loop [current-indent 0
+             column-fns column-fns
+             values column-values]
         (if (empty? column-fns)
           (w/writeln writer)
           (let [cf (first column-fns)
-                remaining-column-data (cf writer column-data)]
-            (recur (rest column-fns) remaining-column-data)))))))
+                [new-indent remaining-values] (cf writer current-indent values)]
+            (recur new-indent (rest column-fns) remaining-values)))))))
 
 (defn write-rows
   "A convienience for writing rows of columns using a prepared column formatter.

src/io/aviso/exception.clj

@@ -11,24 +11,22 @@
              [columns :as c]
              [writer :as w]]))
 
-(defn- string-length
-  [^String s]
-  (.length s))
+(defn- length [^String s] (.length s))
 
 ;;; Obviously, this is making use of some internals of Clojure that
 ;;; could change at any time.
 
 (def ^:private clojure->java
   (->> (Compiler/CHAR_MAP)
        set/map-invert
-       (sort-by #(-> % first string-length))
+       (sort-by #(-> % first length))
        reverse))
 
 
 (defn- match-mangled
   [^String s i]
   (->> clojure->java
-       (filter (fn [[k _]] (.regionMatches s i k 0 (string-length k))))
+       (filter (fn [[k _]] (.regionMatches s i k 0 (length k))))
        ;; Return the matching sequence and its single character replacement
        first))
 
@@ -43,7 +41,7 @@
         (>= i in-length) (.toString result)
         (= \_ (.charAt s i)) (let [[match replacement] (match-mangled s i)]
                                (.append result replacement)
-                               (recur (+ i (string-length match))))
+                               (recur (+ i (length match))))
         :else (do
                 (.append result (.charAt s i))
                 (recur (inc i)))))))
@@ -109,34 +107,12 @@
   [coll]
   (if (empty? coll)
     0
-    (apply max (map string-length coll))))
+    (apply max (map visual-length coll))))
 
 (defn- max-value-length
   [coll key]
   (max-length (map key coll)))
 
-(defn- indent [writer spaces]
-  (w/write writer (apply str (repeat spaces \space))))
-
-(defn- justify
-  "w/write the text, right justified within its column."
-  ([writer width ^String value]
-   (indent writer (- width (-> value str .length)))
-   (w/write writer value))
-  ([writer width prefix ^String value suffix]
-   (indent writer (- width (.length value)))
-   (w/write writer prefix value suffix)))
-
-(defn- write-indented
-  [writer indent-amount value]
-  (loop [lines (str/split-lines value)
-         is-first true]
-    (when-not (empty? lines)
-      (if-not is-first
-        (indent writer indent-amount))
-      (w/writeln writer (first lines))
-      (recur (rest lines) false))))
-
 (defn- update-keys [m f]
   "Builds a map where f has been applied to each key in m."
   (into {} (map (fn [[k v]] [(f k) v]) m)))
@@ -219,11 +195,9 @@
       ;; Case 1: names is empty, it's a Java frame
       (let [full-name (str (:class element) "." (:method element))]
         (assoc element
-          :name-width (.length full-name)
           :formatted-name (str (:java-frame *fonts*) full-name (:reset *fonts*))))
       ;; Case 2: it's a Clojure name
       (assoc element
-        :name-width (.length (:name element))
         :formatted-name (str
                           (:clojure-frame *fonts*)
                           (->> names drop-last (str/join "/"))
@@ -233,17 +207,17 @@
 (defn- write-stack-trace
   [writer exception]
   (let [elements (->> exception expand-stack-trace (map preformat-stack-frame))
-        formatter (c/format-columns [:right (->> elements (map :name-width) (apply max))]
+        formatter (c/format-columns [:right (max-value-length elements :formatted-name)]
                                     "  " (:source *fonts*)
                                     [:right (max-value-length elements :file)]
                                     ": "
                                     [:right (->> elements (map :line) (map str) max-length)]
                                     (:reset *fonts*))]
-    (c/write-rows writer formatter [#(vector (:name-width %) (:formatted-name %)) :file :line] elements)))
+    (c/write-rows writer formatter [:formatted-name :file :line] elements)))
 
-(defn- write-property-value [writer value-indent value]
-  (write-indented writer value-indent
-                  (pp/write value :stream nil :length (or *print-length* 10))))
+(defn- format-property-value
+  [value]
+  (pp/write value :stream nil :length (or *print-length* 10)))
 
 (defn write-exception
   "Writes a formatted version of the exception to the writer.
@@ -262,32 +236,30 @@
          exception-stack (->> exception
                               analyze-exception
                               (map #(assoc % :name (-> % :exception class .getName))))
-         exception-column-width (max-value-length exception-stack :name)]
+         exception-formatter (c/format-columns [:right (max-value-length exception-stack :name)]
+                                               ": "
+                                               :none)]
      (doseq [e exception-stack]
        (let [^Throwable exception (-> e :exception)
-             message (.getMessage exception)]
-         (justify writer exception-column-width exception-font (:name e) reset-font)
-         ;; TODO: Handle no message for the exception specially
-         (w/write writer ":")
-         (if-not message
-           (w/writeln writer)
-           (do
-             (w/write writer " ")
-             (write-indented writer
-                             (+ 2 exception-column-width)
-                             (str message-font message reset-font))))
-
-         (let [properties (update-keys (:properties e) name)
-               prop-keys (keys properties)
-               ;; Allow for the width of the exception class name, and some extra
-               ;; indentation.
-               prop-name-width (+ 4 (max-length prop-keys))]
-           (doseq [k (sort prop-keys)]
-             (justify writer prop-name-width property-font k reset-font)
-             (w/write writer ": ")
-             (write-property-value writer (+ 2 prop-name-width) (get properties k)))
-           (if (:root e)
-             (write-stack-trace writer exception))))))))
+             class-name (:name e)
+             message (.getMessage exception)
+             properties (update-keys (:properties e) name)
+             prop-keys (keys properties)
+             ;; Allow for the width of the exception class name, and some extra
+             ;; indentation.
+             property-formatter (c/format-columns "    "
+                                                  [:right (max-length prop-keys)]
+                                                  ": "
+                                                  :none)]
+         (exception-formatter writer
+                              (str exception-font class-name reset-font)
+                              (str message-font message reset-font))
+         (doseq [k (sort prop-keys)]
+           (property-formatter writer
+                               (str property-font k reset-font)
+                               (-> properties (get k) format-property-value)))
+         (if (:root e)
+           (write-stack-trace writer exception)))))))
 
 (defn format-exception
   "Formats an exception as a multi-line string using write-exception."