Localized and neat error reports

examples/9999error.txt

@@ -0,0 +1,1 b''
+error

src/l10n.lisp

@@ -6,14 +6,18 b''
 (defparameter *l10n-strings*
   (mapcan (lambda (lang)
             (cons (intern (string-upcase lang) :keyword)
-                  (read-code-from-string
-                   (load-src
-                    (concatenate 'string "strings/" lang ".sexp")))))
+                  (list (apply #'append
+                               (read-code-from-string
+                                (load-src
+                                 (concatenate 'string "strings/" lang ".sexp")))))))
           *languages*))
 
 (defun lformat (target key &rest args)
   (let* ((lang (intern (string-upcase (first (system-locale:languages)))
                       :keyword))
          (strings (or (getf *l10n-strings* lang)
-                      (getf *l10n-strings* :en))))
-    (apply #'format target (getf strings key) args)))
+                      (getf *l10n-strings* :en)))
+         (string (getf strings key)))
+    (if string
+        (apply #'format target string args)
+        (error "Unknown localization string ~S for language ~S" key lang))))

src/main.lisp

@@ -4,6 +4,7 b''
 (defvar *app-name* "")
 
 (defun entry-point-no-args ()
+  (setf *delivered* t)
   (entry-point uiop:*command-line-arguments*))
 
 (defun entry-point (args)
@@ -51,8 +52,12 b''
   (lformat t :usage *app-name*))
 
 (defun parse-file (filename)
-  (p:parse 'txt2web-grammar
-           (alexandria:read-file-into-string filename)))
+  (handler-case
+      (p:parse 'txt2web-grammar
+               (alexandria:read-file-into-string filename))
+    (p:esrap-parse-error (e)
+      (format t "~A~%" e)
+      (uiop:quit 1))))
 
 (defun report-error (fmt &rest args)
   (format t "ERROR: ~A~%" (apply #'format nil fmt args))

src/patches.lisp

@@ -72,3 +72,60 b''
 ;; No idea why these are not exported
 (export '<<)
 (export '>>)
+
+(in-package esrap)
+(defmethod print-object :around ((condition esrap-error) stream)
+  (when (not txt2web::*delivered*)
+    (return-from print-object
+      (call-next-method)))
+  (when (or *print-escape*
+            *print-readably*
+            (and *print-lines* (<= *print-lines* 5)))
+    (return-from print-object))
+
+  ;; FIXME: this looks like it won't do the right thing when used as
+  ;; part of a logical block.
+  (if-let ((text (esrap-error-text condition))
+           (position (esrap-error-position condition)))
+    (labels ((safe-index (index)
+               (min (max index 0) (length text)))
+             (find-newline (&key (start 0) (end (length text)) (from-end t))
+               (let ((start (safe-index start))
+                     (end   (safe-index end)))
+                 (cond
+                   ((when-let ((position (position #\Newline text
+                                                   :start start :end end
+                                                   :from-end from-end)))
+                      (1+ position)))
+                   ((and from-end (zerop start))
+                    start)
+                   ((and (not from-end) (= end (length text)))
+                    end)))))
+      ;; FIXME: magic numbers
+      (let* ((line       (count #\Newline text :end position))
+             (column     (- position (or (find-newline :end position) 0) 1))
+             (min-start  (- position 160))
+             (max-end    (+ position 24))
+             (line-start (or (find-newline :start min-start
+                                           :end   position)
+                             (safe-index min-start)))
+             (start      (cond
+                           ((= (safe-index min-start) line-start)
+                            line-start)
+                           ((find-newline :start min-start
+                                          :end   (1- line-start)))
+                           (t
+
+                            line-start)))
+             (end        (or (find-newline :start    position
+                                           :end      max-end
+                                           :from-end nil)
+                             (safe-index max-end)))
+             (*print-circle* nil))
+        (txt2web::lformat stream :error
+                (= position (length text))
+                (list (subseq text start end))
+                (- position line-start)
+                (1+ line) (1+ column) position)))
+
+    (format stream "~2&<text and position not available>~2%")))

src/utils.lisp

@@ -1,6 +1,8 b''
 
 (in-package txt2web)
 
+(defvar *delivered* nil)
+
 (defun src-file (filename)
   (uiop/pathname:merge-pathnames*
    filename

strings/en.sexp

@@ -10,3 +10,6 b' Options:'
 
 Note that the files in extras/ are not actually used. They're just there for the reference~%")
 
+(:error "Error at~:[~; end of input~]~2%~
+                        ~2@T~<~@;~A~:>~%~
+                        ~2@T~V@T^ (Line ~D, Column ~D, Position ~D)~2%")
  No newline at end of file

strings/ru.sexp

@@ -10,3 +10,6 b''
 
 Файлы в extras на самом деле компилятором не используются. Используйте только как образец.~%")
 
+(:error "Ошибка в~:[~; конце файла~]~2%~
+                        ~2@T~<~@;~A~:>~%~
+                        ~2@T~V@T^ (Строка ~D, Столбец ~D, Символ ~D)~2%")
  No newline at end of file