From 0c3c2bd08d0c590721d563dd414145fff85a23a3 Mon Sep 17 00:00:00 2001 From: Edward Langley Date: Sat, 1 Oct 2022 12:00:23 -0700 Subject: [PATCH] chore: more tests, fixes - add DELAY as the new name for JUST-AFTER (JUST-AFTER now warns) - fix definition of OF-MAX-LENGTH - add ignorable declaration to CONJ and DISJ - lots of new tests --- data-lens.asd | 6 +- lens.lisp | 15 +++- package.lisp | 2 +- t/lens.lisp | 219 +++++++++++++++++++++++++++++++++++++++++++++++--- 4 files changed, 227 insertions(+), 15 deletions(-) diff --git a/data-lens.asd b/data-lens.asd index 025cf84..dc27042 100644 --- a/data-lens.asd +++ b/data-lens.asd @@ -8,7 +8,8 @@ :author "Edward Langley " :license "Apache v2" :depends-on (:cl-ppcre - :alexandria) + :alexandria + (:require :sb-cover)) :serial t :in-order-to ((test-op (test-op :data-lens/test))) :components ((:file "package") @@ -20,7 +21,8 @@ :author "Edward Langley " :license "Apache v2" :depends-on (:data-lens - :fiveam) + :fiveam + :string-case) :serial t :perform (test-op (o c) (unless (symbol-call :fiveam '#:run! :data-lens.lens) diff --git a/lens.lisp b/lens.lisp index 9b16012..ffa0eb5 100644 --- a/lens.lisp +++ b/lens.lisp @@ -102,7 +102,7 @@ (defun-ct of-max-length (len) (lambda (it) - (>= (length it) + (<= (length it) len))) (defun-ct applicable-when (fun test) @@ -114,6 +114,7 @@ (defmacro conj (&rest fns) (let ((dat (gensym "dat"))) `(lambda (,dat) + (declare (ignorable ,dat)) (and ,@(mapcar (lambda (fn) `(funcall ,fn ,dat)) fns))))) @@ -226,6 +227,18 @@ (apply f args)) r))))) +(defun delay () + "Return a function that always returns the last thing it was called with" + (let ((result nil)) + (lambda (v) + (prog1 result + (setf result v))))) + +(defun just-after () + "Return a function that always returns the last thing it was called with" + (warn "JUST-AFTER renamed to DELAY") + (delay)) + (defun =>> (fun1 fun2) (lambda (i) (prog1 (funcall fun1 i) diff --git a/package.lisp b/package.lisp index 185445e..0b13632 100644 --- a/package.lisp +++ b/package.lisp @@ -20,7 +20,7 @@ #:transform-head #:maximizing #:zipping #:applying #:splice-elt #:transform-elt #:denest #:op #:defalias #:<> #:<>1 #:== #:• #:suffixp #:functionalize #:inc #:group-by - #:keys #:conj #:disj)) + #:keys #:conj #:disj #:delay)) (defpackage :data-lens.transducers.internals (:use :cl) diff --git a/t/lens.lisp b/t/lens.lisp index 8a36962..3967300 100644 --- a/t/lens.lisp +++ b/t/lens.lisp @@ -6,17 +6,6 @@ (5am:def-suite :data-lens.lens) (5am:in-suite :data-lens.lens) -(5am:def-test == (:suite :data-lens.lens) - (5am:is (equal t - (funcall (data-lens:== 1) - 1))) - (5am:is (equal nil - (funcall (data-lens:== (list "1")) - (list "1")))) - (5am:is (equal t - (funcall (data-lens:== (list "1") :test #'equal) - (list "1"))))) - (5am:def-test functionalize (:suite :data-lens.lens) (5am:is (equal 2 (funcall (data-lens:functionalize #'1+) 1))) @@ -29,6 +18,214 @@ (alexandria:plist-hash-table '(1 8 2 4))) 1)))) +(5am:def-test == (:suite :data-lens.lens) + (5am:is (equal t + (funcall (data-lens:== 1) + 1))) + (5am:is (equal nil + (funcall (data-lens:== (list "1")) + (list "1")))) + (5am:is (equal t + (funcall (data-lens:== (list "1") :test #'equal) + (list "1"))))) + +(5am:def-test delay (:suite :data-lens.lens) + (5am:is (equal '((nil 1) + (1 2) + (2 3) + (3 4)) + (mapcar (data-lens:juxt (data-lens:delay) + 'identity) + '(1 2 3 4))))) + +(5am:def-test of-length (:suite :data-lens.lens) + (5am:is (equal t + (funcall (data-lens:of-length 3) + '(1 2 3)))) + (5am:is (equal nil + (funcall (data-lens:of-length 3) + '(2 3)))) + (5am:is (equal t + (funcall (data-lens:of-length 0) + '()))) + (5am:is (equal t + (funcall (data-lens:of-length 1) + '(1))))) + +(5am:def-test of-min-length (:suite :data-lens.lens) + (5am:is (equal t + (funcall (data-lens:of-min-length 3) + '(1 2 3 4 5)))) + (5am:is (equal nil + (funcall (data-lens:of-min-length 3) + '(2 3)))) + (5am:is (equal t + (funcall (data-lens:of-min-length 0) + '()))) + (5am:is (equal t + (funcall (data-lens:of-min-length 0) + '(1))))) + +(5am:def-test of-max-length (:suite :data-lens.lens) + (5am:is (equal nil + (funcall (data-lens:of-max-length 3) + '(1 2 3 4 5)))) + (5am:is (equal t + (funcall (data-lens:of-max-length 3) + '(2 3)))) + (5am:is (equal t + (funcall (data-lens:of-max-length 0) + '()))) + (5am:is (equal nil + (funcall (data-lens:of-max-length 0) + '(1))))) + +(5am:def-test applicable-when (:suite :data-lens.lens) + (5am:is (equal 1 + (funcall (data-lens:applicable-when '1+ (constantly nil)) + 1))) + (5am:is (equal 2 + (funcall (data-lens:applicable-when '1+ (constantly t)) + 1)))) + +(5am:def-test conj (:suite :data-lens.lens) + (5am:is (equal t + (not + (not + (eval `(funcall (data-lens:conj 'oddp 'identity) + 1)))))) + (5am:is (equal nil + (not + (not + (eval `(funcall (data-lens:conj 'oddp 'evenp) + 1)))))) + (5am:is (equal t + (not + (not + (eval `(funcall (data-lens:conj) + 1))))))) + +(5am:def-test disj (:suite :data-lens.lens) + (5am:is (equal t + (not + (not + (eval `(funcall (data-lens:disj 'oddp 'identity) + 1)))))) + (5am:is (equal t + (not + (not + (eval `(funcall (data-lens:disj 'oddp 'evenp) + 1)))))) + (5am:is (equal nil + (not + (not + (eval `(funcall (data-lens:disj) + 1))))))) + +(5am:def-test sorted (:suite :data-lens.lens) + (5am:is (equal '(1 2 3 4 5) + (funcall (data-lens:sorted '<) + '(5 4 3 2 1))))) + +(5am:def-test element (:suite :data-lens.lens) + (5am:is (equal 1 + (funcall (data-lens:element 1) + '(0 1 2 3)))) + (5am:is (equal 1 + (funcall (data-lens:element 1) + #(0 1 2 3))))) + +(defclass my-map () + ((%a :initform 1 :reader a) + (%b :initform 2 :reader b) + (%c :initform 3 :reader c) + (%d :initform 4 :reader d))) +(defmethod data-lens:extract-key ((map my-map) key) + (string-case:string-case (key) + ("a" (a map)) + ("b" (b map)) + ("c" (c map)) + ("d" (d map)))) + +(5am:def-test key (:suite :data-lens.lens) + (5am:is (equal 1 + (funcall (data-lens:key "a") + (alexandria:alist-hash-table + '(("b" . 2) + ("a" . 1) + ("c" . 3)) + :test 'equal)))) + + (5am:is (equal 1 + (funcall (data-lens:key "a") + '(("b" . 2) + ("a" . 1) + ("c" . 3))))) + (5am:is (equal 1 + (funcall (data-lens:key "a") + '("b" 2 + "a" 1 + "c" 3)))) + + (5am:is (equal 1 + (funcall (data-lens:key "a") + (make-instance 'my-map))))) + +(5am:def-test keys (:suite :data-lens.lens) + (5am:is (equal 4 + (funcall (data-lens:keys "a" "b" "c" "d") + (list (cons "a" + (list "b" + (alexandria:alist-hash-table + (acons "c" (make-instance 'my-map) ()) + :test 'equal)))))))) + +(5am:def-test regex-match (:suite :data-lens.lens) + (5am:is (serapeum:seq= + (list "acb" #("c")) + (multiple-value-list + (funcall (data-lens:regex-match "a(.)b") + ""))))) + +(5am:def-test include (:suite :data-lens.lens) + (5am:is (equal '(1 3 5) + (funcall (data-lens:include 'oddp) + '(1 2 3 4 5 6))))) + +(5am:def-test exclude (:suite :data-lens.lens) + (5am:is (equal '(2 4 6) + (funcall (data-lens:exclude 'oddp) + '(1 2 3 4 5 6))))) + +(5am:def-test pick (:suite :data-lens.lens) + (5am:is (equal '(1 2 3) + (funcall (data-lens:pick 'car) + '((1 2) (2 3) (3 4))))) + (5am:is (equal '() + (funcall (data-lens:pick 'car) + '())))) + +(5am:def-test slice (:suite :data-lens.lens) + (5am:is (equal '(1) + (funcall (data-lens:slice 1 2) + '(0 1 2))))) + +(5am:def-test update (:suite :data-lens.lens) + (5am:is-true (funcall (data-lens:suffixp "qwer") + "asdfqwer")) + (5am:is-true (funcall (data-lens:suffixp (mapcar 'copy-seq + (list "q" "w" "e" "r")) + :test 'equal) + '("a" "s" "d" "f" "q" "w" "e" "r"))) + (5am:is-false (funcall (data-lens:suffixp "qwer") + "qwerasdf")) + (5am:is-false (funcall (data-lens:suffixp (mapcar 'copy-seq + (list "q" "w" "e" "r")) + :test 'equal) + '("q" "w" "e" "r" "a" "s" "d" "f")))) + +(5am:def-test suffixp (:suite :data-lens.lens)) + (5am:def-test on (:suite :data-lens.lens :depends-on (and functionalize)) (5am:is (equal 2 (funcall (data-lens:on '1+ 'car)