(fix): fix bad behaviour on malformed properties (#763)

Org-roam now skips over bad properties and throws a warning for the
given file that contains a malformed property. This allows most of the
database rebuild to complete, and for the user to fix the offending
file.

Fixes #728.

org-roam-db.el

@@ -39,6 +39,7 @@
 
 (defvar org-roam-directory)
 (defvar org-roam-verbose)
+(defvar org-roam-file-name)
 
 (declare-function org-roam--org-roam-file-p                "org-roam")
 (declare-function org-roam--extract-titles                 "org-roam")
@@ -387,8 +388,7 @@ If FORCE, force a rebuild of the cache from scratch."
       (let* ((attr (file-attributes file))
              (atime (file-attribute-access-time attr))
              (mtime (file-attribute-modification-time attr)))
-        (org-roam--with-temp-buffer
+        (org-roam--with-temp-buffer file
-          (insert-file-contents file)
           (let ((contents-hash (secure-hash 'sha1 (current-buffer))))
             (unless (string= (gethash file current-files)
                              contents-hash)

org-roam-doctor.el

@@ -53,8 +53,7 @@
 (declare-function org-roam--get-roam-buffers "org-roam")
 (declare-function org-roam--list-all-files "org-roam")
 (declare-function org-roam--org-roam-file-p "org-roam")
-(declare-function org-roam--parse-tags "org-roam")
+(declare-function org-roam--str-to-list "org-roam")
-(declare-function org-roam--parse-alias "org-roam")
 (declare-function org-roam-mode "org-roam")
 
 (defvar org-roam-verbose)
@@ -112,17 +111,17 @@ AST is the org-element parse tree."
     (org-element-map ast 'keyword
       (lambda (kw)
         (when (string-collate-equalp (org-element-property :key kw) "ROAM_TAGS" nil t)
-          (let* ((s (org-element-property :value kw))
+          (let ((tags (org-element-property :value kw)))
-                     (tags (org-roam--parse-tags s))
+            (condition-case nil
-                     (bad-tags (-remove #'stringp tags)))
+                (org-roam--str-to-list tags)
-            (when bad-tags
+              (error
-              (push
+               (push
-               `(,(org-element-property :begin kw)
+                `(,(org-element-property :begin kw)
-                 ,(concat "Invalid tags: "
+                  ,(concat "Unable to parse tags: "
-                          (prin1-to-string bad-tags)
+                           tags
-                          (when (s-contains? "," s)
+                           (when (s-contains? "," tags)
-                            "\nCheck that your tags are not comma-separated.")))
+                             "\nCheck that your tags are not comma-separated.")))
-                 reports))))))
+                reports)))))))
     reports))
 
 (defun org-roam-doctor-check-alias (ast)
@@ -132,17 +131,17 @@ AST is the org-element parse tree."
     (org-element-map ast 'keyword
       (lambda (kw)
         (when (string-collate-equalp (org-element-property :key kw) "ROAM_ALIAS" nil t)
-          (let* ((s (org-element-property :value kw))
+          (let ((aliases (org-element-property :value kw)))
-                     (aliases (org-roam--parse-alias s))
+            (condition-case nil
-                     (bad-aliases (-remove #'stringp aliases)))
+              (org-roam--str-to-list aliases)
-            (when bad-aliases
+              (error
-              (push
+               (push
-               `(,(org-element-property :begin kw)
+                `(,(org-element-property :begin kw)
-                 ,(concat "Invalid aliases: "
+                  ,(concat "Unable to parse aliases: "
-                          (prin1-to-string bad-aliases)
+                           aliases
-                          (when (s-contains? "," s)
+                           (when (s-contains? "," aliases)
-                            "\nCheck that your aliases are not comma-separated.")))
+                             "\nCheck that your aliases are not comma-separated.")))
-                 reports))))))
+                reports)))))))
     reports))
 
 (defun org-roam-doctor-broken-links (ast)

org-roam-graph.el

@@ -165,7 +165,7 @@ The Org-roam database titles table is read, to obtain the list of titles.
 The links table is then read to obtain all directed links, and formatted
 into a digraph."
   (org-roam-db--ensure-built)
-  (org-roam--with-temp-buffer
+  (org-roam--with-temp-buffer nil
     (let* ((nodes (org-roam-db-query node-query))
            (edges-query
             `[:with selected :as [:select [file] :from ,node-query]

org-roam-macs.el

@@ -36,14 +36,18 @@
 
 (defvar org-roam-verbose)
 
-(defmacro org-roam--with-temp-buffer (&rest body)
+(defmacro org-roam--with-temp-buffer (file &rest body)
   "Execute BODY within a temp buffer.
-Like `with-temp-buffer', but propagates `org-roam-directory'."
+Like `with-temp-buffer', but propagates `org-roam-directory'.
-  (declare (indent 0) (debug t))
+If FILE, set `org-roam-temp-file-name' to file and insert its contents."
+  (declare (indent 1) (debug t))
   (let ((current-org-roam-directory (make-symbol "current-org-roam-directory")))
     `(let ((,current-org-roam-directory org-roam-directory))
        (with-temp-buffer
          (let ((org-roam-directory ,current-org-roam-directory))
+           (when ,file
+             (insert-file-contents ,file)
+             (setq-local org-roam-file-name ,file))
            ,@body)))))
 
 (defmacro org-roam--with-template-error (templates &rest body)

org-roam.el

@@ -233,6 +233,11 @@ space-delimited strings.
 (defvar org-roam-last-window nil
   "Last window `org-roam' was called from.")
 
+(defvar-local org-roam-file-name nil
+  "The corresponding file for a temp buffer.
+This is set by `org-roam--with-temp-buffer', to allow throwing of
+descriptive warnings when certain operations fail (e.g. parsing).")
+
 (defvar org-roam--org-link-file-bracket-re
   (rx "[[file:" (seq (group (one-or-more (or (not (any "]" "[" "\\"))
                                              (seq "\\"
@@ -259,7 +264,11 @@ space-delimited strings.
 
 (defun org-roam--str-to-list (str)
   "Transform string STR into a list of strings.
-If str is nil, return nil."
+If STR is nil, return nil.
+
+This function can throw an error if STR is not a string, or if
+str is malformed (e.g. missing a closing quote). Callers of this
+function are expected to catch the error."
   (when str
     (unless (stringp str)
       (signal 'wrong-type-argument `(stringp ,str)))
@@ -268,12 +277,14 @@ If str is nil, return nil."
            (items (cdar (org-babel-parse-header-arguments (format format-str str)))))
       (mapcar (lambda (item)
                 (cond
+                 ((stringp item)
+                  item)
                  ((symbolp item)
                   (symbol-name item))
                  ((numberp item)
                   (number-to-string item))
                  (t
-                  item))) items))))
+                  (signal 'wrong-type-argument `((stringp numberp symbolp) ,item))))) items))))
 
 ;;;; File functions and predicates
 (defun org-roam--file-name-extension (filename)
@@ -525,14 +536,20 @@ it as FILE-PATH."
     (when title
       (list title))))
 
-(defalias 'org-roam--parse-alias 'org-roam--str-to-list)
-
 (defun org-roam--extract-titles-alias ()
   "Return the aliases from the current buffer.
 Reads from the \"ROAM_ALIAS\" property."
   (let* ((prop (org-roam--extract-global-props '("ROAM_ALIAS")))
          (aliases (cdr (assoc "ROAM_ALIAS" prop))))
-    (org-roam--parse-alias aliases)))
+    (condition-case nil
+        (org-roam--str-to-list aliases)
+      (error
+       (progn
+         (lwarn '(org-roam) :error
+                "Failed to parse aliases for buffer: %s. Skipping"
+                (or org-roam-file-name
+                    (buffer-file-name)))
+         nil)))))
 
 (defun org-roam--extract-titles-headline ()
   "Return the first headline of the current buffer."
@@ -575,12 +592,18 @@ The final directory component is used as a tag."
                             (file-relative-name file org-roam-directory))))
     (last (f-split dir-relative))))
 
