mirror of https://github.com/status-im/reagent.git
136 lines
4.2 KiB
Clojure
136 lines
4.2 KiB
Clojure
(ns reagentdemo.syntax
|
|
(:require [clojure.java.io :as io]
|
|
[clojure.string :as string]))
|
|
|
|
|
|
;;;;; Colorization
|
|
|
|
(def builtins #{"def" "defn" "ns" "atom" "let" "if" "when"
|
|
"cond" "merge" "assoc" "swap!" "reset!" "for"
|
|
"range" "nil?" "int" "or" "->" "->>" "%" "fn" "if-not"
|
|
"empty?" "case" "str" "pos?" "zero?" "map" "remove"
|
|
"empty" "into" "assoc-in" "dissoc" "get-in" "when-not"
|
|
"filter" "vals" "count" "complement" "identity" "dotimes"
|
|
"update-in" "sorted-map" "inc" "dec" "false" "true" "not"
|
|
"=" "partial" "first" "second" "rest" "list" "conj"
|
|
"drop" "when-let" "if-let" "add-watch" "mod" "quot"
|
|
"bit-test" "vector"})
|
|
|
|
(def me "reagentdemo.syntax")
|
|
|
|
(def styles {:comment (symbol me "comment-span")
|
|
:str-litt (symbol me "string-span")
|
|
:keyw (symbol me "keyword-span")
|
|
:builtin (symbol me "builtin-span")
|
|
:def (symbol me "def-span")})
|
|
|
|
(def paren-styles [(symbol me "paren-span-1")
|
|
(symbol me "paren-span-2")
|
|
(symbol me "paren-span-3")])
|
|
|
|
(defn tokenize [src]
|
|
(let [ws " \\t\\n"
|
|
open "\\[({"
|
|
close ")\\]}"
|
|
sep (str ws open close)
|
|
comment-p ";.*"
|
|
str-p "\"[^\"]*\""
|
|
open-p (str "[" open "]")
|
|
close-p (str "[" close "]")
|
|
iden-p (str "[^" sep "]+")
|
|
meta-p (str "\\^" iden-p)
|
|
any-p (str "[" ws "]+" "|\\^[^" sep "]+|.")
|
|
patt (re-pattern (str "("
|
|
(string/join ")|(" [comment-p str-p open-p
|
|
close-p meta-p iden-p any-p])
|
|
")"))
|
|
keyw-re #"^:"]
|
|
(for [[s comment str-litt open close met iden any] (re-seq patt src)]
|
|
(cond
|
|
comment [:comment s]
|
|
str-litt [:str-litt s]
|
|
open [:open s]
|
|
close [:close s]
|
|
met [:other s]
|
|
iden (cond
|
|
(re-find keyw-re s) [:keyw s]
|
|
(builtins s) [:builtin s]
|
|
:else [:iden s])
|
|
any [:other s]))))
|
|
|
|
(defn syntaxify [src]
|
|
(let [def-re #"^def|^ns\b"
|
|
ncol (count paren-styles)
|
|
paren-style (fn [level]
|
|
(nth paren-styles (mod level ncol)))]
|
|
(loop [tokens (tokenize (str src " "))
|
|
prev nil
|
|
level 0
|
|
res []]
|
|
(let [[kind val] (first tokens)
|
|
level' (case kind
|
|
:open (inc level)
|
|
:close (dec level)
|
|
level)
|
|
style (case kind
|
|
:iden (when (and prev (re-find def-re prev))
|
|
(:def styles))
|
|
:open (paren-style level)
|
|
:close (paren-style level')
|
|
(styles kind))
|
|
remain (rest tokens)]
|
|
(if-not (empty? remain)
|
|
(recur remain
|
|
(if (= kind :other) prev val)
|
|
level'
|
|
(if (nil? style)
|
|
(let [old (peek res)]
|
|
(if (string? old)
|
|
(conj (pop res) (str old val))
|
|
(conj res val)))
|
|
(conj res (list style val))))
|
|
(apply vector :pre res))))))
|
|
|
|
|
|
;;;; Source splitting
|
|
|
|
(defn src-parts [src]
|
|
(string/split src #"\n(?=[(])"))
|
|
|
|
(defn src-defs [parts]
|
|
(let [ws #"[^ \t]+"]
|
|
(into {} (for [x parts]
|
|
[(->> x (re-seq ws) second keyword) x]))))
|
|
|
|
(defn fun-map [src]
|
|
(-> src src-parts src-defs))
|
|
|
|
(defn src-for-names [srcmap names]
|
|
(string/join "\n" (map srcmap names)))
|
|
|
|
;;; Macros
|
|
|
|
(defmacro syntaxed [src]
|
|
(assert (string? src))
|
|
(syntaxify src))
|
|
|
|
(defmacro src-of
|
|
([funs]
|
|
`(src-of ~funs nil))
|
|
([funs resource]
|
|
(assert (or (nil? funs)
|
|
(vector? funs)))
|
|
(assert (or (nil? resource)
|
|
(string? resource)))
|
|
(let [f (if (nil? resource)
|
|
(-> (name cljs.analyzer/*cljs-ns*)
|
|
(string/replace #"[.]" "/")
|
|
(str ".cljs"))
|
|
resource)
|
|
src (-> f io/resource slurp)
|
|
fm (fun-map src)
|
|
sel (if (nil? funs)
|
|
src
|
|
(-> src fun-map (src-for-names funs)))]
|
|
(syntaxify sel))))
|