Регистрация | Войти
Lisp — программируемый язык программирования

Оригинальная публикация: http://chaitanyagupta.com/lisp/restarts.html

Перевод: http://gzip4ever.blogspot.com/2010/06/common-lisp-tutorial-on-conditions-and.html

Common Lisp: Введение в Условия и Перезапуск

Система условий, с её исключениями и перезапусками, является одной из уникальных особенностей языка Common Lisp (CL). К сожалению, учебных материалов, объясняющих данную концепцию, существует не так уж много. Информацию, касающуюся условий и перезапусков, можно найти в одной из глав прекрасной книги Питера Сибела (Peter Seibel), "Практический Коммон Лисп" (Practical Common Lisp) (см. 1, 2). Настоящее введение предполагает наличие некоторых знаний касательно системы условий, поэтому перед тем как продолжить, необходимо как минимум прочитать эту главу (русский перевод).

Я попытаюсь показать, насколько может быть эффективна система условий в CL на примере валидатора для CSV-файлов. Этот валидатор будет проверять правильность (в соответствии с некоторыми заданными критериями) всех полей данных во всех строках файла.

Первая строка CSV-файла - разделяемый запятыми список заголовков, за которым следуют строки, в которых каждая колонка соответствует заголовку из первой строки. Пример может выглядеть следующим образом:

rating,url,visitors,date
4,http://chaitanyagupta.com/home,1233445,2000-01-01
5,http://chaitanyagupta.com/blog,33333,2006-02-02
5,http://chaitanyagupta.com/code,2121212,2007-03-03

Валидация заголовков

Сначала напишем функции для валидации четырех заголовков, приведенных выше: rating, url, visitors и date. Заметьте, что эти функции зависят от библиотеки CL-PPCRE.

(defun validate-url (string)
  "The URL of the page; should start with http:// or https://."
  (unless (cl-ppcre:scan "^https?://" string)
    (csv-error "URL invalid." :value string)
)
)


(defun validate-rating (string)
  "String should contain an integer between 1 and 5, inclusive."
  (let ((rating (parse-integer string :junk-allowed t)))
    (unless (and (integerp rating) (<= 1 rating 5))
      (csv-error "Rating not an integer in range." :value string)
)
)
)


(defun validate-visitors (string)
  "The number of visitors to the page; string should contain aninteger
more than or equal to zero."

  (let ((visitors (parse-integer string :junk-allowed nil)))
    (unless (and (integerp visitors) (>= visitors 0))
      (csv-error "Number of visitors invalid." :value string)
)
)
)


(defun validate-date (string)
  "The published date of the URL. Should be in yyyy-mm-dd format."
  (let ((split (cl-ppcre:split "-" string)))
    (flet ((!valid-number-of-digits-p (string n)   ; See note 3
            (and (every #'digit-char-p string)
                  (= (length string) n)
)
)
)

      (unless (and (!valid-number-of-digits-p (first split) 4)
                   (!valid-number-of-digits-p (second split) 2)
                   (!valid-number-of-digits-p (third split) 2)
)

        (csv-error "Published date not in valid format." :value string)
)
)
)
)

Все эти функции принимают в качестве аргумента строку, и если строка не удовлетворяет критерию валидации, они сигнализируют ошибку, вызывая функцию csv-error, определение которой приведено далее.

Сигнализируем об ошибках валидации.

Функция csv-error сигнализирует условие, имеющее тип csv-error. Посмотрим на их определения:

(define-condition csv-error (error)
  ((message
    :initarg :message
    :accessor csv-error-message
    :initform nil
    :documentation
    "Text message indicating what went wrong with the validation."
)

   (value
    :initarg :value
    :accessor csv-error-value
    :initform nil
    :documentation
    "The value of the field for which the error is signalled."
)

   (line-number
    :initarg :line-number
    :accessor csv-error-line-number
    :initform nil
    :documentation
    "The line number of the row in for the error was signalled."
)
)
)


;; Do something more useful than the default printer behaviour
(defmethod print-object ((object csv-error) stream)
  (print-unreadable-object (object stream :type t :identity t)
    (format stream "~@[L~A ~]~S~@[: ~S~]"
            (csv-error-line-number object)
            (csv-error-message object)
            (csv-error-value object)
)
)
)


;; We use this function to signal our validation error
(defun csv-error (message &key value line-number)
  (error 'csv-error
         :message message
         :value value
         :line-number line-number
)
)

Парсим CSV-файл

Парсер преобразует CSV-файл в список списков, каждый элемент которых соответствует полю CSV-файла.

(defun parse-csv-file (file)
  (with-open-file (f file :direction :input)
    (loop
       for line = (read-line f nil)
       while line
       collect (cl-ppcre:split "," line)
)
)
)

Валидатор (без перезапусков)

Наконец мы дошли до написания валидатора, validate-csv. В случае успешной валидации (т.е. когда все записи верны) происходит обычный возврат из функции. Если же обнаружена неверная запись, валидирующие функции сигнализируют об ошибке.

Эта версия валидатора пока что не содержит т.н. перезапусков.

(defun validate-csv (file)
  (destructuring-bind (headers . rows)
      (parse-csv-file file)
    (loop
       for row in rows
       for line-number upfrom 2
       do
       (when (/= (length row) (length headers))
         (csv-error "Number of fields doesn't equal number of headers."
                    :line-number line-number
)
)

       (handler-bind
           ;; Set the LINE-NUMBER slot of the signalled
          ;; csv-error. Note that since this clause returns normally,
          ;; the error doesn't stop here, it goes "up" the stack
          ((csv-error #'(lambda (c)
                           (setf (csv-error-line-number c) line-number)
)
)
)

         (loop
            for header in headers
            for field in row
            do (validate-field header field)
)
)
)
)
)


