~technomancy/fennel

ref: 8cf5bb8eab82d80ffc2c135d32135d07f06ef61e fennel/fennelview.fnl -rw-r--r-- 12.3 KiB
8cf5bb8eAndrey Orst fennelview rewrite 5 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
;; A pretty-printer that outputs tables in Fennel syntax.

(local type-order {:number 1 :boolean 2 :string 3 :table 4
                   :function 5 :userdata 6 :thread 7})

(fn sort-keys [[a] [b]]
  ;; Sort keys depending on the `type-order`.
  (let [ta (type a) tb (type b)]
    (if (and (= ta tb)
             (or (= ta "string") (= ta "number")))
        (< a b)
        (let [dta (. type-order ta)
              dtb (. type-order tb)]
          (if (and dta dtb) (< dta dtb)
              dta true
              dtb false
              false)))))

(fn table-kv-pairs [t]
  ;; Return table of tables with first element representing key and second
  ;; element representing value.  Second value indicates table type, which is
  ;; either sequential or associative.

  ;; [:a :b :c] => [[1 :a] [2 :b] [3 :c]]
  ;; {:a 1 :b 2} => [[:a 1] [:b 2]]
  (var assoc? false)
  (let [kv []
        insert table.insert]
    (each [k v (pairs t)]
      (when (not= (type k) :number)
        (set assoc? true))
      (insert kv [k v]))
    (table.sort kv sort-keys)
    (if (= (length kv) 0)
        (values kv :empty)
        (values kv (if assoc? :table :seq)))))

(fn count-table-appearances [t appearances]
  (when (= (type t) :table)
    (if (not (. appearances t))
        (do (tset appearances t 1)
            (each [k v (pairs t)]
              (count-table-appearances k appearances)
              (count-table-appearances v appearances)))
        (tset appearances t (+ (or (. appearances t) 0) 1))))
  appearances)

(fn save-table [t seen]
  ;; Save table `t` in `seen` storing `t` as key, and its index as an id.
  (let [seen (or seen {:len 0})
        id (+ seen.len 1)]
    (when (not (. seen t))
      (tset seen t id)
      (set seen.len id))
    seen))

(fn detect-cycle [t seen]
  ;; Return `true` if table `t` appears in itself.
  (let [seen (or seen {})]
    (tset seen t true)
    (each [k v (pairs t)]
      (when (and (= (type k) :table)
                 (or (. seen k) (detect-cycle k seen)))
        (lua "return true"))
      (when (and (= (type v) :table)
                 (or (. seen v) (detect-cycle v seen)))
        (lua "return true")))))

(fn visible-cycle? [t options]
  ;; Detect cycle, save table's ID in seen tables, and determine if
  ;; cycle is visible.  Exposed via options table to use in
  ;; __fennelview metamethod implementations
  (and options.detect-cycles?
       (detect-cycle t)
       (save-table t options.seen)
       (< 1 (or (. options.appearances t) 0))))

(fn table-indent [t indent id]
  ;; When table contains cycles, it is printed with a prefix before opening
  ;; delimiter.  Prefix has a variable length, as it contains `id` of the table
  ;; and fixed part of `2` characters `@` and either `[` or `{` depending on
  ;; `t`type.  If `t` has visible cycles, we need to increase indent by the size
  ;; of the prefix.
  (let [opener-length (if id
                          (+ (length (tostring id)) 2)
                          1)]
    (+ indent opener-length)))

(local pp {})

(fn concat-table-lines
  [elements options multiline? indent table-type prefix]
  (.. (or prefix "")
      (if (= :seq table-type) "[" "{")
      (table.concat
       elements
       (if (and (not options.one-line?)
                (or multiline?
                    (> (length elements) (if (= table-type :seq)
                                             options.sequential-length
                                             options.associative-length))
                    (> indent 40)))
           (.. "\n" (string.rep " " indent))
           " "))
      (if (= :seq table-type) "]" "}")))