-(defalias 'org-roam--parse-tags 'org-roam--str-to-list)
-
 (defun org-roam--extract-tags-prop (_file)
   "Extract tags from the current buffer's \"#ROAM_TAGS\" global property."
-  (let* ((prop (org-roam--extract-global-props '("ROAM_TAGS"))))
+  (let* ((prop (cdr (assoc "ROAM_TAGS" (org-roam--extract-global-props '("ROAM_TAGS"))))))
-    (org-roam--parse-tags (cdr (assoc "ROAM_TAGS" prop)))))
+    (condition-case nil
+        (org-roam--str-to-list prop)
+      (error
+       (progn
+         (lwarn '(org-roam) :error
+                "Failed to parse tags for buffer: %s. Skipping"
+                (or org-roam-file-name
+                    (buffer-file-name)))
+         nil)))))
 
 (defun org-roam--extract-tags (&optional file)
   "Extract tags from the current buffer.

tests/test-org-roam.el

@@ -22,7 +22,6 @@
 ;;; Code:
 
 (require 'buttercup)
-(require 'with-simulated-input)
 (require 'org-roam)
 (require 'dash)
 
@@ -53,6 +52,25 @@
   (delete-file (org-roam-db--get))
   (org-roam-db--close))
 
+(describe "org-roam--str-to-list"
+  (it "nil"
+    (expect (org-roam--str-to-list nil)
+            :to-be
+            nil))
+  (it "\"multi word\" prop 123"
+    (expect (org-roam--str-to-list "\"multi word\" prop 123")
+            :to-equal
+            '("multi word" "prop" "123")))
+  (it "prop \"multi word\" 123"
+    (expect (org-roam--str-to-list "\"multi word\" prop 123")
+            :to-equal
+            '("multi word" "prop" "123")))
+  (it "errors on bad input"
+    (expect (org-roam--str-to-list 1)
+            :to-throw)
+    (expect (org-roam--str-to-list "\"hello")
+            :to-throw)))
+
 (describe "Title extraction"
   :var (org-roam-title-sources)
   (before-all
@@ -270,199 +288,6 @@
             :to-equal
             (list :files 0 :links 0 :tags 0 :titles 0 :refs 0 :deleted 0))))
 
-(xdescribe "org-roam-insert"
-  (before-each
-    (test-org-roam--init))
-
-  (after-each
-    (test-org-roam--teardown))
-
-  (it "temp1 -> foo"
-    (let ((buf (test-org-roam--find-file "temp1.org")))
-      (with-current-buffer buf
-        (with-simulated-input
-         "Foo RET"
-         (org-roam-insert))))
-    (expect (buffer-string) :to-match (regexp-quote "file:foo.org")))
-
-  (it "temp2 -> nested/foo"
-    (let ((buf (test-org-roam--find-file "temp2.org")))
-      (with-current-buffer buf
-        (with-simulated-input
-         "(nested) SPC Nested SPC Foo RET"
-         (org-roam-insert))))
-    (expect (buffer-string) :to-match (regexp-quote "file:nested/foo.org")))
-
-  (it "nested/temp3 -> foo"
-    (let ((buf (test-org-roam--find-file "nested/temp3.org")))
-      (with-current-buffer buf
-        (with-simulated-input
-         "Foo RET"
-         (org-roam-insert))))
-    (expect (buffer-string) :to-match (regexp-quote "file:../foo.org")))
-
-  (it "a/b/temp4 -> nested/foo"
-    (let ((buf (test-org-roam--find-file "a/b/temp4.org")))
-      (with-current-buffer buf
-        (with-simulated-input
-         "(nested) SPC Nested SPC Foo RET"
-         (org-roam-insert))))
-    (expect (buffer-string) :to-match (regexp-quote "file:../../nested/foo.org"))))
-
-(xdescribe "rename file updates cache"
-  (before-each
-    (test-org-roam--init))
-
-  (after-each
-    (test-org-roam--teardown))
-
-  (it "foo -> new_foo"
-    (rename-file (test-org-roam--abs-path "foo.org")
-                 (test-org-roam--abs-path "new_foo.org"))
-    ;; Cache should be cleared of old file
-    (expect (caar (org-roam-db-query [:select (funcall count)
-                                      :from titles
-                                      :where (= file $s1)]
-                                     (test-org-roam--abs-path "foo.org"))) :to-be 0)
-    (expect (caar (org-roam-db-query [:select (funcall count)
-                                      :from refs
-                                      :where (= file $s1)]
-                                     (test-org-roam--abs-path "foo.org"))) :to-be 0)
-    (expect (caar (org-roam-db-query [:select (funcall count)
-                                      :from links
-                                      :where (= from $s1)]
-                                     (test-org-roam--abs-path "foo.org"))) :to-be 0)
-
-    ;; Cache should be updated
-    (expect (org-roam-db-query [:select [to]
-                                :from links
-                                :where (= from $s1)]
-                               (test-org-roam--abs-path "new_foo.org"))
-            :to-have-same-items-as
-            (list (list (test-org-roam--abs-path "bar.org"))))
-    (expect (org-roam-db-query [:select [from]
-                                :from links
-                                :where (= to $s1)]
-                               (test-org-roam--abs-path "new_foo.org"))
-            :to-have-same-items-as
-            (list (list (test-org-roam--abs-path "nested/bar.org"))))
-
-    ;; Links are updated
-    (expect (with-temp-buffer
-              (insert-file-contents (test-org-roam--abs-path "nested/bar.org"))
-              (buffer-string))
-            :to-match
-            (regexp-quote "[[file:../new_foo.org][Foo]]")))
-
-  (it "foo -> foo with spaces"
-    (rename-file (test-org-roam--abs-path "foo.org")
-                 (test-org-roam--abs-path "foo with spaces.org"))
-    ;; Cache should be cleared of old file
-    (expect (caar (org-roam-db-query [:select (funcall count)
-                                      :from titles
-                                      :where (= file $s1)]
-                                     (test-org-roam--abs-path "foo.org"))) :to-be 0)
-    (expect (caar (org-roam-db-query [:select (funcall count)
-                                      :from refs
-                                      :where (= file $s1)]
-                                     (test-org-roam--abs-path "foo.org"))) :to-be 0)
-    (expect (caar (org-roam-db-query [:select (funcall count)
-                                      :from links
-                                      :where (= from $s1)]
-                                     (test-org-roam--abs-path "foo.org"))) :to-be 0)
-
-    ;; Cache should be updated
-    (expect (org-roam-db-query [:select [to]
-                                :from links
-                                :where (= from $s1)]
-                               (test-org-roam--abs-path "foo with spaces.org"))
-            :to-have-same-items-as
-            (list (list (test-org-roam--abs-path "bar.org"))))
-    (expect (org-roam-db-query [:select [from]
-                                :from links
-                                :where (= to $s1)]
-                               (test-org-roam--abs-path "foo with spaces.org"))
-            :to-have-same-items-as
-            (list (list (test-org-roam--abs-path "nested/bar.org"))))
-
-    ;; Links are updated
-    (expect (with-temp-buffer
-              (insert-file-contents (test-org-roam--abs-path "nested/bar.org"))
-              (buffer-string))
-            :to-match
-            (regexp-quote "[[file:../foo with spaces.org][Foo]]")))
-
-  (it "no-title -> meaningful-title"
-    (rename-file (test-org-roam--abs-path "no-title.org")
-                 (test-org-roam--abs-path "meaningful-title.org"))
-    ;; File has no forward links
-    (expect (caar (org-roam-db-query [:select (funcall count)
-                                      :from links
-                                      :where (= from $s1)]
-                                     (test-org-roam--abs-path "no-title.org"))) :to-be 0)
-    (expect (caar (org-roam-db-query [:select (funcall count)
-                                      :from links
-                                      :where (= from $s1)]
-                                     (test-org-roam--abs-path "meaningful-title.org"))) :to-be 1)
-
-    ;; Links are updated with the appropriate name
-    (expect (with-temp-buffer
-              (insert-file-contents (test-org-roam--abs-path "meaningful-title.org"))
-              (buffer-string))
-            :to-match
-            (regexp-quote "[[file:meaningful-title.org][meaningful-title]]")))
-
-  (it "web_ref -> hello"
-    (expect (org-roam-db-query
-             [:select [file] :from refs
-              :where (= ref $s1)]
-             "https://google.com/")
-            :to-equal
-            (list (list (test-org-roam--abs-path "web_ref.org"))))
-    (rename-file (test-org-roam--abs-path "web_ref.org")
-                 (test-org-roam--abs-path "hello.org"))
-    (expect (org-roam-db-query
-             [:select [file] :from refs
-              :where (= ref $s1)]
-             "https://google.com/")
-            :to-equal (list (list (test-org-roam--abs-path "hello.org"))))
-    (expect (caar (org-roam-db-query
-                   [:select [ref] :from refs
-                    :where (= file $s1)]
-                   (test-org-roam--abs-path "web_ref.org")))
-            :to-equal nil)))
-
-(xdescribe "delete file updates cache"
-  (before-each
-    (test-org-roam--init))
-
-  (after-each
-    (test-org-roam--teardown))
-
-  (it "delete foo"
-    (delete-file (test-org-roam--abs-path "foo.org"))
-    (expect (caar (org-roam-db-query [:select (funcall count)
-                                      :from titles
-                                      :where (= file $s1)]
-                                     (test-org-roam--abs-path "foo.org"))) :to-be 0)
-    (expect (caar (org-roam-db-query [:select (funcall count)
-                                      :from refs
-                                      :where (= file $s1)]
-                                     (test-org-roam--abs-path "foo.org"))) :to-be 0)
-    (expect (caar (org-roam-db-query [:select (funcall count)
-                                      :from links
-                                      :where (= from $s1)]
-                                     (test-org-roam--abs-path "foo.org"))) :to-be 0))
-
-  (it "delete web_ref"
-    (expect (org-roam-db-query [:select * :from refs])
-            :to-have-same-items-as
-            (list (list "https://google.com/" (test-org-roam--abs-path "web_ref.org") "website")))
-    (delete-file (test-org-roam--abs-path "web_ref.org"))
-    (expect (org-roam-db-query [:select * :from refs])
-            :to-have-same-items-as
-            (list))))
-
 (provide 'test-org-roam)
 
 ;;; test-org-roam.el ends here