summaryrefslogtreecommitdiff
path: root/tests/examplefiles/fennelview.fnl
diff options
context:
space:
mode:
Diffstat (limited to 'tests/examplefiles/fennelview.fnl')
-rw-r--r--tests/examplefiles/fennelview.fnl156
1 files changed, 0 insertions, 156 deletions
diff --git a/tests/examplefiles/fennelview.fnl b/tests/examplefiles/fennelview.fnl
deleted file mode 100644
index fd0fc648..00000000
--- a/tests/examplefiles/fennelview.fnl
+++ /dev/null
@@ -1,156 +0,0 @@
-;; A pretty-printer that outputs tables in Fennel syntax.
-;; Loosely based on inspect.lua: http://github.com/kikito/inspect.lua
-
-(local quote (fn [str] (.. '"' (: str :gsub '"' '\\"') '"')))
-
-(local short-control-char-escapes
- {"\a" "\\a" "\b" "\\b" "\f" "\\f" "\n" "\\n"
- "\r" "\\r" "\t" "\\t" "\v" "\\v"})
-
-(local long-control-char-esapes
- (let [long {}]
- (for [i 0 31]
- (let [ch (string.char i)]
- (when (not (. short-control-char-escapes ch))
- (tset short-control-char-escapes ch (.. "\\" i))
- (tset long ch (: "\\%03d" :format i)))))
- long))
-
-(fn escape [str]
- (let [str (: str :gsub "\\" "\\\\")
- str (: str :gsub "(%c)%f[0-9]" long-control-char-esapes)]
- (: str :gsub "%c" short-control-char-escapes)))
-
-(fn sequence-key? [k len]
- (and (= (type k) "number")
- (<= 1 k)
- (<= k len)
- (= (math.floor k) k)))
-
-(local type-order {:number 1 :boolean 2 :string 3 :table 4
- :function 5 :userdata 6 :thread 7})
-
-(fn sort-keys [a b]
- (let [ta (type a) tb (type b)]
- (if (and (= ta tb) (~= ta "boolean")
- (or (= ta "string") (= ta "number")))
- (< a b)
- (let [dta (. type-order a)
- dtb (. type-order b)]
- (if (and dta dtb)
- (< dta dtb)
- dta true
- dtb false
- :else (< ta tb))))))
-
-(fn get-sequence-length [t]
- (var len 1)
- (each [i (ipairs t)] (set len i))
- len)
-
-(fn get-nonsequential-keys [t]
- (let [keys {}
- sequence-length (get-sequence-length t)]
- (each [k (pairs t)]
- (when (not (sequence-key? k sequence-length))
- (table.insert keys k)))
- (table.sort keys sort-keys)
- (values keys sequence-length)))
-
-(fn count-table-appearances [t appearances]
- (if (= (type t) "table")
- (when (not (. appearances t))
- (tset appearances t 1)
- (each [k v (pairs t)]
- (count-table-appearances k appearances)
- (count-table-appearances v appearances)))
- (when (and t (= t t)) ; no nans please
- (tset appearances t (+ (or (. appearances t) 0) 1))))
- appearances)
-
-
-
-(var put-value nil) ; mutual recursion going on; defined below
-
-(fn puts [self ...]
- (each [_ v (ipairs [...])]
- (table.insert self.buffer v)))
-
-(fn tabify [self] (puts self "\n" (: self.indent :rep self.level)))
-
-(fn already-visited? [self v] (~= (. self.ids v) nil))
-
-(fn get-id [self v]
- (var id (. self.ids v))
- (when (not id)
- (let [tv (type v)]
- (set id (+ (or (. self.max-ids tv) 0) 1))
- (tset self.max-ids tv id)
- (tset self.ids v id)))
- (tostring id))
-
-(fn put-sequential-table [self t length]
- (puts self "[")
- (set self.level (+ self.level 1))
- (for [i 1 length]
- (puts self " ")
- (put-value self (. t i)))
- (set self.level (- self.level 1))
- (puts self " ]"))
-
-(fn put-key [self k]
- (if (and (= (type k) "string")
- (: k :find "^[-%w?\\^_`!#$%&*+./@~:|<=>]+$"))
- (puts self ":" k)
- (put-value self k)))
-
-(fn put-kv-table [self t]
- (puts self "{")
- (set self.level (+ self.level 1))
- (each [k v (pairs t)]
- (tabify self)
- (put-key self k)
- (puts self " ")
- (put-value self v))
- (set self.level (- self.level 1))
- (tabify self)
- (puts self "}"))
-
-(fn put-table [self t]
- (if (already-visited? self t)
- (puts self "#<table " (get-id self t) ">")
- (>= self.level self.depth)
- (puts self "{...}")
- :else
- (let [(non-seq-keys length) (get-nonsequential-keys t)
- id (get-id self t)]
- (if (> (. self.appearances t) 1)
- (puts self "#<" id ">")
- (and (= (# non-seq-keys) 0) (= (# t) 0))
- (puts self "{}")
- (= (# non-seq-keys) 0)
- (put-sequential-table self t length)
- :else
- (put-kv-table self t)))))
-
-(set put-value (fn [self v]
- (let [tv (type v)]
- (if (= tv "string")
- (puts self (quote (escape v)))
- (or (= tv "number") (= tv "boolean") (= tv "nil"))
- (puts self (tostring v))
- (= tv "table")
- (put-table self v)
- :else
- (puts self "#<" (tostring v) ">")))))
-
-
-
-(fn fennelview [root options]
- (let [options (or options {})
- inspector {:appearances (count-table-appearances root {})
- :depth (or options.depth 128)
- :level 0 :buffer {} :ids {} :max-ids {}
- :indent (or options.indent " ")}]
- (put-value inspector root)
- (table.concat inspector.buffer)))