mirror of
https://github.com/fiddlerwoaroof/data-lens.git
synced 2025-11-08 18:26:32 +00:00
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
This commit is contained in:
@ -8,7 +8,8 @@
|
|||||||
:author "Edward Langley <el-cl@elangley.org>"
|
:author "Edward Langley <el-cl@elangley.org>"
|
||||||
:license "Apache v2"
|
:license "Apache v2"
|
||||||
:depends-on (:cl-ppcre
|
:depends-on (:cl-ppcre
|
||||||
:alexandria)
|
:alexandria
|
||||||
|
(:require :sb-cover))
|
||||||
:serial t
|
:serial t
|
||||||
:in-order-to ((test-op (test-op :data-lens/test)))
|
:in-order-to ((test-op (test-op :data-lens/test)))
|
||||||
:components ((:file "package")
|
:components ((:file "package")
|
||||||
@ -20,7 +21,8 @@
|
|||||||
:author "Edward Langley <el-cl@elangley.org>"
|
:author "Edward Langley <el-cl@elangley.org>"
|
||||||
:license "Apache v2"
|
:license "Apache v2"
|
||||||
:depends-on (:data-lens
|
:depends-on (:data-lens
|
||||||
:fiveam)
|
:fiveam
|
||||||
|
:string-case)
|
||||||
:serial t
|
:serial t
|
||||||
:perform (test-op (o c)
|
:perform (test-op (o c)
|
||||||
(unless (symbol-call :fiveam '#:run! :data-lens.lens)
|
(unless (symbol-call :fiveam '#:run! :data-lens.lens)
|
||||||
|
|||||||
15
lens.lisp
15
lens.lisp
@ -102,7 +102,7 @@
|
|||||||
|
|
||||||
(defun-ct of-max-length (len)
|
(defun-ct of-max-length (len)
|
||||||
(lambda (it)
|
(lambda (it)
|
||||||
(>= (length it)
|
(<= (length it)
|
||||||
len)))
|
len)))
|
||||||
|
|
||||||
(defun-ct applicable-when (fun test)
|
(defun-ct applicable-when (fun test)
|
||||||
@ -114,6 +114,7 @@
|
|||||||
(defmacro conj (&rest fns)
|
(defmacro conj (&rest fns)
|
||||||
(let ((dat (gensym "dat")))
|
(let ((dat (gensym "dat")))
|
||||||
`(lambda (,dat)
|
`(lambda (,dat)
|
||||||
|
(declare (ignorable ,dat))
|
||||||
(and ,@(mapcar (lambda (fn)
|
(and ,@(mapcar (lambda (fn)
|
||||||
`(funcall ,fn ,dat))
|
`(funcall ,fn ,dat))
|
||||||
fns)))))
|
fns)))))
|
||||||
@ -226,6 +227,18 @@
|
|||||||
(apply f args))
|
(apply f args))
|
||||||
r)))))
|
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)
|
(defun =>> (fun1 fun2)
|
||||||
(lambda (i)
|
(lambda (i)
|
||||||
(prog1 (funcall fun1 i)
|
(prog1 (funcall fun1 i)
|
||||||
|
|||||||
@ -20,7 +20,7 @@
|
|||||||
#:transform-head #:maximizing #:zipping #:applying
|
#:transform-head #:maximizing #:zipping #:applying
|
||||||
#:splice-elt #:transform-elt #:denest #:op #:defalias #:<>
|
#:splice-elt #:transform-elt #:denest #:op #:defalias #:<>
|
||||||
#:<>1 #:== #:• #:suffixp #:functionalize #:inc #:group-by
|
#:<>1 #:== #:• #:suffixp #:functionalize #:inc #:group-by
|
||||||
#:keys #:conj #:disj))
|
#:keys #:conj #:disj #:delay))
|
||||||
|
|
||||||
(defpackage :data-lens.transducers.internals
|
(defpackage :data-lens.transducers.internals
|
||||||
(:use :cl)
|
(:use :cl)
|
||||||
|
|||||||
219
t/lens.lisp
219
t/lens.lisp
@ -6,17 +6,6 @@
|
|||||||
(5am:def-suite :data-lens.lens)
|
(5am:def-suite :data-lens.lens)
|
||||||
(5am:in-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:def-test functionalize (:suite :data-lens.lens)
|
||||||
(5am:is (equal 2
|
(5am:is (equal 2
|
||||||
(funcall (data-lens:functionalize #'1+) 1)))
|
(funcall (data-lens:functionalize #'1+) 1)))
|
||||||
@ -29,6 +18,214 @@
|
|||||||
(alexandria:plist-hash-table '(1 8 2 4)))
|
(alexandria:plist-hash-table '(1 8 2 4)))
|
||||||
1))))
|
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")
|
||||||
|
"<acb>")))))
|
||||||
|
|
||||||
|
(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:def-test on (:suite :data-lens.lens :depends-on (and functionalize))
|
||||||
(5am:is (equal 2
|
(5am:is (equal 2
|
||||||
(funcall (data-lens:on '1+ 'car)
|
(funcall (data-lens:on '1+ 'car)
|
||||||
|
|||||||
Reference in New Issue
Block a user