1;; A pretty-printer that outputs tables in Fennel syntax.
2;; Loosely based on inspect.lua: http://github.com/kikito/inspect.lua
3
4(local quote (fn [str] (.. '"' (: str :gsub '"' '\\"') '"')))
5
6(local short-control-char-escapes
7       {"\a" "\\a" "\b" "\\b" "\f" "\\f" "\n" "\\n"
8        "\r" "\\r" "\t" "\\t" "\v" "\\v"})
9
10(local long-control-char-esapes
11       (let [long {}]
12         (for [i 0 31]
13           (let [ch (string.char i)]
14             (when (not (. short-control-char-escapes ch))
15               (tset short-control-char-escapes ch (.. "\\" i))
16               (tset long ch (: "\\%03d" :format i)))))
17         long))
18
19(fn escape [str]
20  (let [str (: str :gsub "\\" "\\\\")
21        str (: str :gsub "(%c)%f[0-9]" long-control-char-esapes)]
22    (: str :gsub "%c" short-control-char-escapes)))
23
24(fn sequence-key? [k len]
25  (and (= (type k) "number")
26       (<= 1 k)
27       (<= k len)
28       (= (math.floor k) k)))
29
30(local type-order {:number 1 :boolean 2 :string 3 :table 4
31                   :function 5 :userdata 6 :thread 7})
32
33(fn sort-keys [a b]
34  (let [ta (type a) tb (type b)]
35    (if (and (= ta tb) (~= ta "boolean")
36             (or (= ta "string") (= ta "number")))
37        (< a b)
38        (let [dta (. type-order a)
39              dtb (. type-order b)]
40          (if (and dta dtb)
41              (< dta dtb)
42              dta true
43              dtb false
44              :else (< ta tb))))))
45
46(fn get-sequence-length [t]
47  (var len 1)
48  (each [i (ipairs t)] (set len i))
49  len)
50
51(fn get-nonsequential-keys [t]
52  (let [keys {}
53        sequence-length (get-sequence-length t)]
54    (each [k (pairs t)]
55      (when (not (sequence-key? k sequence-length))
56        (table.insert keys k)))
57    (table.sort keys sort-keys)
58    (values keys sequence-length)))
59
60(fn count-table-appearances [t appearances]
61  (if (= (type t) "table")
62      (when (not (. appearances t))
63        (tset appearances t 1)
64        (each [k v (pairs t)]
65          (count-table-appearances k appearances)
66          (count-table-appearances v appearances)))
67      (when (and t (= t t)) ; no nans please
68        (tset appearances t (+ (or (. appearances t) 0) 1))))
69  appearances)
70
71
72
73(var put-value nil) ; mutual recursion going on; defined below
74
75(fn puts [self ...]
76  (each [_ v (ipairs [...])]
77    (table.insert self.buffer v)))
78
79(fn tabify [self] (puts self "\n" (: self.indent :rep self.level)))
80
81(fn already-visited? [self v] (~= (. self.ids v) nil))
82
83(fn get-id [self v]
84  (var id (. self.ids v))
85  (when (not id)
86    (let [tv (type v)]
87      (set id (+ (or (. self.max-ids tv) 0) 1))
88      (tset self.max-ids tv id)
89      (tset self.ids v id)))
90  (tostring id))
91
92(fn put-sequential-table [self t length]
93  (puts self "[")
94  (set self.level (+ self.level 1))
95  (for [i 1 length]
96    (puts self " ")
97    (put-value self (. t i)))
98  (set self.level (- self.level 1))
99  (puts self " ]"))
100
101(fn put-key [self k]
102  (if (and (= (type k) "string")
103           (: k :find "^[-%w?\\^_`!#$%&*+./@~:|<=>]+$"))
104      (puts self ":" k)
105      (put-value self k)))
106
107(fn put-kv-table [self t]
108  (puts self "{")
109  (set self.level (+ self.level 1))
110  (each [k v (pairs t)]
111    (tabify self)
112    (put-key self k)
113    (puts self " ")
114    (put-value self v))
115  (set self.level (- self.level 1))
116  (tabify self)
117  (puts self "}"))
118
119(fn put-table [self t]
120  (if (already-visited? self t)
121      (puts self "#<table " (get-id self t) ">")
122      (>= self.level self.depth)
123      (puts self "{...}")
124      :else
125      (let [(non-seq-keys length) (get-nonsequential-keys t)
126            id (get-id self t)]
127        (if (> (. self.appearances t) 1)
128            (puts self "#<" id ">")
129            (and (= (# non-seq-keys) 0) (= (# t) 0))
130            (puts self "{}")
131            (= (# non-seq-keys) 0)
132            (put-sequential-table self t length)
133            :else
134            (put-kv-table self t)))))
135
136(set put-value (fn [self v]
137                 (let [tv (type v)]
138                   (if (= tv "string")
139                       (puts self (quote (escape v)))
140                       (or (= tv "number") (= tv "boolean") (= tv "nil"))
141                       (puts self (tostring v))
142                       (= tv "table")
143                       (put-table self v)
144                       :else
145                       (puts self "#<" (tostring v) ">")))))
146
147
148
149(fn fennelview [root options]
150  (let [options (or options {})
151        inspector {:appearances (count-table-appearances root {})
152                   :depth (or options.depth 128)
153                   :level 0 :buffer {} :ids {} :max-ids {}
154                   :indent (or options.indent "  ")}]
155    (put-value inspector root)
156    (table.concat inspector.buffer)))
157