suzanne.soy/lens
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add alternating->assoc-list etc.

Browse Source
This commit is contained in:
AlexKnauth 2015-08-28 09:42:12 -04:00
parent 42f3325d88
commit 59a1b7473a
5 changed files with 85 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
lens/private/compound/join-hash.rkt
View File

@ -5,6 +5,7 @@
unstable/sequence
fancy-app
"../base/main.rkt"
"../util/alternating-list.rkt"
"../util/immutable.rkt"
"../util/list-pair-contract.rkt"
"join-list.rkt")
@ -18,27 +19,14 @@
[lens-join/hash (->* () #:rest (listof2 any/c lens?) (lens/c any/c immutable-hash?))]))
(define (value-list->hash keys vs)
(make-immutable-hash (map cons keys vs)))
(define (split-slice n vs)
(define grouped
(for/list ([group (in-slice n vs)])
group))
(define (get-ith i)
(map (list-ref _ i) grouped))
(build-list n get-ith))
(module+ test
(check-equal? (split-slice 3 '(a 1 FOO b 2 BAR c 3 BAZ))
'((a b c) (1 2 3) (FOO BAR BAZ))))
(define (keys+values->hash keys vs)
(make-immutable-hash (keys+values->assoc-list keys vs)))
(define (lens-join/hash . keys/lenses)
(match-define (list keys lenses) (split-slice 2 keys/lenses))
(define-values [keys lenses] (alternating-list->keys+values keys/lenses))
(define list-lens (apply lens-join/list lenses))
(define (get target)
(value-list->hash keys (lens-view list-lens target)))
(keys+values->hash keys (lens-view list-lens target)))
(define (set target new-view-hash)
(lens-set list-lens target (map (hash-ref new-view-hash _) keys)))
(make-lens get set))

26
lens/private/compound/join-list.rkt
View File

@ -1,26 +1,24 @@
#lang racket/base
#lang sweet-exp racket/base
(require racket/list
racket/contract
"../base/main.rkt")
require racket/list
racket/contract
"../base/main.rkt"
"../util/alternating-list.rkt"
(module+ test
(require rackunit
"../list/list-ref-take-drop.rkt"))
module+ test
require rackunit
"../list/list-ref-take-drop.rkt"
(provide
(contract-out
[lens-join/list (->* () #:rest (listof lens?) (lens/c any/c list?))]))
provide
contract-out
lens-join/list (->* () #:rest (listof lens?) (lens/c any/c list?))
(define (zip xs ys)
(append-map list xs ys))
(define (lens-join/list . lenses)
(define (get target)
(apply lens-view/list target lenses))
(define (set target new-views)
(apply lens-set/list target (zip lenses new-views)))
(apply lens-set/list target (keys+values->alternating-list lenses new-views)))
(make-lens get set))

61
lens/private/util/alternating-list.rkt Normal file
View File

@ -0,0 +1,61 @@
#lang sweet-exp racket/base
provide alternating->assoc-list
assoc->alternating-list
keys+values->assoc-list
assoc-list->keys+values
keys+values->alternating-list
alternating-list->keys+values
require racket/list
racket/match
unstable/sequence
module+ test
require rackunit
(define (alternating->assoc-list alternating-list)
(for/list ([lst (in-slice 2 alternating-list)])
(match-define (list a b) lst)
(cons a b)))
(define (assoc->alternating-list alist)
(append*
(for/list ([(k v) (in-pairs alist)])
(list k v))))
(define (keys+values->assoc-list keys values)
(map cons keys values))
(define (assoc-list->keys+values alist)
(values (map car alist)
(map cdr alist)))
(define (keys+values->alternating-list keys values)
(append-map list keys values))
(define (alternating-list->keys+values alternating-list)
(for/lists (ks vv) ([lst (in-slice 2 alternating-list)])
(match-define (list k v) lst)
(values k v)))
module+ test
(check-equal? (alternating->assoc-list '(a 1 b 2)) '((a . 1) (b . 2)))
(check-equal? (alternating->assoc-list '(b 2 a 1)) '((b . 2) (a . 1)))
(check-equal? (assoc->alternating-list '((a . 1) (b . 2))) '(a 1 b 2))
(check-equal? (assoc->alternating-list '((b . 2) (a . 1))) '(b 2 a 1))
(check-equal? (keys+values->assoc-list '(a b) '(1 2)) '((a . 1) (b . 2)))
(check-equal? (keys+values->assoc-list '(b a) '(2 1)) '((b . 2) (a . 1)))
(check-equal? (keys+values->alternating-list '(a b) '(1 2)) '(a 1 b 2))
(check-equal? (keys+values->alternating-list '(b a) '(2 1)) '(b 2 a 1))
(let-values ([(ks vs) (assoc-list->keys+values '((a . 1) (b . 2)))])
(check-equal? ks '(a b))
(check-equal? vs '(1 2)))
(let-values ([(ks vs) (assoc-list->keys+values '((b . 2) (a . 1)))])
(check-equal? ks '(b a))
(check-equal? vs '(2 1)))
(let-values ([(ks vs) (alternating-list->keys+values '(a 1 b 2))])
(check-equal? ks '(a b))
(check-equal? vs '(1 2)))
(let-values ([(ks vs) (alternating-list->keys+values '(b 2 a 1))])
(check-equal? ks '(b a))
(check-equal? vs '(2 1)))

3
unstable/lens/isomorphism/data.rkt
View File

@ -10,6 +10,7 @@ provide string->symbol-lens
string->list-lens
require lens/private/base/main
lens/private/util/alternating-list
"base.rkt"
module+ test
@ -24,6 +25,8 @@ module+ test
(make-isomorphism-lenses list->vector vector->list))
(define-values [list->string-lens string->list-lens]
(make-isomorphism-lenses list->string string->list))
(define-values [alternating->assoc-list-lens assoc->alternating-list-lens]
(make-isomorphism-lenses alternating->assoc-list assoc->alternating-list))
(module+ test

9
unstable/lens/join-assoc.rkt
View File

@ -5,21 +5,20 @@ provide lens-join/assoc
require lens/private/base/main
lens/private/compound/join-list
lens/private/list/assoc
lens/private/util/alternating-list
racket/match
unstable/sequence
module+ test
require rackunit lens/private/list/main
(define (lens-join/assoc . ks/lenses)
(match-define (list (list keys lenses) ...)
(for/list ([k/lens (in-slice 2 ks/lenses)])
k/lens))
(define-values [keys lenses]
(alternating-list->keys+values ks/lenses))
(define key-lenses (map assoc-lens keys))
(define list-lens (apply lens-join/list lenses))
(make-lens
(λ (tgt)
(for/list ([k (in-list keys)] [lens (in-list lenses)])
(cons k (lens-view lens tgt))))
(keys+values->assoc-list keys (lens-view list-lens tgt)))
(λ (tgt nvw)
(lens-set list-lens tgt (apply lens-view/list nvw key-lenses)))))