|
| 1 | +(ns clj-commons.pretty.annotations |
| 2 | + "Tools to annotate a line of source code, in the form of callouts (lines and arrows) connected to a message. |
| 3 | +
|
| 4 | + SELECT DATE, AMT FROM PAYMENTS WHEN AMT > 10000 |
| 5 | + ▲▲▲ ▲▲▲▲ |
| 6 | + │ │ |
| 7 | + │ └╴ Unknown token |
| 8 | + │ |
| 9 | + └╴ Invalid column name |
| 10 | +
|
| 11 | + This kind of output is common with various kinds of parsers or interpreters. |
| 12 | +
|
| 13 | + Specs for types and functions are in the [[spec]] namespace." |
| 14 | + {:added "3.3.0"}) |
| 15 | + |
| 16 | +(def default-style |
| 17 | + "The default style used when generating callouts. |
| 18 | +
|
| 19 | + Key | Default | Description |
| 20 | + --- |--- |--- |
| 21 | + :font | :yellow | Default font characteristics if not overrided by annotation |
| 22 | + :spacing | :tall | One of :tall, :compact, or :minimal |
| 23 | + :marker | \"▲\" | The marker character used to identify the offset/length of an annotation |
| 24 | + :bar | \"│\" | Character used as the vertical bar in the callout |
| 25 | + :nib | \"└╴ \" | String used just before the annotation's message |
| 26 | +
|
| 27 | + When :spacing is :minimal, only the lines with markers or error messages appear |
| 28 | + (the lines with just vertical bars are omitted). :compact spacing is the same, but |
| 29 | + one line of bars appears between the markers and the first annotation message. |
| 30 | +
|
| 31 | + Note: rendering of Unicode characters in HTML often uses incorrect fonts or adds unwanted |
| 32 | + character spacing; the annotations look proper in console output." |
| 33 | + {:font :yellow |
| 34 | + :spacing :tall |
| 35 | + :marker "▲" |
| 36 | + :bar "│" |
| 37 | + :nib "└╴ "}) |
| 38 | + |
| 39 | +(def ^:dynamic *default-style* |
| 40 | + "The default style used when no style is provided; some applications may bind or |
| 41 | + override this." |
| 42 | + default-style) |
| 43 | + |
| 44 | +(defn- nchars |
| 45 | + [n ch] |
| 46 | + (apply str (repeat n ch))) |
| 47 | + |
| 48 | +(defn- markers |
| 49 | + [style annotations] |
| 50 | + (let [{:keys [font marker]} style] |
| 51 | + (loop [output-offset 0 |
| 52 | + annotations annotations |
| 53 | + result [font]] |
| 54 | + (if-not annotations |
| 55 | + result |
| 56 | + (let [{:keys [offset length font] |
| 57 | + :or {length 1}} (first annotations) |
| 58 | + spaces-needed (- offset output-offset) |
| 59 | + result' (conj result |
| 60 | + (nchars spaces-needed \space) |
| 61 | + [font (nchars length marker)])] |
| 62 | + (recur (+ offset length) |
| 63 | + (next annotations) |
| 64 | + result')))))) |
| 65 | + |
| 66 | +(defn- bars |
| 67 | + [style annotations] |
| 68 | + (let [{:keys [font bar]} style] |
| 69 | + (loop [output-offset 0 |
| 70 | + annotations annotations |
| 71 | + result [font]] |
| 72 | + (if-not annotations |
| 73 | + result |
| 74 | + (let [{:keys [offset font]} (first annotations) |
| 75 | + spaces-needed (- offset output-offset) |
| 76 | + result' (conj result |
| 77 | + (nchars spaces-needed \space) |
| 78 | + [font bar])] |
| 79 | + (recur (+ offset 1) |
| 80 | + (next annotations) |
| 81 | + result')))))) |
| 82 | + |
| 83 | +(defn- bars+message |
| 84 | + [style annotations] |
| 85 | + (let [{:keys [font bar nib]} style] |
| 86 | + (loop [output-offset 0 |
| 87 | + [annotation & more-annotations] annotations |
| 88 | + result [font]] |
| 89 | + (let [{:keys [offset font message]} annotation |
| 90 | + spaces-needed (- offset output-offset) |
| 91 | + last? (not (seq more-annotations)) |
| 92 | + result' (conj result |
| 93 | + (nchars spaces-needed \space) |
| 94 | + [font |
| 95 | + (if last? |
| 96 | + nib |
| 97 | + bar) |
| 98 | + (when last? |
| 99 | + message)])] |
| 100 | + (if last? |
| 101 | + result' |
| 102 | + (recur (+ offset 1) |
| 103 | + more-annotations |
| 104 | + result')))))) |
| 105 | + |
| 106 | +(defn callouts |
| 107 | + "Creates callouts (the marks, bars, and messages from the example) from annotations. |
| 108 | +
|
| 109 | + Each annotation is a map: |
| 110 | +
|
| 111 | + Key | Description |
| 112 | + --- |--- |
| 113 | + :message | Composed string of the message to present |
| 114 | + :offset | Integer position (from 0) to mark on the line |
| 115 | + :length | Number of characters in the marker (min 1, defaults to 1) |
| 116 | + :font | Override of the style's font; used for marker, bars, nib, and message |
| 117 | +
|
| 118 | + The leftmost column has offset 0; some frameworks may report this as column 1 |
| 119 | + and an adjustment is necessary before invoking callouts. |
| 120 | +
|
| 121 | + At least one annotation is required; they will be sorted into an appropriate order. |
| 122 | + Annotation's ranges should not overlap. |
| 123 | +
|
| 124 | + The messages should be relatively short, and not contain any line breaks. |
| 125 | +
|
| 126 | + Returns a sequence of composed strings, one for each line of output. |
| 127 | +
|
| 128 | + The calling code is responsible for any output; even the line being annotated; |
| 129 | + this might look something like: |
| 130 | +
|
| 131 | + (ansi/perr source-line) |
| 132 | + (run! ansi/perr (annotations/annotate annotations)) |
| 133 | +
|
| 134 | + Uses the style defined by [[*default-style*]] if no style is provided." |
| 135 | + ([annotations] |
| 136 | + (callouts *default-style* annotations)) |
| 137 | + ([style annotations] |
| 138 | + ;; TODO: Check for overlaps |
| 139 | + (let [expanded (sort-by :offset annotations) |
| 140 | + {:keys [spacing]} style |
| 141 | + marker-line (markers style expanded)] |
| 142 | + (loop [annotations expanded |
| 143 | + first? true |
| 144 | + result [marker-line]] |
| 145 | + (let [include-bars? (or (= spacing :tall) |
| 146 | + (and first? (= spacing :compact))) |
| 147 | + result' (conj result |
| 148 | + (when include-bars? |
| 149 | + (bars style annotations)) |
| 150 | + (bars+message style annotations)) |
| 151 | + annotations' (butlast annotations)] |
| 152 | + (if (seq annotations') |
| 153 | + (recur annotations' false result') |
| 154 | + (remove nil? result'))))))) |
| 155 | + |
| 156 | +(defn annotate-lines |
| 157 | + "Intersperses numbered lines with callouts to form a new sequence |
| 158 | + of composable strings where input lines are numbered, and |
| 159 | + callout lines are indented beneath the input lines. |
| 160 | +
|
| 161 | + Example: |
| 162 | +
|
| 163 | + ``` |
| 164 | + 1: SELECT DATE, AMT |
| 165 | + ▲▲▲ |
| 166 | + │ |
| 167 | + └╴ Invalid column name |
| 168 | + 2: FROM PAYMENTS WHEN AMT > 10000 |
| 169 | + ▲▲▲▲ |
| 170 | + │ |
| 171 | + └╴ Unknown token |
| 172 | + ``` |
| 173 | + Each line is a map: |
| 174 | +
|
| 175 | + Key | Value |
| 176 | + --- |--- |
| 177 | + :line | Composed string for a single line of input (usually, just a string) |
| 178 | + :annotations | Optional, a seq of annotation maps (used to create the callouts) |
| 179 | +
|
| 180 | + Option keys are all optional: |
| 181 | +
|
| 182 | + Key | Value |
| 183 | + --- |--- |
| 184 | + :style | style map (for callouts), defaults to [*default-style*] |
| 185 | + :start-line | Defaults to 1 |
| 186 | + :line-number-width | Width for the line numbers column |
| 187 | +
|
| 188 | + The :line-number-width option is usually computed from the maximum line number |
| 189 | + that will be output. |
| 190 | +
|
| 191 | + Returns a seq of composed strings." |
| 192 | + ([lines] |
| 193 | + (annotate-lines nil lines)) |
| 194 | + ([opts lines] |
| 195 | + (let [{:keys [style start-line] |
| 196 | + :or {style *default-style* |
| 197 | + start-line 1}} opts |
| 198 | + max-line-number (+ start-line (count lines) -1) |
| 199 | + ;; inc by one to account for the ':' |
| 200 | + line-number-width (inc (or (:line-number-width opts) |
| 201 | + (-> max-line-number str count))) |
| 202 | + callout-indent (repeat (nchars (inc line-number-width) " "))] |
| 203 | + (loop [[line-data & more-lines] lines |
| 204 | + line-number start-line |
| 205 | + result []] |
| 206 | + (if-not line-data |
| 207 | + result |
| 208 | + (let [{:keys [line annotations]} line-data |
| 209 | + callout-lines (when (seq annotations) |
| 210 | + (callouts style annotations)) |
| 211 | + result' (cond-> (conj result |
| 212 | + (list |
| 213 | + [{:width line-number-width} |
| 214 | + line-number ":"] |
| 215 | + " " |
| 216 | + line)) |
| 217 | + callout-lines (into |
| 218 | + (map list callout-indent callout-lines)))] |
| 219 | + (recur more-lines (inc line-number) result'))))))) |
| 220 | + |
0 commit comments