;; Takes a header name and a string value as arguments; checks the
;; validity of the value by calling the appropriate validator function
(defun validate-field (header value)
  (flet ((!header-matches (string)
           (string-equal header string)
)
)

    (cond
      ((!header-matches "url") (validate-url value))
      ((!header-matches "rating") (validate-rating value))
      ((!header-matches "visitors") (validate-visitors value))
      ((!header-matches "date") (validate-date value))
      (t (csv-error "Invalid header." :value header))
)
)
)

Добавляем перезапуски

В случае обнаружения "неверной" записи (когда сигнализируется условие csv-error) мы можем предпринять некоторые действия, например, прекратить дальнейшую валидацию, или продолжить валидацию со вледующей строки, или продолжить валидацию остальных полей текущей строки.

Прекращение валидации произойдет если выбрать перезапуск ABORT в отладчике, или если использовать код вроде такого:

(handler-case (progn
                (validate-csv "~/tmp/test.csv")
                :success
)

  (csv-error () :failure))

Чтобы продолжить валидацию с той же строки, или со следующей, добавим пару перезапусков используя макрос with-simple-restart:

(defun validate-csv (file)
  (destructuring-bind (headers . rows)
      (parse-csv-file file)
    (loop
       for row in rows
       for line-number upfrom 2
       do
       ;; If this restart is invoked, validation will continue on
      ;; the next row
      (with-simple-restart (continue-next-row
                             "Continue validation on next row."
)

         (when (/= (length row) (length headers))
           (csv-error "Number of fields doesn't equal number of headers."
                      :line-number line-number
)
)

         (loop
            for header in headers
            for field in row
            do
            (handler-bind
                ((csv-error #'(lambda (c)
                                (setf (csv-error-line-number c)
                                      line-number
)
)
)
)

              ;; If this restart is invoked, validation will continue
             ;; on the next field in the row
             (with-simple-restart (continue-next-field
                                    "Continue validation on next field."
)

                (validate-field header field)
)
)
)
)
)
)
)

А теперь прикол! Дадим валидатору заведомо неверный файл и что мы видим в отладчике? Два новых перезапуска, CONTINUE-NEXT-FIELD и CONTINUE-NEXT-ROW. Выбор любого из них покажет, что валидация продолжается. Перезапуск ABORT должен присутствовать всегда, чтобы мы могли прекратить валидацию в любой момент.

Начинаем всё с начала

А теперь добавим еще один перезапуск, который, в случае ошибки, позволит нам начать процедуру валидации с начала проверяемого файла.

;; Note that what was known as VALIDATE-CSV earlier is now called
;; VALIDATE-CSV-AUX.
(defun validate-csv (file)
  (restart-case (validate-csv-aux file)
    (retry-file ()
      :report (lambda (stream)
                (format stream "Retry validating the file ~A." file)
)

      (validate-csv file)
)
)
)


(defun validate-csv-aux (file)
  (destructuring-bind (headers . rows)
      (parse-csv-file file)
    (loop
       for row in rows
       for line-number upfrom 2
       do
       (with-simple-restart (continue-next-row
                             "Continue validation on next row."
)

         (when (/= (length row) (length headers))
           (csv-error "Number of fields doesn't equal number of headers."
                      :line-number line-number
)
)

         (loop
            for header in headers
            for field in row
            do
            (handler-bind
                ((csv-error #'(lambda (c)
                                (setf (csv-error-line-number c)
                                      line-number
)
)
)
)

              (with-simple-restart (continue-next-field
                                    "Continue validation on next field."
)

                (validate-field header field)
)
)
)
)
)
)
)

Что произойдет теперь, если указать функции validate-csv неверный файл? Мы получим в отладчике новый перезапуск RETRY-FILE. Это значит, что мы сможем исправить ошибочную запись, сохранить файл и повторить валидацию с начала, и всё это не выходя из отладчика!

Обработка перезапусков

Можно обрабатывать перезапуски не только в отладчике, используя handler-bind и find-restart.

Например, следующая функция будет продолжать валидировать файл, если при возникновении ошибки CSV-ERROR доступны перезапуски CONTINUE-NEXT-FIELD или CONTINUE-NEXT-ROW. Объекты ошибок будут собраны в список, который функция возвратит на выходе.

(defun list-csv-errors (file)
  (let ((result nil))
    (handler-bind
        ((csv-error #'(lambda (c)
                        (let ((restart
                               (or (find-restart 'continue-next-field)
                                   (find-restart 'continue-next-row)
)
)
)

                          (when restart
                            (push c result)
                            (invoke-restart restart)
)
)
)
)
)

      (validate-csv file)
)

    (nreverse result)
)
)

Если мы хотим, чтобы не-программист использовал наш валидатор, мы должны обеспечить возможность загрузки файла на сервер () и предоставить в браузере красиво оформленный список list-csv-errors.

Заключение

Что мне больше всего нравится в системе условий (condition system), так это то, что она позволяет переложить принятие решений на функции более высокого уровня. Функции низкого уровня предоставляют различные стратегии при возникновении исключительных ситуаций (как это делает validate-csv), тогда как функции высокого уровня (такие как list-csv-errors) могут выбрать подходящую для них стратегию.

Если нам понадобится, чтобы функция list-csv-errors помещала в список только одну ошибку на каждую строку, то изменения в коде будут тривиальны благодяря предоставляемым перезапускам. Такое разделение логики в программе, на мой взгляд, является очень элегантным инструментом для решения подобных задач.

Заметки

@2009-2013 lisper.ru