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