Add core tests

This commit is contained in:
JackFirth 2015-02-22 18:37:18 -08:00
parent 58a6f214d0
commit b01fe1f6b6

View File

@ -1,5 +1,7 @@
#lang racket
(require rackunit)
(provide lens/c
let-lens
lens-view
@ -7,16 +9,38 @@
lens-transform
lens-compose)
(module+ test
(define (first-lens lst)
(values (first lst)
(λ (v) (cons v (drop lst 1)))))
(define (second-lens lst)
(values (second lst)
(λ (v)
(append (take lst 1)
(list v)
(drop lst 2))))))
;; Lens contract
(define (lens/c input subcomponent)
(-> input
(values subcomponent
(-> subcomponent
input))))
;; Lens result local bindings syntax
(define-syntax-rule (let-lens (view setter) lens-call-expr body ...)
(let-values ([(view setter) lens-call-expr])
body ...))
(module+ test
(let-lens (view-first setter-first) (first-lens '(1 2 3 4 5))
(check-eqv? view-first 1)
(check-equal? (setter-first 'a) '(a 2 3 4 5))))
;; Helpers for only working with one half of a lens
(define (lens-view lens v)
(let-lens (view _) (lens v)
view))
@ -25,19 +49,43 @@
(let-lens (_ setter) (lens v)
(setter x)))
(module+ test
(check-eqv? (lens-view second-lens '(1 2 3)) 2)
(check-equal? (lens-set second-lens '(1 2 3) 'a) '(1 a 3)))
;; Composing a lens with a function to make a value-sensitive setter
(define (lens-transform lens v f)
(let-lens (view setter) (lens v)
(setter (f view))))
(module+ test
(check-equal? (lens-transform second-lens '(1 2 3) number->string) '(1 "2" 3)))
;; Lens composition
(define ((lens-compose2 sub-lens super-lens) v)
(let-lens (super-view super-setter) (super-lens v)
(let-lens (sub-view sub-setter) (sub-lens super-view)
(values sub-view
(compose super-setter sub-setter)))))
(module+ test
(define first-of-second-lens (lens-compose2 first-lens second-lens))
(define test-alist '((a 1) (b 2) (c 3)))
(check-eq? (lens-view first-of-second-lens test-alist) 'b)
(check-equal? (lens-set first-of-second-lens test-alist 'B)
'((a 1) (B 2) (c 3))))
(define ((generalize-operator op) v . vs)
(if (empty? vs)
v
(foldl (λ (next-v previous) (op previous next-v)) vs)))
(foldl (λ (next-v previous) (op previous next-v)) v vs)))
(module+ test
(define (num-append2 n m)
(+ (* 10 n) m))
(define num-append (generalize-operator num-append2))
(check-eqv? (num-append 1 2 3 4 5) 12345))
(define lens-compose (generalize-operator lens-compose2))