blob: 0508553ae488134babb3d4a7d7f11f91ea2509e8 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
(define-module (test hnh-util-lens)
:use-module (srfi srfi-64)
:use-module (srfi srfi-64 test-error)
:use-module (srfi srfi-88)
: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))
;; (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))
;; (set (list (iota 10)) first first 11)
(define cadr* (compose-lenses 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 '(10 2 3 4 5)
(car* lst 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-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-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*
;; each
|
