fix: quickload systems

.github/workflows/test.yml

@@ -58,11 +58,13 @@ jobs:
         run: |
           export PATH="$HOME/.nix-profile/bin:$PATH"
           cd "$GITHUB_WORKSPACE"
+          ln -s "$GITHUB_WORKSPACE" "$HOME/quicklisp/local-projects"
           sbcl --disable-debugger --no-userinit \
                --load "$HOME/quicklisp/setup.lisp" \
                --eval "(mapcar 'asdf:load-asd (directory \"*.asd\"))" \
-               --eval "(ql:quickload :data-lens/test)" \
+               --eval '(format *error-output* "~{~A~%~}" (asdf:registered-systems))' \
-               --eval "(handler-case (asdf:test-system :data-lens/test) (error () (uiop:quit 42)))" \
+               --eval "(handler-case (ql:quickload :data-lens) (error (c) (format t \"~a\" c) (uiop:quit 41)))" \
-               --eval "(ql:quickload :data-lens/transducers/test)" \
+               --eval "(handler-case (asdf:test-system :data-lens) (error (c) (format t \"~a\" c) (uiop:quit 42)))" \
-               --eval "(handler-case (asdf:test-system :data-lens/transducers/test) (error () (uiop:quit 43)))" \
+               --eval "(handler-case (ql:quickload :data-lens/transducers) (error (c) (format t \"~a\" c) (uiop:quit 43)))" \
+               --eval "(handler-case (asdf:test-system :data-lens/transducers) (error (c) (format t \"~a\" c) (uiop:quit 44)))" \
                --quit

data-lens.asd

@@ -32,7 +32,7 @@
   :components ((:module "t"
                 :components ((:file "lens")))))
 
-(asdf:defsystem #:data-lens/beta/transducers
+(asdf:defsystem #:data-lens/transducers
   :description #.(format nil "~@{~a~^ ~}"
                          "A collection of transducers to reduce stream-manipulation overhead")
   :author "Edward Langley <el-cl@elangley.org>"
@@ -47,6 +47,14 @@
                (:file "transducers")
                (:file "lazy-sequence")))
 
+(asdf:defsystem #:data-lens/beta/transducers
+  :description #.(format nil "~@{~a~^ ~}"
+                         "A collection of transducers to reduce stream-manipulation overhead")
+  :author "Edward Langley <el-cl@elangley.org>"
+  :license "Apache v2"
+  :depends-on (:data-lens/transducers)
+  :in-order-to ((test-op (test-op :data-lens/transducers))))
+
 (asdf:defsystem #:data-lens/transducers/test
   :description "tests for the transducers"
   :author "Edward Langley <el-cl@elangley.org>"

lens.lisp

@@ -115,11 +115,16 @@
     (<= (length it)
         len)))
 
-(defun applicable-when (fun test)
+(defun applicable-when (fun test &optional (default nil default-p))
+  (if default-p
       (lambda (it)
         (if (funcall test it)
             (funcall fun it)
-        it)))
+            default))
+      (lambda (it)
+        (if (funcall test it)
+            (funcall fun it)
+            it))))
 
 (defmacro conj (&rest fns)
   (let ((dat (gensym "dat")))
@@ -193,6 +198,11 @@
         (alexandria:ends-with-subseq suffix
                                      it))))
 
+(defun of-type (type)
+  (lambda (it)
+    (when (typep it type)
+      it)))
+
 (defun transform-head (fun)
   (lambda (it)
     (typecase it
@@ -220,8 +230,9 @@
 
 (defun transform-elt (elt fun)
   (lambda (it)
-    (append (subseq it 0 elt)
+    (concatenate (type-of it)
-            (list (funcall fun (nth elt it)))
+                 (subseq it 0 elt)
+                 (list (funcall fun (elt it elt)))
                  (subseq it (1+ elt)))))
 
 (defun key-transform (fun key-get key-set)
@@ -321,11 +332,23 @@
     (apply #'concatenate result-type
            seq)))
 
+(defun transform (arg &rest args)
+  (if args
+      (lambda (fn)
+        (apply fn arg args))
+      (lambda (fn)
+        (funcall fn arg))))
+
 (defmacro calling (fun &rest args)
   (alexandria:with-gensyms (first-arg)
     `(lambda (,first-arg)
        (funcall (functionalize ,fun) ,first-arg ,@args))))
 
+(defmacro calling* (fun &rest args)
+  (alexandria:with-gensyms (last-arg)
+    `(lambda (,last-arg)
+       (funcall (functionalize ,fun) ,@args ,last-arg))))
+
 (defmacro applying (fun &rest args)
   (alexandria:with-gensyms (seq fsym)
     `(let ((,fsym (functionalize ,fun)))

package.lisp

@@ -20,7 +20,8 @@
            #:maximizing #:zipping #:applying #:splice-elt
            #:transform-elt #:denest #:op #:defalias #:<> #:<>1 #:== #:•
            #:∘ #:suffixp #:functionalize #:inc #:group-by #:keys
-           #:conj #:disj #:delay #:calling))
+           #:conj #:disj #:delay #:of-type #:transform #:calling*
+           #:calling))
 
 (defpackage :data-lens.transducers.internals
   (:use :cl)

t/lens.lisp

@@ -84,6 +84,9 @@
   (5am:is (equal 1
                  (funcall (data-lens:applicable-when '1+ (constantly nil))
                           1)))
+  (5am:is (equal "hi"
+                 (funcall (data-lens:applicable-when '1+ (constantly nil) "hi")
+                          1)))
   (5am:is (equal 2
                  (funcall (data-lens:applicable-when '1+ (constantly t))
                           1))))
@@ -259,3 +262,37 @@
   (5am:is (equalp #(1 2 3)
                   (funcall (data-lens:over '1+ :result-type 'vector)
                            #(0 1 2)))))
+
+(5am:def-test transform-elt (:suite :data-lens.lens :depends-on (and functionalize))
+  (5am:is (equal '(1 1 2)
+                 (funcall (data-lens:transform-elt 0 '1+)
+                          '(0 1 2))))
+  (5am:is (equal '(0 2 2)
+                 (funcall (data-lens:transform-elt 1 '1+)
+                          '(0 1 2))))
+  (5am:is (equalp #(0 1 3)
+                  (funcall (data-lens:transform-elt 2 '1+)
+                           (vector 0 1 2))))
+  (5am:is (equal "Abc"
+                 (funcall (data-lens:transform-elt 0 'char-upcase)
+                          "abc"))))
+
+(5am:def-test transform (:suite :data-lens.lens :depends-on (and functionalize))
+  (5am:is (equal (funcall (data-lens:transform 1) #'1+)
+                 2))
+
+  (5am:is (equal (funcall (data-lens:transform 1)
+                          (data-lens:juxt '1- 'identity '1+))
+                 '(0 1 2))))
+
+(5am:def-test calling (:suite :data-lens.lens :depends-on (and functionalize))
+  (5am:is (equal (funcall (data-lens:calling #'- 1) 3)
+                 2))
+  (5am:is (equal (funcall (data-lens:calling #'- 2 1) 3)
+                 0)))
+
+(5am:def-test calling* (:suite :data-lens.lens :depends-on (and functionalize))
+  (5am:is (equal (funcall (data-lens:calling* #'- 3) 1)
+                 2))
+  (5am:is (equal (funcall (data-lens:calling* #'- 3 2) 1)
+                 0)))