Yellow Rabbit

Разбираем комплексный элемент

Web-движок на Lisp: разбираем самый сложный элемент

Самый сложный элемент. Гораздо сложнее комментариев. У нас есть открывающие и закрывающие теги, атрибуты и их значения, а ко всему прочему, элементы ещё могут быть вложенными.

У него даже конструктор сложный :smile:


(defun make-element-node (tag attrs children)
  "Tag and list of name-value pairs"
  (let ((el (make-instance 'element-node :tag tag :children children)))
       (element-set-all-attrs el attrs)
       el))

Чтобы это работало, нужно добавить функцию в dom.lisp:


;; Set all attrs at once
(defun element-set-all-attrs (el vals)
  "Set all attrs at once. Vals is name-value pair list."
  (let ((attrs (element-node-attrs el)))
    (mapc #'(lambda (nv)
	      (setf (gethash (car nv) attrs) (cdr nv))) vals)))

Ещё нам понадобится много маленьких парсеров, начиная с парсера имени тега.


      (parse-tagname ()
          "Parse tag name"
          (let (ch)
            (with-output-to-string (s)
              (matchit $[@(tag-text ch) !(write-char ch s)]))))

Полезная штука — пропуск пробелов, табуляций и пр. Успешна всегда.


       (skip-whitespace ()
          (let (ch)
            (matchit $[@(whitespace ch)])
            t))

Значения атрибутов могут быть заключены или в двойные или в одинарные кавычки, парсер таким образом должен запомнить с кавычки какого типа началось значение и работать до точно такой же закрывающей кавычки.


       (parse-value (quo)
          (let (ch)
            (with-output-to-string (s)
              (matchit $[@(any-text ch) !(char/= ch quo) !(write-char ch s)]))))


       (parse-quoted-value ()
          "Parse quoted value"
          (let (quo (oldindex index))
            (or (matchit
                  [ {[#\' !(setf quo #\')] [#\" !(setf quo #\")]}
                    !(parse-value quo)])
                (progn (setf index oldindex) nil))))

С такими помощниками сделать парсер одного атрибута легко: сначала выделим имя (не пустое), затем знак = и значение атрибута в каких-нибудь кавычках. На выходе будет пара (имя . значение).


       (parse-attr ()
          "name=value"
          (let (name value (oldindex index))
            (if
              (matchit
                [ !(setf name (parse-tagname))
                  !(not (zerop (length name)))
                  #\= !(setf value (parse-quoted-value))])
              (cons name value)
              (progn (setf index oldindex) nil))))

Распознанные атрибуты заталкиваем в список. Порядок будет обратным.


       (parse-attrs ()
          "Parse attributes"
          (let (attrs)
            (matchit
              $[ !(skip-whitespace)
                 !(setf attr (parse-attr))
                 !(push attr attrs)])
            attrs))

Закрывающий тег так же требует внимания.


       (parse-closing-tag (tagname)
          "Parse </tagname>"
          (let ((oldindex index))
            (or
              (matchit
                [#\< #\/ !(string= (parse-tagname) tagname) #\>])
              (progn (setf index oldindex) nil))))

Эскиз парсера элемента:


       (parse-element ()
          "<tagname $[attr=value]> ??? </tagname>"
          (let ((oldindex index)
                ch tagname attrs)
            (or (matchit
                  [!(setf tagname (parse-tagname))
                   {!(setf attrs (parse-attrs)) !T}
                   #\>
                   !(parse-closing-tag tagname)
                   !(make-element-node tagname attrs nil)])
                (progn (setf index oldindex) nil))))

Проблема с этим парсером состоит в том, что он не предусматривает ничего между открывающим и закрывающими тегами. То есть настало время подумать о рекурсии и о том как организовывать потомков. А пока можно проверить как работает парсер элемента.


* (ql:quickload 'toy-engine)
To load "toy-engine":
  Load 1 ASDF system:
    toy-engine
; Loading "toy-engine"

(TOY-ENGINE)
* (in-package :toy-engine)

#<PACKAGE "TOY-ENGINE">
* (defparameter *str* "table border=\"1\"   width=\"50%\"   ></table>")

*STR*
* (parse-html *str*)

#<ELEMENT-NODE {100504E943}>
* (gethash "width" (element-node-attrs *))

"50%"
T
* (pp->dot "element-node.dot" (lambda () (pp-dom **)))

"}"
* 

Дерево после разбора элемента

Рекурсия

Так как мы создаём узел только после того, как создадим всех его потомков, то логично будем накапливать их в списке и потом просто передавать его в конструктор узла. Самой интересной функцией будет та, что разбирает несколько расположенных друг за другом узлов в список будущих потомков.

Но сначала парсер одного единственного узла:


       (parse-node ()
          "Text or node"
          (let ((oldindex index))
            (or (matchit
                  { !(parse-comment-or-element)
                    !(parse-text)})
                (progn (setf index oldindex) nil))))

Он использует маленький вспомогательный парсер, который нужен для отката назад в том случае, если встретился не комментарий и не элемент. Дело в том, что элементарные совпадения вроде #\< или "example" использованные внутри последовательности [] нельзя откатить, если они сработали.


       (parse-comment-or-element ()
	  "< {comment element}"
	  (let ((oldindex index))
	    (or (matchit
		  [#\< {!(parse-comment) !(parse-element)}])
		(progn (setf index oldindex) nil))))

Проверим, что эта функция распознаёт и создаёт разные типы узлов:


* (ql:quickload 'toy-engine)
To load "toy-engine":
  Load 1 ASDF system:
    toy-engine
; Loading "toy-engine"

(TOY-ENGINE)
* (in-package :toy-engine)

#<PACKAGE "TOY-ENGINE">
* (defparameter *str-text* "table border=\"1\"   width=\"50%\"   ></table>")

*STR-TEXT*
* (defparameter *text* (parse-html *str-text*))

*TEXT*
* (defparameter *str-comment* "<!-- coomn -->")

*STR-COMMENT*
* (defparameter *comment* (parse-html *str-comment*))

*COMMENT*
* (defparameter *str-element* "<table border=\"1\"   width=\"50%\"   ></table>>")

*STR-ELEMENT*
* (defparameter *element* (parse-html *str-element*))

*ELEMENT*
* *element*

#<ELEMENT-NODE {100516F043}>
* *text*

#<TEXT-NODE {100503DD53}>
* *comment*

#<COMMENT-NODE {10050C6A93}>
*

Собираем несколько узлов в список:


       (parse-nodes ()
          "Children"
          (let ((oldindex index) children node)
            (if (matchit
                   $[!(setf node (parse-node)) !(push node children)])
	        (reverse children)
                (progn (setf index oldindex) nil))))

Проверяем насколько успешно эта функция распознает строку с разными составными частями HTML:


* (ql:quickload 'toy-engine)
To load "toy-engine":
  Load 1 ASDF system:
    toy-engine
; Loading "toy-engine"

(TOY-ENGINE)
* (in-package :toy-engine)

#<PACKAGE "TOY-ENGINE">
* (defparameter *str* "Text  rr<!-- coomn --> <p></p>")

*STR*
* (defparameter *ch* (parse-html *str*))

*CH*
* *ch*

(#<TEXT-NODE {1005AD9AA3}> #<COMMENT-NODE {1005AD9BE3}>
 #<TEXT-NODE {1005AD9EE3}> #<ELEMENT-NODE {1005ADA5E3}>)
*

Если теперь изменить тело функции parse-html на


      (make-instance 'node :children (parse-nodes))

тем самым сделав все распознанные узлы на верхнем уровне потомками некого узла типа node.


* (ql:quickload 'toy-engine)
To load "toy-engine":
  Load 1 ASDF system:
    toy-engine
; Loading "toy-engine"

(TOY-ENGINE)
* (in-package :toy-engine)

#<PACKAGE "TOY-ENGINE">
* (defparameter *str* "Text  rr<!-- coomn --> <p></p>")

*STR*
* (defparameter *ch* (parse-html *str*))

*CH*
* (pp->dot "children.dot" (lambda () (pp-dom *ch*)))

"}"
*

Дерево после разбора нескольких элементов

Окончательно парсер элемента содержит запуск рекурсии:


       (parse-element ()
          "<tagname $[attr=value]> ??? </tagname>"
          (let ((oldindex index)
                ch tagname attrs children)
            (or (matchit
                  [!(setf tagname (parse-tagname))
                   {!(setf attrs (parse-attrs)) !t}
                   #\>
		   {!(setf children (parse-nodes)) !t}
                   !(parse-closing-tag tagname)
                   !(make-element-node tagname attrs children)])
                (progn (setf index oldindex) nil))))

Разбор сложного примера:


* (ql:quickload 'toy-engine)
To load "toy-engine":
  Load 1 ASDF system:
    toy-engine
; Loading "toy-engine"
.
(TOY-ENGINE)
* (in-package :toy-engine)

#<PACKAGE "TOY-ENGINE">
* (defparameter *str* "Text  rr<!-- coomn --> <p>another text<table color=\"red\"><tr>Row</tr></table></p>")

*STR*
* (defparameter *ch* (parse-html *str*))

*CH*
* (pp->dot "parse-html.dot" (lambda () (pp-dom *ch*)))

"}"
*

Дерево после разбора крошечного HTML