aboutsummaryrefslogtreecommitdiff
path: root/tests/unit/util/hnh-util-lens.scm
diff options
context:
space:
mode:
Diffstat (limited to 'tests/unit/util/hnh-util-lens.scm')
-rw-r--r--tests/unit/util/hnh-util-lens.scm68
1 files changed, 42 insertions, 26 deletions
diff --git a/tests/unit/util/hnh-util-lens.scm b/tests/unit/util/hnh-util-lens.scm
index 0f4af6cb..6e8b5831 100644
--- a/tests/unit/util/hnh-util-lens.scm
+++ b/tests/unit/util/hnh-util-lens.scm
@@ -2,60 +2,76 @@
:use-module (srfi srfi-64)
:use-module (srfi srfi-64 test-error)
:use-module (srfi srfi-88)
+ :use-module ((hnh util) :select (enumerate))
:use-module (hnh util lens))
(define first (ref 0))
-(test-equal '((1)) (first '(((1)))))
-(test-equal '((2)) (set '(((1))) (compose-lenses first first) 2))
-(test-equal '(((2))) (set '(((1))) (compose-lenses first first first) 2))
+(test-equal '((1)) (get '(((1))) first))
+
+(test-equal '((2)) (set '(((1))) (compose-lens first first) 2))
+(test-equal '(((2))) (set '(((1))) (compose-lens first first first) 2))
;; (list-change (iota 10) 5 'Hello)
;; => (0 1 2 3 4 Hello 6 7 8 9)
-(test-equal '(1 (10) 3) (set '(1 (2) 3) (compose-lenses (ref 1) (ref 0)) 10))
-(test-equal '(1 (10) 3) (set '(1 (2) 3) (ref 1) (ref 0) 10))
+(test-equal '(1 (10) 3) (set '(1 (2) 3)
+ (compose-lens (ref 1) (ref 0))
+ 10))
+(test-equal '(1 (10) 3) (set '(1 (2) 3)
+ (compose-lens (ref 1) (ref 0))
+ 10))
;; (set (list (iota 10)) first first 11)
-(define cadr* (compose-lenses cdr* car*))
+(define cadr* (compose-lens cdr* car*))
(test-group "Primitive lenses get and set"
(define lst '(1 2 3 4 5))
- (test-equal 1 (car* lst))
- (test-equal '(2 3 4 5) (cdr* lst))
+ (test-equal 1 (get lst car*))
+ (test-equal '(2 3 4 5) (get lst cdr*))
(test-equal '(10 2 3 4 5)
- (car* lst 10)))
+ (set lst car* 10)))
(test-group "Primitive lens composition"
(define lst '(1 2 3 4 5))
- (test-equal 2 (cadr* lst))
- (test-equal '(1 10 3 4 5) (cadr* lst 10)))
+ (test-equal 2 (get lst cadr*))
+ (test-equal '(1 10 3 4 5) (set lst cadr* 10)))
(test-group "Modify"
(define lst '(1 2 3 4 5))
- (test-equal '(10 2 3 4 5) (modify lst car* * 10))
- (test-equal '(1 20 3 4 5) (modify lst cadr* * 10))
+ (test-equal '(10 2 3 4 5) (modify lst car* (lambda (x) (* x 10))))
+ (test-equal '(1 20 3 4 5) (modify lst cadr* (lambda (x) (* x 10))))
)
(test-group "Modify*"
(define lst '(1 2 3 4 5))
- (test-equal '(1 2 4 4 5) (modify* lst cdr* cdr* car* 1+)))
-
-;; modify
-;; modify*
-;; set
-;; get
-
-;; identity-lens
-;; compose-lenses
-;; lens-compose
-
-;; ref car* cdr*
+ (test-equal '(1 2 4 4 5)
+ (modify lst (lens-compose cdr* cdr* car*) 1+)))
+
+(test-equal
+ "!e!l!,!W!r!d"
+ (list->string
+ (map cadr
+ (set (enumerate (string->list "Hello, World"))
+ (compose-lens
+ (focus-matching (compose even? car))
+ cdr*)
+ '(#\!)))))
+
+
+(test-group "Identity lens"
+ (test-equal 'anything
+ (get 'anything identity-lens))
+ (test-equal 'else
+ (set 'anything identity-lens 'else))
+
+ (test-equal '(1 x 3)
+ (set '(1 2 3) (lens-compose cdr* identity-lens car*)
+ 'x)))
-;; each
'((hnh util lens))