diff --git a/devops-drift.el b/devops-drift.el index 04d5dda..f2b2caf 100644 --- a/devops-drift.el +++ b/devops-drift.el @@ -294,4 +294,41 @@ the buffer." (tabulated-list-print)) (pop-to-buffer buf))) +;;; State checks + +(defun devops-drift--set-lines (value) + "Normalize VALUE to a list of trimmed, non-empty lines. +VALUE is a string (split on newlines) or a possibly nested list, the +two shapes org-babel passes for :var references to blocks and tables." + (cond + ((stringp value) + (seq-remove #'string-empty-p + (mapcar #'string-trim (split-string value "\n")))) + ((listp value) (mapcan #'devops-drift--set-lines value)) + (t (list (string-trim (format "%s" value)))))) + +;;;###autoload +(defun devops-drift-set (actual expected) + "Compare ACTUAL and EXPECTED as unordered sets of lines. +Each argument is a string or a list, as org-babel passes :var values; +lines are trimmed and blanks dropped. Return \"ok (N lines)\" when the +sets match, otherwise a DRIFT report listing expected lines missing +from ACTUAL and extra lines not in EXPECTED. Meant for state-check +blocks that compare live command output against a declared expectation: + + #+begin_src elisp :var actual=live-cmd() expected=expected-block + (devops-drift-set actual expected) + #+end_src" + (let* ((actual (devops-drift--set-lines actual)) + (expected (devops-drift--set-lines expected)) + (missing (seq-difference expected actual)) + (extra (seq-difference actual expected))) + (if (not (or missing extra)) + (format "ok (%d lines)" (length expected)) + (string-join + (cons "DRIFT" + (nconc (mapcar (lambda (l) (concat "missing: " l)) missing) + (mapcar (lambda (l) (concat "extra: " l)) extra))) + "\n")))) + (provide 'devops-drift) diff --git a/devops-test.el b/devops-test.el index fc0c39c..0d436c2 100644 --- a/devops-test.el +++ b/devops-test.el @@ -752,6 +752,40 @@ afterwards), in an org buffer visiting the formatted text." (kill-buffer report) (should-not (file-directory-p root)))))) +;;; State-check set comparison (devops-drift.el) + +(ert-deftest devops-drift-set-match-test () + "Matching line sets report ok, ignoring order, blanks and whitespace." + (should (equal (devops-drift-set "b.service\na.service\n" + " a.service \n\nb.service") + "ok (2 lines)"))) + +(ert-deftest devops-drift-set-drift-test () + "Missing and extra lines are each reported." + (should (equal (devops-drift-set "a.service\nc.service" + "a.service\nb.service") + "DRIFT\nmissing: b.service\nextra: c.service"))) + +(ert-deftest devops-drift-set-table-input-test () + "Org table :var values (nested lists) normalize like strings." + (should (equal (devops-drift-set '(("a.service") ("b.service")) + "a.service\nb.service") + "ok (2 lines)"))) + +(ert-deftest devops-drift-set-org-block-test () + "An elisp check block compares a named block against a named example." + (devops-test--with-org + (concat "#+name: actual\n" + "#+begin_src emacs-lisp\n\"a.service\\nb.service\\n\"\n#+end_src\n\n" + "#+name: expected\n" + "#+begin_example\na.service\nb.service\n#+end_example\n\n" + "#+begin_src emacs-lisp :var a=actual() e=expected\n" + "(devops-drift-set a e)\n#+end_src\n") + (goto-char (point-max)) + (re-search-backward ":var a=actual") + (let ((org-confirm-babel-evaluate nil)) + (should (equal (org-babel-execute-src-block) "ok (2 lines)"))))) + ;;; devops-lob (README: per-project tools.org) (defvar devops-test--tools-org