1.1--- a/lisp/bin/rdb.lisp	Wed May 08 00:13:43 2024 -0400
     1.2+++ b/lisp/bin/rdb.lisp	Wed May 08 15:09:39 2024 -0400
     1.3@@ -15,48 +15,87 @@
     1.4 
     1.5 ;; (defopt rdb-config (init-rdb-user-config (parse-file-opt $val)))
     1.6 
     1.7-(defcmd help (print-help $cli))
     1.8+(defopt rdb-help (print-help $cli))
     1.9 
    1.10-(defcmd new
    1.11+(defcmd rdb-new
    1.12   (set-opt *rdb* :error-if-exists t)
    1.13   (open-db *rdb*)
    1.14   (println (rdb-name *rdb*)))
    1.15 
    1.16-(defcmd show
    1.17-  (let ((db-path (find-opt $cli "db" t)))
    1.18-    (if (and (null db-path)
    1.19-             (or (zerop $argc) (equal (car $args) "opts")))
    1.20+(defcmd rdb-show
    1.21+  (let ((db-path (cli-opt-val (find-opt $cli "db"))))
    1.22+    (if (and (null db-path) (zerop $argc))
    1.23         (mapc (lambda (x) (println (format nil "~a ~a" (car x) (cdr x))))
    1.24               (hash-table-alist (backfill-opts (default-rdb-opts) :full t)))
    1.25-        (with-db (db (create-db (cli/clap::cli-opt-val db-path) :open t))
    1.26-          (println (hash-table-alist (backfill-opts db)))))))
    1.27+        (with-db (db (create-db db-path :open t))
    1.28+          (println (hash-table-alist (backfill-opts db)))
    1.29+          (with-iter (it (create-iter db))
    1.30+            (iter-seek-to-first it)
    1.31+            (loop while (iter-valid-p it)
    1.32+                  do (progn
    1.33+                       (format t "~A : ~A~%"
    1.34+                               (sb-ext:octets-to-string (iter-key it) :external-format '(:ascii :replacement #\_))
    1.35+                               (iter-val it))
    1.36+                       (iter-next it))
    1.37+                  finally (rocksdb::rocksdb-iter-destroy %it)))))))
    1.38 
    1.39-(defcmd insert
    1.40+(defcmd rdb-set
    1.41   (if (> 2 $argc)
    1.42       (rdb-error "missing args: KEY VAL")
    1.43       (with-db (db *rdb*)
    1.44         (open-db db)
    1.45         (insert-key  db (pop $args) (pop $args)))))
    1.46 
    1.47+(defcmd rdb-get
    1.48+  (if (> 1 $argc)
    1.49+      (rdb-error "missing arg: KEY")
    1.50+      (with-db (db *rdb*)
    1.51+        (open-db db)
    1.52+        (when-let ((val (get-key db (car $args))))
    1.53+          (println val)))))
    1.54+
    1.55+(defcmd rdb-destroy
    1.56+  (destroy-db *rdb*))
    1.57+
    1.58+(defcmd rdb-fuzz
    1.59+  (with-db (db *rdb*)
    1.60+    (open-db db)
    1.61+    (let ((val (make-array 32 :element-type 'octet)))
    1.62+      (dotimes (i (if (zerop $argc) 1000 (parse-integer (car $args))))
    1.63+        (nreversef val)
    1.64+        (let ((seed (random 32)))
    1.65+          (dotimes (ii seed)
    1.66+            (setf (aref val ii) (random 256))))
    1.67+          (nreversef val)
    1.68+          (put-key db
    1.69+                   (sb-ext:string-to-octets (string (gensym "foo")))
    1.70+                   val)))))
    1.71+
    1.72 (define-cli $cli
    1.73   :name "rdb"
    1.74   :version "0.1.0"
    1.75-  :thunk help
    1.76-  :description "richard's database"
    1.77+  :thunk rdb-show
    1.78+  :description "A simple helper for RocksDB."
    1.79   :opts (make-opts
    1.80           (:name "level" :global t :description "set the log level" :thunk rdb-log-level)
    1.81           (:name "help" :global t :description "print help" :thunk rdb-help)
    1.82           (:name "version" :global t :description "print version" :thunk rdb-version)
    1.83           (:name "db" :global t :description "target db" :thunk rdb-target-db :kind dir))
    1.84   :cmds (make-cmds
    1.85-          (:name new :thunk new)
    1.86-          (:name show :thunk show)
    1.87-          (:name insert :thunk insert)))
    1.88+          (:name new :thunk rdb-new)
    1.89+          (:name show :thunk rdb-show)
    1.90+          (:name set :thunk rdb-set)
    1.91+          (:name get :thunk rdb-get)
    1.92+          (:name fuzz :thunk rdb-fuzz)
    1.93+          (:name destroy :thunk rdb-destroy)))
    1.94 
    1.95 (defmain ()
    1.96   (let ((*log-level* :info))
    1.97     (with-cli (opts cmds args) $cli
    1.98-      ;; FIXME 2024-05-07: 
    1.99-      (do-opt (find-opt $cli "db"))
   1.100-      (prog1 (do-cmd $cli)
   1.101-        (close-db *rdb*)))))
   1.102+      ;; FIXME 2024-05-07: needs to be triggered explicitly - need to support
   1.103+      ;; running global opt thunks even when no arg present - macro key
   1.104+      (if (active-cmds $cli)
   1.105+          (prog2 (do-opt (find-opt $cli "db"))
   1.106+              (do-cmd $cli)
   1.107+            (close-db *rdb*))
   1.108+          (print-help $cli)))))

     2.1--- a/lisp/lib/cli/pkg.lisp	Wed May 08 00:13:43 2024 -0400
     2.2+++ b/lisp/lib/cli/pkg.lisp	Wed May 08 15:09:39 2024 -0400
     2.3@@ -159,6 +159,7 @@
     2.4    :handle-missing-argument
     2.5    :handle-invalid-argument
     2.6    :cli-opt
     2.7+   :cli-opt-val
     2.8    :cli-val
     2.9    :cli-cmd-args
    2.10    :cli-cmd

     3.1--- a/lisp/lib/rdb/macs.lisp	Wed May 08 00:13:43 2024 -0400
     3.2+++ b/lisp/lib/rdb/macs.lisp	Wed May 08 15:09:39 2024 -0400
     3.3@@ -76,6 +76,7 @@
     3.4   (let ((%iter-var (symbolicate '% (symbol-name iter-var))))
     3.5     `(let ((,iter-var ,iter))
     3.6        (let ((,%iter-var (rdb-iter-sap ,iter-var)))
     3.7+         (declare (ignorable ,%iter-var))
     3.8          ,@body))))
     3.9 
    3.10 ;; TODO: sb-ext:with-current-source-form ?

     4.1--- a/lisp/lib/rdb/obj.lisp	Wed May 08 00:13:43 2024 -0400
     4.2+++ b/lisp/lib/rdb/obj.lisp	Wed May 08 15:09:39 2024 -0400
     4.3@@ -126,7 +126,7 @@
     4.4   (rocksdb-iter-seek (rdb-iter-sap self) key (length key)))
     4.5 
     4.6 (defmethod iter-next ((self rdb-iter))
     4.7-  (rocksdb-iter-next (log:info! (rdb-iter-sap self))))
     4.8+  (rocksdb-iter-next (rdb-iter-sap self)))
     4.9 
    4.10 (defmethod iter-prev ((self rdb-iter))
    4.11   (rocksdb-iter-prev (rdb-iter-sap self)))

     5.1--- a/lisp/lib/rdb/tests.lisp	Wed May 08 00:13:43 2024 -0400
     5.2+++ b/lisp/lib/rdb/tests.lisp	Wed May 08 15:09:39 2024 -0400
     5.3@@ -150,4 +150,4 @@
     5.4 (deftest errors ()
     5.5   "Test basic error handling."
     5.6   (with-temp-db (errs () :open t :destroy t)
     5.7-    (signals 'rocksdb-error (open-db-raw "errs"))))
     5.8+    (signals rdb-error (open-db errs))))

     6.1--- a/x.lisp	Wed May 08 00:13:43 2024 -0400
     6.2+++ b/x.lisp	Wed May 08 15:09:39 2024 -0400
     6.3@@ -148,7 +148,7 @@
     6.4       (compile-prelude t nil)))
     6.5 
     6.6 (defun %build (name)
     6.7-  (format t "saving executable to: ~A~%" (merge-pathnames name *stash-path*))
     6.8+  (format t "saving ~A to: ~A~%" name (merge-pathnames name *stash-path*))
     6.9   (let ((sys (sb-int:keywordicate (format nil "BIN/~A" (string-upcase name)))))
    6.10     (ql:quickload sys)
    6.11     (asdf:make sys)))
    6.12@@ -158,13 +158,13 @@
    6.13       (let ((name (car args)))
    6.14         (ensure-directories-exist *stash-path*)
    6.15         (%build name))
    6.16-      (time (std:wait-for-threads (mapcar
    6.17+      (std:wait-for-threads (mapcar
    6.18                              (lambda (x)
    6.19                                (sb-thread:make-thread
    6.20                                 (lambda ()
    6.21                                   (sb-ext:run-program "x" (list "build" x) :wait t :output t))
    6.22                                 :name x))
    6.23-            (list "skel" "rdb" "organ" "homer" "packy"))))))
    6.24+                             (list "skel" "rdb" "organ" "homer" "packy")))))
    6.25 
    6.26 (defun x-save (args)
    6.27   (if args