mirror of
https://github.com/fiddlerwoaroof/data-lens.git
synced 2025-11-08 10:16:32 +00:00
Compare commits
12 Commits
08302fae40
...
903c0aaced
| Author | SHA1 | Date | |
|---|---|---|---|
| 903c0aaced | |||
| 3f27d70514 | |||
| a3724362b6 | |||
| 6c2d96f0c6 | |||
| 4eab1df341 | |||
| 555b621974 | |||
| 46b1b66291 | |||
| fde90ed5ff | |||
| 7309c59ca8 | |||
| 821ec9407b | |||
| 49358627c2 | |||
| 9c4d29543b |
12
.github/workflows/test.yml
vendored
12
.github/workflows/test.yml
vendored
@ -22,7 +22,7 @@ jobs:
|
||||
# Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it
|
||||
- uses: actions/checkout@v2
|
||||
|
||||
- uses: cachix/install-nix-action@v15
|
||||
- uses: cachix/install-nix-action@v19
|
||||
with:
|
||||
extra_nix_config: |
|
||||
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
|
||||
@ -34,6 +34,15 @@ jobs:
|
||||
cd
|
||||
|
||||
nix profile install nixpkgs\#sbcl
|
||||
|
||||
- name: setup lisp
|
||||
run: |
|
||||
set -x
|
||||
nix profile list
|
||||
export PATH="$HOME/.nix-profile/bin:$PATH"
|
||||
echo $PATH
|
||||
ls ~/.nix-profile/bin
|
||||
sbcl --quit
|
||||
command -v sbcl || exit 36
|
||||
|
||||
wget 'https://beta.quicklisp.org/quicklisp.lisp'
|
||||
@ -47,6 +56,7 @@ jobs:
|
||||
|
||||
- name: run tests
|
||||
run: |
|
||||
export PATH="$HOME/.nix-profile/bin:$PATH"
|
||||
cd "$GITHUB_WORKSPACE"
|
||||
sbcl --disable-debugger --no-userinit \
|
||||
--load "$HOME/quicklisp/setup.lisp" \
|
||||
|
||||
28
lens.lisp
28
lens.lisp
@ -132,6 +132,7 @@
|
||||
(defmacro disj (&rest fns)
|
||||
(let ((dat (gensym "dat")))
|
||||
`(lambda (,dat)
|
||||
(declare (ignorable ,dat))
|
||||
(or ,@(mapcar (lambda (fn)
|
||||
`(funcall ,fn ,dat))
|
||||
fns)))))
|
||||
@ -291,10 +292,29 @@
|
||||
seq
|
||||
:initial-value ()))))
|
||||
|
||||
(defun over (fun &key (result-type 'list))
|
||||
(let ((fun (functionalize fun)))
|
||||
(lambda (seq)
|
||||
(map result-type fun seq))))
|
||||
(defun over (fun &rest funs)
|
||||
(let* ((fun (functionalize fun))
|
||||
(rt-pos (position :result-type funs))
|
||||
(result-type (cond
|
||||
((null rt-pos) 'list)
|
||||
((>= (1+ rt-pos)
|
||||
(length funs))
|
||||
(error "invalid result-type"))
|
||||
(t
|
||||
(elt funs (1+ rt-pos)))))
|
||||
(funs (if rt-pos
|
||||
(append (mapcar #'functionalize
|
||||
(subseq funs 0 rt-pos))
|
||||
(mapcar #'functionalize
|
||||
(subseq funs (+ rt-pos 2))))
|
||||
(mapcar #'functionalize funs)))
|
||||
(combined-fun (if funs
|
||||
(apply #'alexandria:compose fun funs)
|
||||
fun)))
|
||||
(lambda (seq &rest seqs)
|
||||
(if seqs
|
||||
(apply #'map result-type combined-fun seq seqs)
|
||||
(map result-type combined-fun seq)))))
|
||||
|
||||
(defun denest (&key (result-type 'list))
|
||||
(lambda (seq)
|
||||
|
||||
@ -250,6 +250,12 @@
|
||||
(5am:is (equalp #(1 2 3)
|
||||
(funcall (data-lens:over '1+ :result-type 'vector)
|
||||
'(0 1 2))))
|
||||
(5am:is (equalp #(2 3 4)
|
||||
(funcall (data-lens:over '1+ :result-type 'vector '1+)
|
||||
'(0 1 2))))
|
||||
(5am:is (equalp #(2 3 4)
|
||||
(funcall (data-lens:over '1+ '1+ :result-type 'vector)
|
||||
'(0 1 2))))
|
||||
(5am:is (equalp #(1 2 3)
|
||||
(funcall (data-lens:over '1+ :result-type 'vector)
|
||||
#(0 1 2)))))
|
||||
|
||||
Reference in New Issue
Block a user