Function: combobulate-procedure-validate

combobulate-procedure-validate is a natively compiled function defined in combobulate-procedure.el.

Signature

(combobulate-procedure-validate PROCEDURE)

Documentation

Validate PROCEDURE.

Source Code

;; Defined in /nix/store/b5fvrwzi3zvkabyzx0in6gw1cj963z46-emacs-packages-deps/share/emacs/site-lisp/combobulate-procedure.el
(defun combobulate-procedure-validate (procedure)
  "Validate PROCEDURE."
  ;; assert that there are no keys beyond these three
  (when-let (unknown-keys (seq-difference (map-keys procedure)
                                          '(:activation-nodes :selector)))
    (error "Unknown key in procedure `%s'. Only `:activation-nodes' or
 `:selector' are valid" unknown-keys))
  (map-let (:activation-nodes :selector)
      procedure
    (unless (listp activation-nodes)
      (error "Expected `:activation-nodes' to be a list, but got `%s'" :activation-nodes))
    (dolist (activation-node activation-nodes)
      (when (and (plist-get activation-node :has-parent)
                 (plist-get activation-node :has-ancestor)
                 (plist-get activation-node :has-fields))
        (error "`:activation-node' allows only: `:has-parent', `:has-ancestor', or `:has-fields' but got `%s'" activation-node)))
    (when selector
      (map-let (:match-children :match-siblings :match-query)
          selector
        (let ((matcher))
          (setq matcher (or (plist-get selector :match-children)
                            (plist-get selector :match-siblings)
                            (plist-get selector :match-query)))
          (cond
           ((or match-children match-siblings)
            (unless (or (listp matcher) (equal matcher 't))
              (error "Expected `:selector' to have a list of matchers, but got `%s'" matcher)))
           (match-query
            ;; match-query should be a list (:query QUERY :discard-rules RULES :engine ENGINE)
            (unless (and (listp matcher)
                         (let ((query (plist-get matcher :query))
                               ;; (discard-rules (plist-get matcher :discard-rules))
                               )
                           (and (listp query))))
              (error "Query matchers must have `:query' (and optionally `:discard-rules') but got `%s'" matcher))
            ;; cquery and query should match using `@match' and
            ;; `@discard' and not other markers.
            (when match-query
              (when-let
                  (wrong-mark
                   (seq-find
                    (lambda (query-atom)
                      (and
                       ;; only check symbols!
                       (symbolp query-atom)
                       (let ((name (symbol-name query-atom)))
                         ;; ensure the name, if it starts with
                         ;; `@', is either `@match' or
                         ;; `@discard'.
                         (and (string-prefix-p "@" name)
                              (not (member name '("@match" "@discard")))))))
                    (flatten-tree matcher)))
                (error "`:match-query' should use `@match' and `@discard' to tag nodes, but got `%s'" wrong-mark))))
           (t
            (error "Expected `:selector' to have either `:match-children' or `:match-query', but got `%s'" selector))))))))