From 44f520ccd176ef70f69a4e3bf9656d0198cfc5e8 Mon Sep 17 00:00:00 2001 From: William Carroll Date: Tue, 2 Aug 2022 13:10:10 -0700 Subject: feat(wpcarro/emacs): Support struct-update! Support mutable variant of `struct-update`. Also remove the `dash` dependency in `tests.el`. Change-Id: I76fc809e96b7cbbd3b39fd16db339cb62eab002c Reviewed-on: https://cl.tvl.fyi/c/depot/+/6027 Reviewed-by: wpcarro Autosubmit: wpcarro Tested-by: BuildkiteCI --- users/wpcarro/emacs/pkgs/struct/default.nix | 1 - users/wpcarro/emacs/pkgs/struct/struct.el | 10 +++++++ users/wpcarro/emacs/pkgs/struct/tests.el | 42 +++++++++++++++++++++-------- 3 files changed, 41 insertions(+), 12 deletions(-) diff --git a/users/wpcarro/emacs/pkgs/struct/default.nix b/users/wpcarro/emacs/pkgs/struct/default.nix index 3ea514fcd6..3c836e74ac 100644 --- a/users/wpcarro/emacs/pkgs/struct/default.nix +++ b/users/wpcarro/emacs/pkgs/struct/default.nix @@ -16,7 +16,6 @@ let { }; emacs = (pkgs.emacsPackagesFor pkgs.emacs28).emacsWithPackages (epkgs: [ - epkgs.dash struct ]); in diff --git a/users/wpcarro/emacs/pkgs/struct/struct.el b/users/wpcarro/emacs/pkgs/struct/struct.el index 36d9d4ac0b..e5b25c3836 100644 --- a/users/wpcarro/emacs/pkgs/struct/struct.el +++ b/users/wpcarro/emacs/pkgs/struct/struct.el @@ -39,6 +39,16 @@ This is immutable." (setf (,accessor copy) (funcall ,f (,accessor copy))) copy))) +(defmacro struct-update! (type field f xs) + "Mutably apply F to FIELD in XS." + (let ((accessor (->> field + symbol-name + (s-prepend (s-concat (symbol-name type) "-")) + intern))) + `(progn + (setf (,accessor ,xs) (funcall ,f (,accessor ,xs))) + ,xs))) + (defmacro struct-set (type field x xs) "Immutably set FIELD in XS (struct TYPE) to X." (let ((copier (->> type diff --git a/users/wpcarro/emacs/pkgs/struct/tests.el b/users/wpcarro/emacs/pkgs/struct/tests.el index ee48c2f6b5..a7ddb52c46 100644 --- a/users/wpcarro/emacs/pkgs/struct/tests.el +++ b/users/wpcarro/emacs/pkgs/struct/tests.el @@ -3,22 +3,42 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (require 'ert) -(require 'dash) (require 'struct) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Tests ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(ert-deftest struct-set! () - (cl-defstruct dummy name age) - (defvar struct--test-dummy (make-dummy :name "Roofus" :age 19)) - (struct-set! dummy name "Doofus" struct--test-dummy) - (should (string= "Doofus" (dummy-name struct--test-dummy)))) +(cl-defstruct dummy name age) + +(ert-deftest struct-update () + (let* ((test (make-dummy :name "Roofus" :age 19)) + (result (struct-update dummy name #'upcase test))) + ;; test + (should (string= "Roofus" (dummy-name test))) + (should (= 19 (dummy-age test))) + ;; result + (should (string= "ROOFUS" (dummy-name result))) + (should (= 19 (dummy-age result))))) + +(ert-deftest struct-update! () + (let ((test (make-dummy :name "Roofus" :age 19))) + (struct-update! dummy name #'upcase test) + (should (string= "ROOFUS" (dummy-name test))) + (should (= 19 (dummy-age test))))) (ert-deftest struct-set () - (cl-defstruct dummy name age) - (defvar struct--test-dummy (make-dummy :name "Roofus" :age 19)) - (let ((result (struct-set dummy name "Shoofus" struct--test-dummy))) - (should (string= "Roofus" (dummy-name struct--test-dummy))) - (should (string= "Shoofus" (dummy-name result))))) + (let* ((test (make-dummy :name "Roofus" :age 19)) + (result (struct-set dummy name "Shoofus" test))) + ;; test + (should (string= "Roofus" (dummy-name test))) + (should (= 19 (dummy-age test))) + ;; result + (should (string= "Shoofus" (dummy-name result))) + (should (= 19 (dummy-age result))))) + +(ert-deftest struct-set! () + (let ((test (make-dummy :name "Roofus" :age 19))) + (struct-set! dummy name "Doofus" test) + (should (string= "Doofus" (dummy-name test))) + (should (= 19 (dummy-age test))))) -- cgit 1.4.1