changelog shortlog graph tags branches files raw help

Mercurial > demo / changeset: added musicbrainz db example

changeset 39: 1ef551e24009
parent 38: 8259376eee11
child 40: 6b652d7d6663
author: Richard Westhaver <ellis@rwest.io>
date: Thu, 11 Apr 2024 18:58:35 -0400
files: examples/db/cl-simple-example-raw.lisp examples/db/cl-simple-example.lisp examples/db/mbdb.lisp examples/db/mini-redis.lisp examples/db/tao.lisp examples/examples.asd examples/vegadat.lisp tools/build-cli.lisp tools/build-image.lisp tools/prepare-image.lisp
description: added musicbrainz db example
     1.1--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2+++ b/examples/db/cl-simple-example-raw.lisp	Thu Apr 11 18:58:35 2024 -0400
     1.3@@ -0,0 +1,66 @@
     1.4+;;; cl-simple-example.lisp --- Common Lisp port of rocksdb/examples/c_simple_example.c
     1.5+
     1.6+;; ref: https://github.com/facebook/rocksdb/blob/main/examples/c_simple_example.c
     1.7+
     1.8+;;; Usage: 
     1.9+
    1.10+;; To compile and run from the shell:
    1.11+#|
    1.12+sbcl --eval '(ql:quickload :rdb)' \
    1.13+     --eval '(ql:quickload :cli)' \
    1.14+     --eval '(compile-file "cl-simple-example.lisp")' \
    1.15+     --eval '(load "cl-simple-example.fasl")' \
    1.16+     --eval "(sb-ext:save-lisp-and-die \"cl-simple-example\" :toplevel #'cl-simple-example::main :executable t)"
    1.17+
    1.18+time ./cl-simple-example
    1.19+
    1.20+# real	0m0.030s
    1.21+# user	0m0.012s
    1.22+# sys	0m0.017s
    1.23+|#
    1.24+
    1.25+;; Compare to C:
    1.26+#|
    1.27+# in rocksdb/examples
    1.28+gcc -lrocksdb c_simple_example.c -oc_simple_example
    1.29+
    1.30+time ./c_simple_example
    1.31+
    1.32+# real	0m0.021s
    1.33+# user	0m0.006s
    1.34+# sys	0m0.015s
    1.35+|#
    1.36+
    1.37+;;; Code:
    1.38+(defpackage :examples/cl-simple-example-raw
    1.39+  (:use :cl :std :cli :rdb :sb-alien :rocksdb)
    1.40+  (:export :main))
    1.41+
    1.42+(in-package :examples/cl-simple-example-raw)
    1.43+(declaim (optimize (speed 3)))
    1.44+
    1.45+(defparameter *num-cpus* (num-cpus)
    1.46+  "CPU count.")
    1.47+
    1.48+(defparameter *db-path* "/tmp/rocksdb-cl-simple-example-raw")
    1.49+
    1.50+(defparameter *db-backup-path* "/tmp/rocksdb-cl-simple-example-backup-raw")
    1.51+
    1.52+(defmain ()
    1.53+  ;; open Backup Engine that we will use for backing up our database
    1.54+  (let ((options (make-rocksdb-options 
    1.55+                  (lambda (opt)
    1.56+                    (rocksdb-options-increase-parallelism opt *num-cpus*) ;; set # of online cores
    1.57+                    (rocksdb-options-optimize-level-style-compaction opt 0)
    1.58+                    (rocksdb-options-set-create-if-missing opt 1)))))
    1.59+  (with-open-backup-engine-raw (be *db-backup-path* options)
    1.60+    ;; open DB
    1.61+    (with-open-db-raw (db *db-path* options)
    1.62+      ;; put key-value
    1.63+      (put-kv-str-raw db "key" "value")
    1.64+      ;; get value
    1.65+      (string= (get-kv-str-raw db "key") "value")
    1.66+      ;; create new backup in a directory specified by *db-backup-path*
    1.67+      (create-new-backup-raw be db))
    1.68+    ;; if something is wrong, you might want to restore data from last backup
    1.69+    (restore-from-latest-backup-raw be *db-path* *db-backup-path*))))
     2.1--- a/examples/db/cl-simple-example.lisp	Fri Dec 29 00:45:44 2023 -0500
     2.2+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.3@@ -1,66 +0,0 @@
     2.4-;;; cl-simple-example.lisp --- Common Lisp port of rocksdb/examples/c_simple_example.c
     2.5-
     2.6-;; ref: https://github.com/facebook/rocksdb/blob/main/examples/c_simple_example.c
     2.7-
     2.8-;;; Usage: 
     2.9-
    2.10-;; To compile and run from the shell:
    2.11-#|
    2.12-sbcl --eval '(ql:quickload :rdb)' \
    2.13-     --eval '(ql:quickload :cli)' \
    2.14-     --eval '(compile-file "cl-simple-example.lisp")' \
    2.15-     --eval '(load "cl-simple-example.fasl")' \
    2.16-     --eval "(sb-ext:save-lisp-and-die \"cl-simple-example\" :toplevel #'cl-simple-example::main :executable t)"
    2.17-
    2.18-time ./cl-simple-example
    2.19-
    2.20-# real	0m0.030s
    2.21-# user	0m0.012s
    2.22-# sys	0m0.017s
    2.23-|#
    2.24-
    2.25-;; Compare to C:
    2.26-#|
    2.27-# in rocksdb/examples
    2.28-gcc -lrocksdb c_simple_example.c -oc_simple_example
    2.29-
    2.30-time ./c_simple_example
    2.31-
    2.32-# real	0m0.021s
    2.33-# user	0m0.006s
    2.34-# sys	0m0.015s
    2.35-|#
    2.36-
    2.37-;;; Code:
    2.38-(defpackage :examples/cl-simple-example
    2.39-  (:use :cl :std :cli :rdb :sb-alien :rocksdb)
    2.40-  (:export :main))
    2.41-
    2.42-(in-package :examples/cl-simple-example)
    2.43-(declaim (optimize (speed 3)))
    2.44-
    2.45-(defvar *num-cpus* (alien-funcall (extern-alien "sysconf" (function int int)) sb-unix:sc-nprocessors-onln)
    2.46-  "CPU count.")
    2.47-
    2.48-(defparameter *db-path* "/tmp/rocksdb-cl-simple-example")
    2.49-
    2.50-(defparameter *db-backup-path* "/tmp/rocksdb-cl-simple-example-backup")
    2.51-
    2.52-(defmain ()
    2.53-  ;; open Backup Engine that we will use for backing up our database
    2.54-  (let ((options (make-rocksdb-options 
    2.55-                  (lambda (opt)
    2.56-                    (rocksdb-options-increase-parallelism opt *num-cpus*) ;; set # of online cores
    2.57-                    (rocksdb-options-optimize-level-style-compaction opt 0)
    2.58-                    (rocksdb-options-set-create-if-missing opt 1)))))
    2.59-  (with-open-backup-engine-raw (be *db-backup-path* options)
    2.60-    ;; open DB
    2.61-    (with-open-db-raw (db *db-path* options)
    2.62-      ;; put key-value
    2.63-      (put-kv-str-raw db "key" "value")
    2.64-      ;; get value
    2.65-      (string= (get-kv-str-raw db "key") "value")
    2.66-      ;; create new backup in a directory specified by *db-backup-path*
    2.67-      (create-new-backup-raw be db))
    2.68-    ;; if something is wrong, you might want to restore data from last backup
    2.69-    (restore-from-latest-backup-raw be *db-path* *db-backup-path*))))
     3.1--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.2+++ b/examples/db/mbdb.lisp	Thu Apr 11 18:58:35 2024 -0400
     3.3@@ -0,0 +1,48 @@
     3.4+;;; examples/mbdb.lisp --- MusicBrainz Database import and analysis
     3.5+
     3.6+;; This example show how to migrate a set of complex JSON objects to
     3.7+;; RocksDB using a dump from the MusicBrainz database
     3.8+;; (https://musicbrainz.org/). The files are hosted at
     3.9+;; https://packy.compiler.company/data/mbdump
    3.10+
    3.11+;;; Code:
    3.12+(defpackage :examples/mbdb
    3.13+  (:use :cl :std :dat/json :net/fetch :obj/id :rdb :cli/clap :obj/uuid)
    3.14+  (:import-from :log :info! :debug!)
    3.15+  (:import-from :rocksdb :load-rocksdb)
    3.16+  (:export :main))
    3.17+
    3.18+(in-package :examples/mbdb)
    3.19+
    3.20+(load-rocksdb t)
    3.21+
    3.22+(declaim (type pathname *mbdb-path*))
    3.23+(defvar *mbdb-path* #P"/tmp/mbdb/")
    3.24+(defvar *mbdb* (create-db *mbdb-path* :opts (default-rdb-opts)))
    3.25+
    3.26+(defvar *mbdump-base-url* "https://packy.compiler.company/data/mbdump/"
    3.27+  "Remote location of MusicBrainz JSON data files.")
    3.28+
    3.29+(defvar *mbdump-files*
    3.30+  (mapcar (lambda (f) (make-pathname :name f :type "json" :directory *mbdump-base-url*))
    3.31+          (list "area" "artist" "event" "instrument"
    3.32+                "label" "place" "recording" "release"
    3.33+                "release-group" "series" "work")))
    3.34+
    3.35+(defun extract-columns (obj)
    3.36+  "Extract fields from a JSON-OBJECT, returning a vector of
    3.37+  uninitialized column-families which can be created with CREATE-CFS.
    3.38+
    3.39+Returns multiple values: the list of columns, the id, and type-id if present."
    3.40+  (values
    3.41+   (mapcar #'car (json-object-members obj))
    3.42+   (make-uuid-from-string (json-getf obj "id"))
    3.43+   (when-let ((tid (json-getf obj "type-id")))
    3.44+     (make-uuid-from-string tid))))
    3.45+
    3.46+(defmain ()
    3.47+  (let ((*default-pathname-defaults* (ensure-directories-exist *mbdb-path* :verbose t)))
    3.48+    (log:info! "Welcome to MBDB")
    3.49+    (with-db (db *mbdb*)
    3.50+      (open-db db)
    3.51+      (close-db db))))
     4.1--- a/examples/db/mini-redis.lisp	Fri Dec 29 00:45:44 2023 -0500
     4.2+++ b/examples/db/mini-redis.lisp	Thu Apr 11 18:58:35 2024 -0400
     4.3@@ -12,7 +12,7 @@
     4.4 
     4.5 (in-package :examples/mini-redis)
     4.6 
     4.7-(defparameter *worker-count* 4)
     4.8+(defparameter *worker-count* 8)
     4.9 (defparameter *writer-proportion* 0.5)
    4.10 (defvar *keys*
    4.11   (loop for n below 130 by 2
     5.1--- a/examples/db/tao.lisp	Fri Dec 29 00:45:44 2023 -0500
     5.2+++ b/examples/db/tao.lisp	Thu Apr 11 18:58:35 2024 -0400
     5.3@@ -6,9 +6,85 @@
     5.4 
     5.5 ;;; Code:
     5.6 (defpackage :examples/tao
     5.7-  (:use :cl :std :cli :rdb)
     5.8-  (:export :main))
     5.9+  (:use :cl :std :rdb :log :obj/db :obj/graph :obj/id)
    5.10+  (:export :run-tao))
    5.11 
    5.12 (in-package :examples/tao)
    5.13 
    5.14-(defmain ())
    5.15+(rdb::load-rocksdb)
    5.16+
    5.17+(defvar *tao-directory* "/tmp/tao/")
    5.18+
    5.19+(defvar *tao-log-dir*)
    5.20+(defvar *tao-db-dir*)
    5.21+(defvar *tao-cfs*
    5.22+  (vector (make-rdb-cf "nodes")
    5.23+          (make-rdb-cf "edges")))
    5.24+
    5.25+(defun tao-path (path &optional (root *tao-directory*))
    5.26+  (merge-pathnames path root))
    5.27+
    5.28+(defclass tao-node (id)
    5.29+  (key val))
    5.30+
    5.31+(defclass tao-edge (edge) ())
    5.32+
    5.33+(defclass tao-graph (graph) ())
    5.34+
    5.35+(defclass tao-db (database)
    5.36+  ((db :type rdb)))
    5.37+
    5.38+(defclass tao (tao-db tao-graph)
    5.39+  ((dir :initarg :dir)))
    5.40+
    5.41+(defun ensure-tao-directories (&optional (root *tao-directory*))
    5.42+  (setf *tao-log-dir* (ensure-directories-exist (tao-path "log/" root) :verbose t))
    5.43+  root)
    5.44+
    5.45+(defun init-tao-db (&optional (root *tao-directory*))
    5.46+  (let ((db-dir (tao-path "db/" root)))
    5.47+    (setf *tao-db-dir* db-dir)
    5.48+    (create-db db-dir :cfs *tao-cfs*)))
    5.49+
    5.50+(defun make-tao (&key (dir *tao-directory*))
    5.51+  (make-instance 'tao
    5.52+    :dir (setf *tao-directory* (ensure-tao-directories dir))
    5.53+    :db (init-tao-db dir)))
    5.54+
    5.55+(defun run-tao ()
    5.56+  (let ((opts (default-rdb-opts))) ;; configure database options
    5.57+    (set-opt opts "error-if-exists" 0)
    5.58+    (set-opt opts "db-log-dir" "/tmp/log")
    5.59+    (push-sap* opts)
    5.60+    (let ((db (create-db "tao"
    5.61+                         :opts opts
    5.62+                         ;; :cfs (vector (make-rdb-cf "nodes")
    5.63+                         ;;              (make-rdb-cf "edges"))
    5.64+                         :open t)))
    5.65+      (with-db (db db)
    5.66+        (flush-db db)
    5.67+        (let ((metadata (get-metadata db)))
    5.68+          (info!
    5.69+           (rdb::rocksdb-column-family-metadata-get-name metadata)
    5.70+           (rdb::rocksdb-column-family-metadata-get-size metadata)
    5.71+           (rdb::rocksdb-column-family-metadata-get-file-count metadata)
    5.72+           (rdb::rocksdb-column-family-metadata-get-level-count metadata))
    5.73+          (let ((lmeta (rdb::rocksdb-column-family-metadata-get-level-metadata metadata 0)))
    5.74+            (info!
    5.75+             (rdb::rocksdb-level-metadata-get-level lmeta)
    5.76+             (rdb::rocksdb-level-metadata-get-size lmeta)
    5.77+             (rdb::rocksdb-level-metadata-get-file-count lmeta))
    5.78+            ;; TODO: requires file-count > 0
    5.79+            ;; (let ((smeta (rdb::rocksdb-level-metadata-get-sst-file-metadata lmeta 0)))
    5.80+            ;;   (info!
    5.81+            ;;    (rdb::rocksdb-sst-file-metadata-get-directory smeta)
    5.82+            ;;    (rdb::rocksdb-sst-file-metadata-get-relative-filename smeta)
    5.83+            ;;    (rdb::rocksdb-sst-file-metadata-get-size smeta)
    5.84+            ;;    (rdb::rocksdb-sst-file-metadata-get-smallestkey smeta)
    5.85+            ;;    (rdb::rocksdb-sst-file-metadata-get-largestkey smeta))
    5.86+            ;;   (rdb::rocksdb-sst-file-metadata-destroy smeta))
    5.87+            (rdb::rocksdb-level-metadata-destroy lmeta))
    5.88+          (rdb::rocksdb-column-family-metadata-destroy metadata))
    5.89+        (info! (get-prop db "rocksdb.stats"))
    5.90+        (close-db db))))
    5.91+  (info! "TAO OK"))
     6.1--- a/examples/examples.asd	Fri Dec 29 00:45:44 2023 -0500
     6.2+++ b/examples/examples.asd	Thu Apr 11 18:58:35 2024 -0400
     6.3@@ -1,9 +1,10 @@
     6.4 (defsystem :examples
     6.5-  :depends-on (:std :cli :obj :dat :net :rdb)
     6.6+  :depends-on (:prelude)
     6.7   :components 
     6.8   ((:file "vegadat")
     6.9    (:module "db"
    6.10-    :components ((:file "cl-simple-example")
    6.11+    :components ((:file "cl-simple-example-raw")
    6.12                  (:file "mini-redis")
    6.13-                 (:file "tao")))))
    6.14+                 (:file "tao")
    6.15+                 (:file "mbdb" :depends-on nil)))))
    6.16 
     7.1--- a/examples/vegadat.lisp	Fri Dec 29 00:45:44 2023 -0500
     7.2+++ b/examples/vegadat.lisp	Thu Apr 11 18:58:35 2024 -0400
     7.3@@ -8,7 +8,7 @@
     7.4 (in-package :examples/vegadat)
     7.5 
     7.6 (defparameter *vega-dataset-base-url* "http://raw.githubusercontent.com/vega/vega-datasets/main/data/"
     7.7-  "Base URL for datasets included in Vega")
     7.8+  "Base URL for datasets included in Vega.")
     7.9 
    7.10 (defparameter *vega-dataset-stash* "vega/")
    7.11 
     8.1--- a/tools/build-cli.lisp	Fri Dec 29 00:45:44 2023 -0500
     8.2+++ b/tools/build-cli.lisp	Thu Apr 11 18:58:35 2024 -0400
     8.3@@ -3,7 +3,7 @@
     8.4 #+sbcl
     8.5 (sb-ext:save-lisp-and-die *output*
     8.6                           :purify t
     8.7-                          :toplevel 'screenshotbot-sdk:main
     8.8+                          :toplevel 'homer:main
     8.9                           :executable t)
    8.10 #+ccl
    8.11 (ccl:save-application *output*
     9.1--- a/tools/build-image.lisp	Fri Dec 29 00:45:44 2023 -0500
     9.2+++ b/tools/build-image.lisp	Thu Apr 11 18:58:35 2024 -0400
     9.3@@ -8,10 +8,6 @@
     9.4 (defun image-load-hook ()
     9.5   ;; On MacOS, the TMPDIR variable can change between sessions.
     9.6   (uiop:setup-temporary-directory)
     9.7-
     9.8-  #-sbcl
     9.9-  (log4cl::init-hook)
    9.10-
    9.11   ;; If we used this image to deliver another image, we don't
    9.12   ;; want to load the same hook twice
    9.13   (unless *hook-loaded-p*
    9.14@@ -20,32 +16,13 @@
    9.15 
    9.16 (compile 'image-load-hook)
    9.17 
    9.18-#+sbcl
    9.19 (pushnew 'image-load-hook sb-ext:*init-hooks*)
    9.20 
    9.21 (format t "Got command line arguments: ~S" (uiop:raw-command-line-arguments))
    9.22 
    9.23-#-sbcl
    9.24-(log4cl::save-hook)
    9.25-
    9.26-#+sbcl
    9.27 (sb-ext:save-lisp-and-die
    9.28  (namestring
    9.29   (make-pathname
    9.30    #+win32 :type #+win32 "exe"
    9.31    :defaults #P"build/sbcl-console"))
    9.32  :executable t)
    9.33-
    9.34-#+ccl
    9.35-(defun ccl-toplevel-function ()
    9.36-  (image-load-hook)
    9.37-  (let ((file (cadr ccl:*command-line-argument-list*)))
    9.38-    (if file
    9.39-     (load file :verbose t)
    9.40-     (loop
    9.41-           (print (eval (read)))))))
    9.42-
    9.43-
    9.44-#+ccl
    9.45-(ccl:save-application "build/ccl-console"
    9.46-                      :toplevel-function 'ccl-toplevel-function)
    10.1--- a/tools/prepare-image.lisp	Fri Dec 29 00:45:44 2023 -0500
    10.2+++ b/tools/prepare-image.lisp	Thu Apr 11 18:58:35 2024 -0400
    10.3@@ -1,59 +1,20 @@
    10.4 (in-package :cl-user)
    10.5 
    10.6-;; For SBCL, if you don't have SBCL_HOME set, then we won't be able to require this later.
    10.7-#+sbcl
    10.8-(require 'sb-introspect)
    10.9-#-sbcl
   10.10-(require "asdf")
   10.11-
   10.12-#+sbcl
   10.13-(require "sb-sprof")
   10.14-
   10.15-(defvar *cwd* (uiop:getcwd))
   10.16-
   10.17-(defun update-output-translations (root)
   10.18-  (asdf:initialize-output-translations
   10.19-   `(:output-translations
   10.20-     :inherit-configuration
   10.21-     (,(namestring root)
   10.22-      ,(format nil "~abuild/asdf-cache/~a/" root
   10.23-               (uiop:implementation-identifier))))))
   10.24-
   10.25-(update-output-translations *cwd*)
   10.26-
   10.27-#+sbcl
   10.28-(progn
   10.29-  (require :sb-rotate-byte)
   10.30-  (require :sb-cltl2)
   10.31-  (asdf:register-preloaded-system :sb-rotate-byte)
   10.32-  (asdf:register-preloaded-system :sb-cltl2))
   10.33+(require :sb-introspect)
   10.34+(require :asdf)
   10.35+(require :sb-sprof)
   10.36+(require :sb-rotate-byte)
   10.37+(require :sb-cltl2)
   10.38+(asdf:register-preloaded-system :sb-rotate-byte)
   10.39+(asdf:register-preloaded-system :sb-cltl2)
   10.40+(asdf:register-preloaded-system :std)
   10.41+(asdf:register-preloaded-system :log)
   10.42 
   10.43 (ql:update-all-dists :prompt nil)
   10.44 
   10.45-;; is the package name already loaded as a feature? uhh look it up
   10.46 (pushnew :demo *features*)
   10.47 
   10.48-(defun update-project-directories (cwd)
   10.49-  (flet ((push-src-dir (name)
   10.50-           (let ((dir (pathname (format nil "~a~a/" cwd name))))
   10.51-             (when (probe-file dir)
   10.52-               (push dir ql:*local-project-directories*)))))
   10.53-    #-demo
   10.54-    (push-src-dir ".")
   10.55-    (push-src-dir "vendor")))
   10.56-
   10.57-(update-project-directories *cwd*)
   10.58+(ql:quickload :prelude)
   10.59+(ql:register-local-projects)
   10.60+(log:info! "*local-project-directories:" ql:*local-project-directories*)
   10.61 
   10.62-(defun maybe-configure-proxy ()
   10.63-  (let ((proxy (uiop:getenv "HTTP_PROXY")))
   10.64-    (when (and proxy (> (length proxy) 0))
   10.65-      (setf ql:*proxy-url* proxy))))
   10.66-
   10.67-(maybe-configure-proxy)
   10.68-
   10.69-(ql:quickload "log4cl")
   10.70-(ql:quickload "prove-asdf")
   10.71-
   10.72-(log:info "*local-project-directories: ~S" ql:*local-project-directories*)
   10.73-
   10.74-(ql:register-local-projects)