@@ -51,10 +51,10 @@

    tree

    :traversal :postorder))

-(defvar *current-language*)

+(defvar *current-language* :tsx)

 (defun parse (src &optional (language *current-language*))

   (typecase src

-    (pathname (parse language (alexandria:read-file-into-string src)))

+    (pathname (parse (alexandria:read-file-into-string src) language))

     (string (displace-tree (cl-tree-sitter:parse-string language src)

                            src))))

@@ -66,9 +66,145 @@

          (cons (if (and (tag-p (car node)) (= 3 (length node)))

                    (destructuring-bind (_ op . __) (parse-thing node)

                      (declare (ignore _ __))

-                     (when (eql op type)

-                       (save node)))

+                     (if (fwoar.cl-multis.interface:isa? op type)

+                         (save node)

+                         node))

                    node))

          (t node)))

      tree

      :traversal :postorder)))

+

+(defun child-tagged (tag)

+  (lambda (node)

+    (values-list

+     (remove-if-not (serapeum:op (eql tag _1))

+                    (fourth (parse-thing node))

+                    :key (data-lens:• 'car

+                                      'parse-thing)))))

+

+

+#+(or)

+(defvar *empty-package* (make-package (gensym) :use ()))

+

+#+(or)

+(defvar *ht-pprint-dispatch* (copy-pprint-dispatch *print-pprint-dispatch*))

+

+#+(or)

+(set-pprint-dispatch 'hash-table

+                     (lambda (s o)

+                       (let ((*package* (make-package *empty-package*)))

+                         (prin1 `(alexandria:alist-hash-table

+                                  (list

+                                   ,@(mapcar (lambda (it)

+                                               `(cons ,(car it)

+                                                      ,(cdr it)))

+                                             (alexandria:hash-table-alist o))))

+                                s)))

+                     0 *ht-pprint-dispatch*)

+

+#+(or)

+(set-pprint-dispatch 'vector

+                     nil

+                     #+(or)

+                     (lambda (s o)

+                       (let ((*package* *empty-package*))

+                         (typecase o

+                           (string (let ((*print-pretty* nil))

+                                     (prin1 o s)))

+                           (t (prin1 `(vector

+                                       ,@(map 'list 'identity o))

+                                     s)))))

+                     0 *ht-pprint-dispatch*)

+

+(defun collect-edits (tree collector)

+  (destructuring-bind (tag type source children) (parse-thing tree)

+    (multiple-value-bind (_ offs) (array-displacement source)

+      (declare (ignore _))

+      (let ((end (+ offs (length source))))

+        (flet ((tag (start-p)

+                 (format nil "<~:[~;/~]span~:*~:[ class=\"~a ~{~a~^ ~}\"~;~]>"

+                         start-p

+                         (if tag (string-downcase tag) "")

+                         (mapcar 'string-downcase

+                                 (fwoar.cl-multis.interface:ancestors

+                                  type)))))

+          (funcall collector (fwoar.lisp-sandbox.ot-edit:insert offs (tag nil)))

+          (funcall collector (fwoar.lisp-sandbox.ot-edit:insert end (tag t)))

+          (mapcar (lambda (it)

+                    (collect-edits it collector))

+                  children))))))

+

+#+(or)

+(setf (ningle:route *a* "/2/(?<url>.*)" :regexp t)

+      (lambda (_)

+        (let ((*standard-output* *trace-output*))

+          (fresh-line)(princ "notice: ")(prin1 _)(terpri))

+        (let ((src (drakma:http-request (cadr (assoc :captures _)))))

+          (flet ((outp ()

+                   (spinneret:with-html

+                     (:div #+(or)selector-ui

+                           ;; :node-types ("expression" "identifier" "operator" "subscript-expression"

+                           ;;                           "member-expression" "jsx" "pair")

+                           (:pre

+                            (:code :class "language-ts"

+                                   (:raw

+                                    (fwoar.lisp-sandbox.ot-edit:apply-edits

+                                     src

+                                     (serapeum:with-collector (s)

+                                       (loop for next = (position #\< src)

+                                               then (position #\< src :start (1+ next))

+                                             while next

+                                             do (s (fwoar.lisp-sandbox.ot-edit::replace-char next "<")))

+                                       (loop for next = (position #\> src)

+                                               then (position #\> src :start (1+ next))

+                                             while next

+                                             do (s (fwoar.lisp-sandbox.ot-edit::replace-char next ">")))

+                                       (collect-edits (parse src)

+                                                      #'s))))))

+                           (:ul#w

+                            (:li "expression"))

+                           (:script

+                            (:raw "const ul = document.querySelector(\"#w\");"

+                                  "const dps = new Set([]);"

+                                  "[].map.call(document.querySelectorAll(\".syntax-element\"),"

+                                  " v=> {Array.from(v.classList).forEach(it=>dps.add(it.toLowerCase()))});"

+                                  "function it(v) {const it=document.createElement(\"li\"); "

+                                  "it.textContent = v; return it}"

+                                  " const dpA = Array.from(dps);dpA.sort();"

+                                  " dpA.forEach(cls => { if(/^[a-zA-Z-]{2,}$/.test(cls)) {ul.appendChild(it(cls))}})"))))))

+            (spinneret:with-html-string

+              (:style

+               "input[name=expression]:checked ~ pre .expression {color: var(--zenburn-red);background-color: hsla(180,0%,0%,0.1)}"

+               "input[name=jsx]:checked ~ pre .jsx {color: var(--zenburn-red);background-color: hsla(180,0%,0%,0.1)}"

+               "input[name=subscript-expression]:checked ~ pre .subscript-expression {color: var(--zenburn-red);background-color: hsla(180,0%,0%,0.1)}"

+               "input[name=member-expression]:checked ~ pre .member-expression {color: var(--zenburn-red);background-color: hsla(180,0%,0%,0.1)}"

+               "input[name=identifier]:checked ~ pre .function .identifier {color: var(--zenburn-red)}"

+               "input[name=operator]:checked ~ pre .function .operator {color: var(--zenburn-red)}"

+               "input[name=pair]:checked ~ pre .pair .tag-key {color: var(--zenburn-blue)}"

+               "input[name=pair]:checked ~ pre .pair .tag-value {color: var(--zenburn-green)}"

+               "input[name=pair]:checked ~ pre .pair {background: var(--zenburn-fg+1)}"

+               (coerce '(#\newline) 'string)

+               (alexandria:read-file-into-string (truename "~/styles.css"))

+               )

+              (outp))))))

+

+

+#+(or)

+(mapcan (data-lens:•

+         (lambda (it)

+           (destructuring-bind (a c) it

+             (mapcar (serapeum:op (list a _)) c)))

+         (data-lens:juxt

+          (data-lens:• (lambda (it)

+                         (substitute #\- #\_ it))

+                       (lambda (it)

+                         (string-left-trim "_" it)))

+          (data-lens:• (data-lens:over (data-lens:• (data-lens:applicable-when

+                                                     (data-lens:• (lambda (it)

+                                                                    (substitute #\- #\_ it))

+                                                                  (lambda (it)

+                                                                    (string-left-trim "_" it)))

+                                                     'identity)

+                                                    (data-lens:key "name")))

+                       (lambda (it) (fw.lu:dive (list "rules" it "members") tsx-grammar:+data+)))))

+        (gethash "supertypes" tsx))