(fn fv [...] (print ((require :fennel.view) ...))) ;; this program optimizes regex using a few fixed patterns ;; (that can be adjusted) ;; its input is a list of possible strings we want to match (specifically as a ;; unicode data file: read emoji-test.txt to see how that looks) ;; this program is specifically optimized to make a template for the YAGPDB ;; discord bot, which is why i'm trying to make it shorter in the first place. ;; there are a few mismatches between things that discord thinks are emoji and ;; things that unicode thinks are emoji, like regional indicators. i add these ;; outside of the program to save myself the thought. ;; a replacement has its id, which it is replaced with in the string ;; it has to be something that doesn't appear in the regex. thankfully, we ;; escape all of the ascii characters from the emoji, so only \, x, hex ;; numbers, and regex characters are unsfae. here we'll use capital letters ;; from g to w ;; then it has the Set of possibilities that we want to replace, and the regex ;; for those ;; we do a replacement when all of the possibilities can be collapsed into one ;; we also have (local replacements ;; gender [{:id "g" :options ["\u{200d}\u{2640}" "\u{200d}\u{2642}"] :regex "\u{200d}[\u{2640}\u{2642}]"} ;; skin tone (including null) {:id "s" :options ["" "\u{1f3fb}" "\u{1f3fc}" "\u{1f3fd}" "\u{1f3fe}" "\u{1f3ff}"] :regex "[\u{1f3fb}\u{1f3fc}\u{1f3fd}\u{1f3fe}\u{1f3ff}]?"} ;; skin tone (excluding null) {:id "S" :options ["\u{1f3fb}" "\u{1f3fc}" "\u{1f3fd}" "\u{1f3fe}" "\u{1f3ff}"] :regex "[\u{1f3fb}\u{1f3fc}\u{1f3fd}\u{1f3fe}\u{1f3ff}]"} ;; variant selector thing {:id "v" :options ["" "\u{fe0f}"] :regex "\u{fe0f}?"} ;; man, woman ;; there's so much gender weirdness in unicode combinations that including ;; "person" here makes things longer :/ {:id "p" :options ["\u{1f468}" "\u{1f469}"] :regex "[\u{1f468}\u{1f469}]"} ;; just person ;; we do this because yagpdb's interface large codepoints as 2 chars {:id "P" :options ["\u{1f9d1}"] :regex "\u{1f9d1}"} ]) (local emoji (icollect [line (io.lines "emoji-test.txt")] (do (var x "") (each [guy (string.gmatch line "[^ ]+") :until (. {";" true "#" true} (string.sub guy 1 1))] (let [num (tonumber guy 16)] (set x (.. x (if (< num 128) (string.format "\\x%02x" num) (utf8.char num)))))) (if (> (length x) 0) x nil)))) ;; find possible matches of options. returns list of prefix-suffix pairs to put ;; around possibilities etc (fn find-matches [str replacement] (local out []) (each [_ option (ipairs replacement.options)] (var start 1) (while (string.find str option start true) (let [(x y) (string.find str option start true)] (set start (+ x 1)) (table.insert out [(string.sub str 1 (- x 1)) (string.sub str (+ y 1))])))) out) ;; with a list of pairs and a list of options, generate a list of reductions, ;; ignoring whether they are actually valid (fn iterate-options [pattern-pairs replacement] (icollect [_ pair (ipairs pattern-pairs)] {:pattern (.. (. pair 1) replacement.id (. pair 2)) :matches (icollect [_ option (ipairs replacement.options)] (.. (. pair 1) option (. pair 2)))})) ;; reduce set of patterns via one replacement. only does one round, which is to ;; say that if there are multiple of the same replacement that can be done on ;; one string (i.e. two different skin tones in the kissing emoji sequences), ;; we'll have to run it twice. for this reason we also return a boolean saying ;; if we actually modified the data at all. (fn reduce-set [patterns replacement] (var out []) (var dirty? false) (local map (collect [_ k (ipairs patterns)] (values k true))) (each [_ pattern (ipairs patterns)] (local possibilities (iterate-options (find-matches pattern replacement) replacement)) (each [_ reduction (ipairs possibilities)] (when (accumulate [ok true _ v (ipairs reduction.matches)] (and ok (. map v))) (table.insert out reduction.pattern) (each [_ v (ipairs reduction.matches)] (tset map v false)))) (if (. map pattern) (do (table.insert out pattern) (tset map pattern false)) (set dirty? true))) (values out dirty?)) (fn fully-reduce-set [patterns replacement] (var out patterns) (var dirty? true) (while dirty? (set (out dirty?) (reduce-set out replacement))) out) (fn reduce-all [patterns replacements] (accumulate [out patterns _ r (ipairs replacements)] (fully-reduce-set out r))) ;; TODO: this is a bad name ;; we find the longest possible string for any set of replacements ;; for greedy matching/sorting weirdness (fn process-replacements [pattern replacements] (accumulate [out pattern _ r (ipairs replacements)] (string.gsub pattern r.id (accumulate [x "" _ v (ipairs r.options)] (if (< (utf8.len x) (utf8.len v)) v x))))) ;; sort by length and then by unicode value (longest first) (fn utf8-comp [a b replacements] (local a (process-replacements a replacements)) (local b (process-replacements b replacements)) (if (not= (utf8.len a) (utf8.len b)) (> (utf8.len a) (utf8.len b)) (not= (utf8.codepoint a) (utf8.codepoint b)) (< (utf8.codepoint a) (utf8.codepoint b)) (= (utf8.len a) 1) false true (utf8-comp (string.sub a (utf8.offset a 2)) (string.sub b (utf8.offset b 2)) []))) ;; inner unescaped regex with ranges etc ;; we do the longest patterns first since yagpdb's regex engine wants to ;; match the first allowed OR clause (fn inner-regex [final-set replacements] (local things (icollect [_ v (ipairs final-set)] v)) (table.sort things #(utf8-comp $1 $2 replacements)) (var map (collect [_ v (ipairs final-set)] (values v true))) (var replacement-map (collect [_ v (ipairs replacements)] (values v.id v))) (var out [""]) (each [_ v (ipairs things)] (when (or (< 1 (utf8.len v)) (. replacement-map v)) (table.insert out (.. v "|")))) (table.insert out "[") (each [_ v (ipairs things)] (when (and (= 1 (utf8.len v)) (not (. replacement-map v))) (let [min-codepoint (utf8.codepoint v) max-codepoint (do (var x min-codepoint) (while (. map (utf8.char x)) (set x (+ x 1))) (- x 1))] (if (< 2 (- max-codepoint min-codepoint)) (do (table.insert out (.. (utf8.char min-codepoint) "-" (utf8.char max-codepoint))) (for [i min-codepoint max-codepoint] (tset map (utf8.char i) false))) (do (table.insert out v) (tset map v false)))))) (table.insert out "]") (table.concat out)) ;;; yagpdb-specific stuff from here on out! (fn yagpdb-escape [str] (-> str (string.gsub "\\" "\\\\") (string.gsub "\"" "\\\""))) (fn yagpdb-output [patterns replacements] (var out []) (table.insert out (string.format "{{ $regex := \"%s\" }}" (yagpdb-escape (inner-regex (reduce-all emoji replacements) replacements)))) (icollect [_ replacement (pairs replacements) :into out] (string.format "{{ $regex = joinStr \"%s\" (split $regex \"%s\") }}" (yagpdb-escape replacement.regex) (yagpdb-escape replacement.id))) (table.concat out "\n")) (io.write (yagpdb-output emoji replacements))