(fn pp-associative [t kv options indent key?]
  (var multiline? false)
  (let [elements []
        id (. options.seen t)]
    (if (>= options.level options.depth) "{...}"
        (and id options.detect-cycles?) (.. "@" id "{...}")
        (let [visible-cycle? (visible-cycle? t options)
              id (and visible-cycle? (. options.seen t))
              indent (table-indent t indent id)
              slength (or (and options.utf8? (-?> (rawget _G :utf8) (. :len)))
                          #(length $))
              prefix (if visible-cycle? (.. "@" id) "")]
          (each [i [k v] (pairs kv)]
            (when (or (= (type k) :table) (= (type v) :table))
              (set multiline? true))
            (let [k (pp.pp k options (+ indent 1) true)
                  v (pp.pp v options (+ indent (slength k) 1))]
              (table.insert elements (.. k " " v))))
          (concat-table-lines
           elements options multiline? indent :table prefix)))))

(fn pp-sequence [t kv options indent]
  (var multiline? false)
  (let [elements []
        id (. options.seen t)]
    (if (>= options.level options.depth) "[...]"
        (and id options.detect-cycles?) (.. "@" id "[...]")
        (let [visible-cycle? (visible-cycle? t options)
              id (and visible-cycle? (. options.seen t))
              indent (table-indent t indent id)
              prefix (if visible-cycle? (.. "@" id) "")]
          (each [_ [_ v] (pairs kv)]
            (when (= (type v) :table)
              (set multiline? true))
            (table.insert elements (pp.pp v options indent)))
          (concat-table-lines
           elements options multiline? indent :seq prefix)))))

(fn concat-lines [lines options indent one-line?]
  (if (= (length lines) 0)
      (if options.empty-as-sequence? "[]" "{}")
      (if (and (not options.one-line?)
               (not one-line?))
          (table.concat lines (.. "\n" (string.rep " " indent)))
          (-> (icollect [_ line (ipairs lines)]
                (line:gsub "^%s+" " "))
              table.concat))))

(fn pp-metamethod [t metamethod options indent]
  (if (>= options.level options.depth)
      (if options.empty-as-sequence? "[...]" "{...}")
      (let [_ (set options.visible-cycle? #(visible-cycle? $ options))
            (lines force-one-line?) (metamethod t pp.pp options indent)]
        (set options.visible-cycle? nil)
        (match (type lines)
          :string lines ;; assuming that it is already single line
          :table  (concat-lines lines options indent force-one-line?)
          _ (error "Error: __fennelview metamethod must return a table of lines")))))

(fn pp-table [x options indent]
  ;; Generic table pretty-printer.  Supports associative and
  ;; sequential tables, as well as tables, that contain __fennelview
  ;; metamethod.
  (set options.level (+ options.level 1))
  (let [x (match (if options.metamethod? (-?> x getmetatable (. :__fennelview)))
            metamethod (pp-metamethod x metamethod options indent)
            _ (match (table-kv-pairs x)
                (_ :empty) (if options.empty-as-sequence? "[]" "{}")
                (kv :table) (pp-associative x kv options indent)
                (kv :seq) (pp-sequence x kv options indent)))]
    (set options.level (- options.level 1))
    x))



(fn number->string [n]
  ;; Transform number to a string without depending on correct `os.locale`
  (match (math.modf n)
    (int 0) (tostring int)
    ((0 frac) ? (< frac 0)) (.. "-0." (: (tostring frac) :gsub "^-?0." ""))
    (int frac) (.. int "." (: (tostring frac) :gsub "^-?0." ""))))

(fn colon-string? [s]
  ;; Test if given string is valid colon string.
  (s:find "^[-%w?\\^_!$%&*+./@:|<=>]+$"))



(fn make-options [t options]
  (let [;; defaults are used when options are not provided
        defaults {:sequential-length 10
                  :associative-length 4
                  :one-line? false
                  :depth 128
                  :detect-cycles? true
                  :empty-as-sequence? false
                  :metamethod? true
                  :utf8? true}
        ;; overrides can't be accessed via options
        overrides {:level 0
                   :appearances (count-table-appearances t {})
                   :seen {:len 0}}]
    (each [k v (pairs (or options {}))]
      (tset defaults k v))
    (each [k v (pairs overrides)]
      (tset defaults k v))
    defaults))

(fn pp.pp [x options indent key?]
  ;; main serialization loop, entry point is defined below
  (let [indent (or indent 0)
        options (or options (make-options x))
        tv (type x)]
    (if (or (= tv :table)
            (and (= tv :userdata)
                 (-?> (getmetatable x) (. :__fennelview))))
        (pp-table x options indent)
        (= tv :number)
        (number->string x)
        (and (= tv :string) key? (colon-string? x))
        (.. ":" x)
        (= tv :string)
        (string.format "%q" x)
        (or (= tv :boolean) (= tv :nil))
        (tostring x)
        (.. "#<" (tostring x) ">"))))

(fn fennelview [x options]
  "Return a string representation of x.

Can take an options table with these keys:
* :one-line? (boolean: default: false) keep the output string as a one-liner
* :depth (number, default: 128) limit how many levels to go (default: 128)
* :detect-cycles? (boolean, default: true) don't try to traverse a looping table
* :metamethod? (boolean: default: true) use the __fennelview metamethod if found
* :empty-as-sequence? (boolean, default: false) render empty tables as []
* :sequential-length (number, default: 10) amount of elements at which
  multi-line sequence ouptut is produced.
* :associative-length (number, default: 4) amount of elements at which
  multi-line table ouptut is produced.
* :utf8? (boolean, default true) whether to use utf8 module to compute string
  lengths

The __fennelview metamethod should take the table being serialized as its first
argument, a function as its second argument, options table as third argument,
and current amount of indentation as its last argument:

(fn [t view inspector indent] ...)

`view` function contains pretty printer, that can be used to serialize elements
stored within the table being serialized.  If your metamethod produces indented
representation, you should pass `indent` parameter to `view` increased by the
amount of addition indentation you've introduced.

`inspector` table contains options described above, and also `visible-cycle?`
function, that takes a table being serialized, detects and saves information
about possible reachable cycle.  Should be used in __fennelview to implement
cycle detection.

`__fennelview` metamethod should always return a table of correctly indented
lines when producing multi-line output, or a string when returning single-line
item. If single-line representation is needed in some cases, there's no need to
concatenate table manually, instead `__fennelview` should return two values - a
table of lines, and a boolean indicating if one-line representation should be
forced.

There's no need to incorporate indentation beyond needed to correctly align
elements within the printed representation of your data structure.  For example,
if you want to print a multi-line table, like this:

@my-table[1
          2
          3]

__fennelview should return a sequence of lines:

[\"@my-table[1\"
 \"          2\"
 \"          3]\"]

Note, since we've introduced inner indent string of length 10, when calling
`view` function from within __fennelview metamethod, in order to keep inner
tables indented correctly, `indent` must be increased by this amount of extra
indentation.

`view` function also accepts additional boolean argument, which controls if
strings should be printed as a colon-strings when possible. Set it to `true`
when `view` is being called on the key of a table.

Here's an implementation of such pretty-printer for an arbitrary sequential
table:

(fn pp-doc-example [t view inspector indent]
  (let [lines (icollect [i v (ipairs t)]
                (let [v (view v inspector (+ 10 indent))]
                  (if (= i 1) v
                      (.. \"          \" v))))]
    (doto lines
      (tset 1 (.. \"@my-table[\" (or (. lines 1) \"\")))
      (tset (length lines) (.. (. lines (length lines)) \"]\")))))

Setting table's __fennelview metamethod to this function will provide correct
results regardless of nesting:

>> {:my-table (setmetatable [{:a {} :b [[1] [2]]} 3]
                            {:__fennelview pp-doc-example})
    :normal-table [{:c [1 2 3] :d :some-data} 4]}
{:my-table @my-table[{:a {}
                      :b [[1]
                          [2]]}
                     3]
 :normal-table [{:c [1 2 3]
                 :d \"some-data\"}
                4]}

Note that even though we've only indented inner elements of our table with 10
spaces, the result is correctly indented in terms of outer table, and inner
tables also remain indented correctly.
"
  (pp.pp x (make-options x options) 0))