refactor: convert all .sls files to Jerboa .ss style
ober
5cf6165f691ccea27f5ebed4980960f05b75f95a
--- a/Makefile +++ b/Makefile @@ -20,14 +20,13 @@ test-lmdb: # Compile all libraries (catches syntax/import errors) build: @echo "Compiling jerboa-db libraries..." - $(SCHEME) --libdirs "$(LIBDIRS)" --program /dev/null \ - --import-notify <<< '(import (jerboa-db core))' 2>&1 || true + printf '(import (jerboa-db core))\n' | $(SCHEME) --libdirs "$(LIBDIRS)" @echo "Build check complete." -# Syntax check all .sls files +# Syntax check all .ss files check: @echo "Checking library files..." - @for f in $$(find lib -name "*.sls"); do \ + @for f in $$(find lib -name "*.ss"); do \ echo " $$f"; \ $(SCHEME) --libdirs "$(LIBDIRS)" --script /dev/null 2>&1 | head -5 || true; \ done deleted file mode 100644 --- a/lib/jerboa-db/analytics.sls +++ /dev/null @@ -1,239 +0,0 @@ -#!chezscheme -;;; (jerboa-db analytics) — DuckDB integration for OLAP queries -;;; -;;; Maintains a columnar replica of the datom store for analytical queries. -;;; Provides SQL over datoms, Parquet export/import, and CSV import. - -(library (jerboa-db analytics) - (export - new-analytics-engine analytics-engine? - analytics-sync! analytics-query - export-parquet import-parquet import-csv - analytics-close) - - (import (chezscheme) - (std db duckdb) - (jerboa-db datom) - (jerboa-db schema) - (jerboa-db tx-log)) - - ;; ---- Analytics engine record ---- - - (define-record-type analytics-engine - (fields (mutable duckdb-conn) ;; DuckDB connection handle (integer) - (mutable last-synced-tx) ;; last tx synced to DuckDB - schema-ref ;; reference to schema registry - tx-log-ref)) ;; reference to transaction log - - (define (new-analytics-engine schema tx-log . opts) - ;; Optional: path for persistent DuckDB file - (let ([path (if (pair? opts) (car opts) ":memory:")]) - (let ([conn (duckdb-open path)]) - (let ([ae (make-analytics-engine conn 0 schema tx-log)]) - (create-datom-table! ae) - ae)))) - - ;; ---- Schema setup ---- - - (define (create-datom-table! ae) - (duckdb-exec (analytics-engine-duckdb-conn ae) - "CREATE TABLE IF NOT EXISTS datoms ( - e BIGINT NOT NULL, - a INTEGER NOT NULL, - a_name VARCHAR, - v_long BIGINT, - v_double DOUBLE, - v_string VARCHAR, - v_bool BOOLEAN, - v_ref BIGINT, - v_instant BIGINT, - tx BIGINT NOT NULL, - added BOOLEAN NOT NULL - )")) - - ;; ---- Sync from transaction log ---- - - (define (analytics-sync! ae) - ;; Read transaction log entries since last-synced-tx and INSERT datoms. - (let* ([log (analytics-engine-tx-log-ref ae)] - [schema (analytics-engine-schema-ref ae)] - [last-tx (analytics-engine-last-synced-tx ae)] - [entries (tx-log-range log last-tx (+ (tx-log-latest-tx log) 1))]) - (for-each - (lambda (entry) - (for-each - (lambda (dv) - ;; dv is #(e a v tx added?) — serializable form from tx-log - (insert-datom-row! ae schema dv)) - (tx-log-entry-datoms entry))) - entries) - (when (pair? entries) - (analytics-engine-last-synced-tx-set! ae - (tx-log-entry-tx-id (car (reverse entries))))))) - - (define (insert-datom-row! ae schema dv) - ;; dv is a vector: #(e a v tx added?) - (let* ([e (vector-ref dv 0)] - [a (vector-ref dv 1)] - [v (vector-ref dv 2)] - [tx (vector-ref dv 3)] - [added? (vector-ref dv 4)] - [attr (schema-lookup-by-id schema a)] - [a-name (if attr (symbol->string (db-attribute-ident attr)) #f)] - [vtype (if attr (db-attribute-value-type attr) #f)]) - ;; Resolve each typed slot — only one should be non-NULL per row. - (let-values ([(v-long v-double v-string v-bool v-ref v-instant) - (classify-value v vtype)]) - (duckdb-eval - (analytics-engine-duckdb-conn ae) - "INSERT INTO datoms - (e, a, a_name, v_long, v_double, v_string, v_bool, v_ref, v_instant, tx, added) - VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" - e a a-name - v-long v-double v-string v-bool v-ref v-instant - tx added?)))) - - ;; Map a datom value + schema type to the six typed column slots. - ;; Returns six values: (v-long v-double v-string v-bool v-ref v-instant). - ;; Exactly one will be non-#f (or all #f for unknown types). - (define (classify-value v vtype) - (cond - ;; Explicit schema type wins - [(eq? vtype 'db.type/long) - (values (and (integer? v) v) #f #f #f #f #f)] - [(eq? vtype 'db.type/double) - (values #f (and (number? v) (inexact v)) #f #f #f #f)] - [(eq? vtype 'db.type/string) - (values #f #f (and (string? v) v) #f #f #f)] - [(eq? vtype 'db.type/boolean) - (values #f #f #f (and (boolean? v) v) #f #f)] - [(eq? vtype 'db.type/ref) - (values #f #f #f #f (and (integer? v) v) #f)] - [(eq? vtype 'db.type/instant) - (values #f #f #f #f #f (and (integer? v) v))] - [(eq? vtype 'db.type/keyword) - ;; Store keyword/symbol as string - (values #f #f (and (symbol? v) (symbol->string v)) #f #f #f)] - [(eq? vtype 'db.type/uuid) - (values #f #f (and (string? v) v) #f #f #f)] - [(eq? vtype 'db.type/symbol) - (values #f #f (and (symbol? v) (symbol->string v)) #f #f #f)] - ;; No schema — infer from Scheme type - [(boolean? v) (values #f #f #f v #f #f)] - [(flonum? v) (values #f v #f #f #f #f)] - [(integer? v) (values v #f #f #f #f #f)] - [(string? v) (values #f #f v #f #f #f)] - [(symbol? v) (values #f #f (symbol->string v) #f #f #f)] - [else (values #f #f (format "~s" v) #f #f #f)])) - - ;; ---- SQL query ---- - - (define (analytics-query ae sql-string . params) - ;; Sync first so the view is up-to-date, then run SQL. - (analytics-sync! ae) - (apply duckdb-query (analytics-engine-duckdb-conn ae) sql-string params)) - - ;; ---- Parquet export ---- - - (define (export-parquet ae path . opts) - ;; opts: optional SQL override (default: full datoms table) - (analytics-sync! ae) - (let ([sql (if (pair? opts) - (car opts) - "SELECT * FROM datoms")]) - (duckdb-write-parquet (analytics-engine-duckdb-conn ae) sql path))) - - ;; ---- Parquet import ---- - ;; - ;; mapping: alist of (column-name . attribute-ident) - ;; Each row becomes a new entity assertion. All values imported as strings; - ;; callers can add type coercion via the schema after import. - - (define (import-parquet ae path mapping) - (let ([conn (analytics-engine-duckdb-conn ae)] - [schema (analytics-engine-schema-ref ae)] - [tx-id (+ (tx-log-latest-tx (analytics-engine-tx-log-ref ae)) 1)]) - ;; Use DuckDB to read the parquet and materialise it in-memory - (let ([rows (duckdb-read-parquet conn path)]) - (for-each - (lambda (row) - ;; Allocate a fresh entity id (use a stable hash of row position - ;; relative to tx so re-import is idempotent-ish) - (let ([eid (next-import-eid ae)]) - (for-each - (lambda (col-mapping) - (let* ([col-name (car col-mapping)] - [attr-ident (cdr col-mapping)] - [raw-val (cdr (or (assoc col-name row) '(#f . #f)))] - [attr (schema-lookup-by-ident schema attr-ident)] - [a-id (if attr (db-attribute-id attr) #f)]) - (when (and raw-val a-id) - (let ([vtype (if attr (db-attribute-value-type attr) #f)]) - (let-values ([(v-long v-double v-string v-bool v-ref v-instant) - (classify-value raw-val vtype)]) - (duckdb-eval conn - "INSERT INTO datoms - (e, a, a_name, v_long, v_double, v_string, - v_bool, v_ref, v_instant, tx, added) - VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" - eid a-id - (if attr (symbol->string (db-attribute-ident attr)) #f) - v-long v-double v-string v-bool v-ref v-instant - tx-id #t)))))) - mapping))) - rows)))) - - ;; ---- CSV import ---- - ;; - ;; Same semantics as import-parquet — reads CSV via DuckDB's auto-detect, - ;; then maps columns to attributes. - - (define (import-csv ae path mapping) - (let ([conn (analytics-engine-duckdb-conn ae)] - [schema (analytics-engine-schema-ref ae)] - [tx-id (+ (tx-log-latest-tx (analytics-engine-tx-log-ref ae)) 1)]) - (let ([rows (duckdb-read-csv conn path)]) - (for-each - (lambda (row) - (let ([eid (next-import-eid ae)]) - (for-each - (lambda (col-mapping) - (let* ([col-name (car col-mapping)] - [attr-ident (cdr col-mapping)] - [raw-val (cdr (or (assoc col-name row) '(#f . #f)))] - [attr (schema-lookup-by-ident schema attr-ident)] - [a-id (if attr (db-attribute-id attr) #f)]) - (when (and raw-val a-id) - (let ([vtype (if attr (db-attribute-value-type attr) #f)]) - (let-values ([(v-long v-double v-string v-bool v-ref v-instant) - (classify-value raw-val vtype)]) - (duckdb-eval conn - "INSERT INTO datoms - (e, a, a_name, v_long, v_double, v_string, - v_bool, v_ref, v_instant, tx, added) - VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" - eid a-id - (if attr (symbol->string (db-attribute-ident attr)) #f) - v-long v-double v-string v-bool v-ref v-instant - tx-id #t)))))) - mapping))) - rows)))) - - ;; ---- Close ---- - - (define (analytics-close ae) - (duckdb-close (analytics-engine-duckdb-conn ae)) - (analytics-engine-duckdb-conn-set! ae #f)) - - ;; ---- Internal helpers ---- - - ;; Simple monotonic counter for import entity IDs. - ;; Starts well above any normal entity range so imports don't collide. - (define *import-eid-counter* (expt 2 48)) - - (define (next-import-eid ae) - (let ([eid *import-eid-counter*]) - (set! *import-eid-counter* (+ *import-eid-counter* 1)) - eid)) - -) ;; end library new file mode 100644 --- /dev/null +++ b/lib/jerboa-db/analytics.ss @@ -0,0 +1,248 @@ +#!chezscheme +;;; (jerboa-db analytics) — DuckDB integration for OLAP queries +;;; +;;; Maintains a columnar replica of the datom store for analytical queries. +;;; Provides SQL over datoms, Parquet export/import, and CSV import. + +(library (jerboa-db analytics) + (export + new-analytics-engine analytics-engine? + analytics-sync! analytics-query + export-parquet import-parquet import-csv + analytics-close) + + (import (except (chezscheme) + make-hash-table hash-table? + sort sort! + printf fprintf + path-extension path-absolute? + with-input-from-string with-output-to-string + iota 1+ 1- + partition + make-date make-time) + (jerboa prelude) + (std db duckdb) + (jerboa-db datom) + (jerboa-db schema) + (jerboa-db tx-log)) + + ;; ---- Analytics engine record ---- + + (defstruct analytics-engine + (duckdb-conn ;; DuckDB connection handle (integer) + last-synced-tx ;; last tx synced to DuckDB + schema-ref ;; reference to schema registry + tx-log-ref)) ;; reference to transaction log + + (def (new-analytics-engine schema tx-log . opts) + ;; Optional: path for persistent DuckDB file + (let ([path (if (pair? opts) (car opts) ":memory:")]) + (let ([conn (duckdb-open path)]) + (let ([ae (make-analytics-engine conn 0 schema tx-log)]) + (create-datom-table! ae) + ae)))) + + ;; ---- Schema setup ---- + + (def (create-datom-table! ae) + (duckdb-exec (analytics-engine-duckdb-conn ae) + "CREATE TABLE IF NOT EXISTS datoms ( + e BIGINT NOT NULL, + a INTEGER NOT NULL, + a_name VARCHAR, + v_long BIGINT, + v_double DOUBLE, + v_string VARCHAR, + v_bool BOOLEAN, + v_ref BIGINT, + v_instant BIGINT, + tx BIGINT NOT NULL, + added BOOLEAN NOT NULL + )")) + + ;; ---- Sync from transaction log ---- + + (def (analytics-sync! ae) + ;; Read transaction log entries since last-synced-tx and INSERT datoms. + (let* ([log (analytics-engine-tx-log-ref ae)] + [schema (analytics-engine-schema-ref ae)] + [last-tx (analytics-engine-last-synced-tx ae)] + [entries (tx-log-range log last-tx (+ (tx-log-latest-tx log) 1))]) + (for-each + (lambda (entry) + (for-each + (lambda (dv) + ;; dv is #(e a v tx added?) — serializable form from tx-log + (insert-datom-row! ae schema dv)) + (tx-log-entry-datoms entry))) + entries) + (when (pair? entries) + (analytics-engine-last-synced-tx-set! ae + (tx-log-entry-tx-id (car (reverse entries))))))) + + (def (insert-datom-row! ae schema dv) + ;; dv is a vector: #(e a v tx added?) + (let* ([e (vector-ref dv 0)] + [a (vector-ref dv 1)] + [v (vector-ref dv 2)] + [tx (vector-ref dv 3)] + [added? (vector-ref dv 4)] + [attr (schema-lookup-by-id schema a)] + [a-name (if attr (symbol->string (db-attribute-ident attr)) #f)] + [vtype (if attr (db-attribute-value-type attr) #f)]) + ;; Resolve each typed slot — only one should be non-NULL per row. + (let-values ([(v-long v-double v-string v-bool v-ref v-instant) + (classify-value v vtype)]) + (duckdb-eval + (analytics-engine-duckdb-conn ae) + "INSERT INTO datoms + (e, a, a_name, v_long, v_double, v_string, v_bool, v_ref, v_instant, tx, added) + VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" + e a a-name + v-long v-double v-string v-bool v-ref v-instant + tx added?)))) + + ;; Map a datom value + schema type to the six typed column slots. + ;; Returns six values: (v-long v-double v-string v-bool v-ref v-instant). + ;; Exactly one will be non-#f (or all #f for unknown types). + (def (classify-value v vtype) + (cond + ;; Explicit schema type wins + [(eq? vtype 'db.type/long) + (values (and (integer? v) v) #f #f #f #f #f)] + [(eq? vtype 'db.type/double) + (values #f (and (number? v) (inexact v)) #f #f #f #f)] + [(eq? vtype 'db.type/string) + (values #f #f (and (string? v) v) #f #f #f)] + [(eq? vtype 'db.type/boolean) + (values #f #f #f (and (boolean? v) v) #f #f)] + [(eq? vtype 'db.type/ref) + (values #f #f #f #f (and (integer? v) v) #f)] + [(eq? vtype 'db.type/instant) + (values #f #f #f #f #f (and (integer? v) v))] + [(eq? vtype 'db.type/keyword) + ;; Store keyword/symbol as string + (values #f #f (and (symbol? v) (symbol->string v)) #f #f #f)] + [(eq? vtype 'db.type/uuid) + (values #f #f (and (string? v) v) #f #f #f)] + [(eq? vtype 'db.type/symbol) + (values #f #f (and (symbol? v) (symbol->string v)) #f #f #f)] + ;; No schema — infer from Scheme type + [(boolean? v) (values #f #f #f v #f #f)] + [(flonum? v) (values #f v #f #f #f #f)] + [(integer? v) (values v #f #f #f #f #f)] + [(string? v) (values #f #f v #f #f #f)] + [(symbol? v) (values #f #f (symbol->string v) #f #f #f)] + [else (values #f #f (format "~s" v) #f #f #f)])) + + ;; ---- SQL query ---- + + (def (analytics-query ae sql-string . params) + ;; Sync first so the view is up-to-date, then run SQL. + (analytics-sync! ae) + (apply duckdb-query (analytics-engine-duckdb-conn ae) sql-string params)) + + ;; ---- Parquet export ---- + + (def (export-parquet ae path . opts) + ;; opts: optional SQL override (default: full datoms table) + (analytics-sync! ae) + (let ([sql (if (pair? opts) + (car opts) + "SELECT * FROM datoms")]) + (duckdb-write-parquet (analytics-engine-duckdb-conn ae) sql path))) + + ;; ---- Parquet import ---- + ;; + ;; mapping: alist of (column-name . attribute-ident) + ;; Each row becomes a new entity assertion. All values imported as strings; + ;; callers can add type coercion via the schema after import. + + (def (import-parquet ae path mapping) + (let ([conn (analytics-engine-duckdb-conn ae)] + [schema (analytics-engine-schema-ref ae)] + [tx-id (+ (tx-log-latest-tx (analytics-engine-tx-log-ref ae)) 1)]) + ;; Use DuckDB to read the parquet and materialise it in-memory + (let ([rows (duckdb-read-parquet conn path)]) + (for-each + (lambda (row) + ;; Allocate a fresh entity id (use a stable hash of row position + ;; relative to tx so re-import is idempotent-ish) + (let ([eid (next-import-eid ae)]) + (for-each + (lambda (col-mapping) + (let* ([col-name (car col-mapping)] + [attr-ident (cdr col-mapping)] + [raw-val (cdr (or (assoc col-name row) '(#f . #f)))] + [attr (schema-lookup-by-ident schema attr-ident)] + [a-id (if attr (db-attribute-id attr) #f)]) + (when (and raw-val a-id) + (let ([vtype (if attr (db-attribute-value-type attr) #f)]) + (let-values ([(v-long v-double v-string v-bool v-ref v-instant) + (classify-value raw-val vtype)]) + (duckdb-eval conn + "INSERT INTO datoms + (e, a, a_name, v_long, v_double, v_string, + v_bool, v_ref, v_instant, tx, added) + VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" + eid a-id + (if attr (symbol->string (db-attribute-ident attr)) #f) + v-long v-double v-string v-bool v-ref v-instant + tx-id #t)))))) + mapping))) + rows)))) + + ;; ---- CSV import ---- + ;; + ;; Same semantics as import-parquet — reads CSV via DuckDB's auto-detect, + ;; then maps columns to attributes. + + (def (import-csv ae path mapping) + (let ([conn (analytics-engine-duckdb-conn ae)] + [schema (analytics-engine-schema-ref ae)] + [tx-id (+ (tx-log-latest-tx (analytics-engine-tx-log-ref ae)) 1)]) + (let ([rows (duckdb-read-csv conn path)]) + (for-each + (lambda (row) + (let ([eid (next-import-eid ae)]) + (for-each + (lambda (col-mapping) + (let* ([col-name (car col-mapping)] + [attr-ident (cdr col-mapping)] + [raw-val (cdr (or (assoc col-name row) '(#f . #f)))] + [attr (schema-lookup-by-ident schema attr-ident)] + [a-id (if attr (db-attribute-id attr) #f)]) + (when (and raw-val a-id) + (let ([vtype (if attr (db-attribute-value-type attr) #f)]) + (let-values ([(v-long v-double v-string v-bool v-ref v-instant) + (classify-value raw-val vtype)]) + (duckdb-eval conn + "INSERT INTO datoms + (e, a, a_name, v_long, v_double, v_string, + v_bool, v_ref, v_instant, tx, added) + VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" + eid a-id + (if attr (symbol->string (db-attribute-ident attr)) #f) + v-long v-double v-string v-bool v-ref v-instant + tx-id #t)))))) + mapping))) + rows)))) + + ;; ---- Close ---- + + (def (analytics-close ae) + (duckdb-close (analytics-engine-duckdb-conn ae)) + (analytics-engine-duckdb-conn-set! ae #f)) + + ;; ---- Internal helpers ---- + + ;; Simple monotonic counter for import entity IDs. + ;; Starts well above any normal entity range so imports don't collide. + (def *import-eid-counter* (expt 2 48)) + + (def (next-import-eid ae) + (let ([eid *import-eid-counter*]) + (set! *import-eid-counter* (+ *import-eid-counter* 1)) + eid)) + +) ;; end library deleted file mode 100644 --- a/lib/jerboa-db/backup.sls +++ /dev/null @@ -1,198 +0,0 @@ -#!chezscheme -;;; (jerboa-db backup) — Backup & Restore -;;; -;;; Snapshots the entire database (all four indices + schema + metadata) -;;; to a file using FASL encoding with optional gzip compression. -;;; Restoration creates a fresh in-memory connection and replays all datoms. - -(library (jerboa-db backup) - (export backup! restore!) - - (import (chezscheme) - (jerboa-db datom) - (jerboa-db schema) - (jerboa-db index protocol) - (jerboa-db index memory) - (jerboa-db history) - (jerboa-db core)) - - ;; ---- Magic header ---- - ;; First 8 bytes of every backup file. - (define +backup-magic+ #vu8(74 68 66 75 49 48 48 48)) ;; "JDBU1000" - - ;; ---- Lazy zlib loader ---- - ;; Mirrors the LevelDB lazy loader pattern in core.sls. - ;; The backup format works with or without zlib: - ;; byte 8 = 1 → gzip compressed, 0 → uncompressed - (define zlib-loaded? #f) - (define zlib-gzip #f) - (define zlib-gunzip #f) - - (define (try-load-zlib!) - (unless zlib-loaded? - (guard (exn [#t #f]) - (eval '(import (std compress zlib))) - (set! zlib-gzip (eval 'gzip-bytevector)) - (set! zlib-gunzip (eval 'gunzip-bytevector)) - (set! zlib-loaded? #t)))) - - ;; ---- Schema serialization ---- - ;; Convert schema registry to a plain list for FASL portability. - - (define (schema->plist schema) - ;; Returns a list of (ident id vtype card unique index? comp? doc no-hist?) - (map (lambda (attr) - (list (db-attribute-ident attr) - (db-attribute-id attr) - (db-attribute-value-type attr) - (db-attribute-cardinality attr) - (db-attribute-unique attr) - (db-attribute-index? attr) - (db-attribute-is-component? attr) - (db-attribute-doc attr) - (db-attribute-no-history? attr))) - (schema-all-attributes schema))) - - (define (plist->schema plist) - ;; new-schema-registry bootstraps system attributes (IDs 0..19). - ;; We then install user attributes from the plist on top of that. - (let ([reg (new-schema-registry)]) - (for-each - (lambda (entry) - (let ([ident (list-ref entry 0)] - [id (list-ref entry 1)] - [vtype (list-ref entry 2)] - [card (list-ref entry 3)] - [unique (list-ref entry 4)] - [idx? (list-ref entry 5)] - [comp? (list-ref entry 6)] - [doc (list-ref entry 7)] - [no-hist (list-ref entry 8)]) - ;; Only install user attributes; system ones are already bootstrapped - (when (>= id +first-user-attr-id+) - (let ([attr (make-db-attribute - ident id vtype card unique idx? comp? doc no-hist)]) - (schema-install-attribute! reg attr))))) - plist) - reg)) - - ;; ---- backup! ---- - ;; Serialize connection snapshot to output-path. - ;; Format: - ;; [8 bytes magic] [1 byte: 0=raw, 1=gzip] [FASL payload] - ;; FASL payload is a vector: #(basis-tx next-eid schema-plist datoms-list) - ;; where datoms-list is a list of (e a v tx added?) 5-tuples. - - (define (backup! conn output-path) - ;; Try to load zlib but proceed without it on failure - (try-load-zlib!) - (let* ([current-db (db conn)] - [indices (db-value-indices current-db)] - [schema (db-value-schema current-db)] - [basis-tx (db-value-basis-tx current-db)] - ;; Read next-eid from connection (it's a list cell: (next-eid)) - ;; We reconstruct it by reading all datoms and taking max eid + 1 - [eavt (index-set-eavt indices)] - [all-datoms (dbi-datoms eavt)] - ;; Serialize datoms as plain lists for FASL - [datom-list (map datom->list all-datoms)] - [schema-pl (schema->plist schema)] - ;; Compute next-eid from connection internals via db-stats - [stats (db-stats conn)] - [payload (vector basis-tx - ;; Store eavt-count as a marker; restore computes next-eid - datom-list - schema-pl)]) - ;; FASL-serialize payload to bytevector - (let-values ([(port get-bv) (open-bytevector-output-port)]) - (fasl-write payload port) - (let* ([raw-bv (get-bv)] - [use-gzip (and zlib-gzip #t)] - [data-bv (if use-gzip (zlib-gzip raw-bv) raw-bv)]) - ;; Write binary data: magic + compression flag + payload - (let ([out (open-file-output-port output-path - (file-options no-fail) - (buffer-mode block))]) - (put-bytevector out +backup-magic+) - (put-u8 out (if use-gzip 1 0)) - (put-bytevector out data-bv) - (close-port out)))))) - - ;; ---- restore! ---- - ;; Read a backup file and return a new in-memory connection with all - ;; data replayed. Does NOT call transact! — datoms are inserted directly - ;; into the indices to avoid schema validation overhead and to preserve - ;; original transaction IDs. - - (define (restore! backup-path) - (try-load-zlib!) - ;; Read the file - (let* ([in (open-file-input-port backup-path - (file-options) - (buffer-mode block))] - [magic (get-bytevector-n in 8)] - [flag (get-u8 in)] - [rest (get-bytevector-all in)]) - (close-port in) - ;; Validate magic - (unless (equal? magic +backup-magic+) - (error 'restore! "Not a valid jerboa-db backup file" backup-path)) - ;; Decompress if needed - (let* ([raw-bv (if (= flag 1) - (if zlib-gunzip - (zlib-gunzip rest) - (error 'restore! "Backup is gzip-compressed but zlib is unavailable")) - rest)] - ;; Deserialize FASL - [port (open-bytevector-input-port raw-bv)] - [payload (fasl-read port)]) - (close-port port) - (let* ([basis-tx (vector-ref payload 0)] - [datom-list (vector-ref payload 1)] - [schema-pl (vector-ref payload 2)] - ;; Rebuild schema - [schema (plist->schema schema-pl)] - ;; Create fresh in-memory index set - [indices (make-mem-index-set)] - ;; Replay all datoms directly into indices - [eavt (index-set-eavt indices)] - [aevt (index-set-aevt indices)] - [avet (index-set-avet indices)] - [vaet (index-set-vaet indices)]) - ;; Insert each datom into appropriate indices - (for-each - (lambda (entry) - (let* ([e (list-ref entry 0)] - [a (list-ref entry 1)] - [v (list-ref entry 2)] - [tx (list-ref entry 3)] - [added (list-ref entry 4)] - [d (make-datom e a v tx added)]) - ;; Always insert into EAVT and AEVT - (dbi-add! eavt d) - (dbi-add! aevt d) - ;; Insert into AVET if attribute is indexed - (let ([attr (schema-lookup-by-id schema a)]) - (when (and attr (indexed-attr? attr)) - (dbi-add! avet d)) - ;; Insert into VAET if ref type - (when (and attr (ref-type? attr)) - (dbi-add! vaet d))))) - datom-list) - ;; Compute next-eid = max entity id + 1 - (let ([max-eid (fold-left - (lambda (acc entry) (max acc (list-ref entry 0))) - +first-user-attr-id+ - datom-list)]) - ;; Build the initial db-value - (let* ([initial-db (make-db-value basis-tx indices schema #f #f #f)] - [conn (make-connection - initial-db - (list (+ max-eid 1)) - '() - (new-db-cache 10000) - ":memory:" - #f)]) - conn)))))) - -) ;; end library new file mode 100644 --- /dev/null +++ b/lib/jerboa-db/backup.ss @@ -0,0 +1,207 @@ +#!chezscheme +;;; (jerboa-db backup) — Backup & Restore +;;; +;;; Snapshots the entire database (all four indices + schema + metadata) +;;; to a file using FASL encoding with optional gzip compression. +;;; Restoration creates a fresh in-memory connection and replays all datoms. + +(library (jerboa-db backup) + (export backup! restore!) + + (import (except (chezscheme) + make-hash-table hash-table? + sort sort! + printf fprintf + path-extension path-absolute? + with-input-from-string with-output-to-string + iota 1+ 1- + partition + make-date make-time) + (jerboa prelude) + (jerboa-db datom) + (jerboa-db schema) + (jerboa-db index protocol) + (jerboa-db index memory) + (jerboa-db history) + (jerboa-db core)) + + ;; ---- Magic header ---- + ;; First 8 bytes of every backup file. + (def +backup-magic+ #vu8(74 68 66 75 49 48 48 48)) ;; "JDBU1000" + + ;; ---- Lazy zlib loader ---- + ;; Mirrors the LevelDB lazy loader pattern in core.sls. + ;; The backup format works with or without zlib: + ;; byte 8 = 1 → gzip compressed, 0 → uncompressed + (def zlib-loaded? #f) + (def zlib-gzip #f) + (def zlib-gunzip #f) + + (def (try-load-zlib!) + (unless zlib-loaded? + (guard (exn [#t #f]) + (eval '(import (std compress zlib))) + (set! zlib-gzip (eval 'gzip-bytevector)) + (set! zlib-gunzip (eval 'gunzip-bytevector)) + (set! zlib-loaded? #t)))) + + ;; ---- Schema serialization ---- + ;; Convert schema registry to a plain list for FASL portability. + + (def (schema->plist schema) + ;; Returns a list of (ident id vtype card unique index? comp? doc no-hist?) + (map (lambda (attr) + (list (db-attribute-ident attr) + (db-attribute-id attr) + (db-attribute-value-type attr) + (db-attribute-cardinality attr) + (db-attribute-unique attr) + (db-attribute-index? attr) + (db-attribute-is-component? attr) + (db-attribute-doc attr) + (db-attribute-no-history? attr))) + (schema-all-attributes schema))) + + (def (plist->schema plist) + ;; new-schema-registry bootstraps system attributes (IDs 0..19). + ;; We then install user attributes from the plist on top of that. + (let ([reg (new-schema-registry)]) + (for-each + (lambda (entry) + (let ([ident (list-ref entry 0)] + [id (list-ref entry 1)] + [vtype (list-ref entry 2)] + [card (list-ref entry 3)] + [unique (list-ref entry 4)] + [idx? (list-ref entry 5)] + [comp? (list-ref entry 6)] + [doc (list-ref entry 7)] + [no-hist (list-ref entry 8)]) + ;; Only install user attributes; system ones are already bootstrapped + (when (>= id +first-user-attr-id+) + (let ([attr (make-db-attribute + ident id vtype card unique idx? comp? doc no-hist)]) + (schema-install-attribute! reg attr))))) + plist) + reg)) + + ;; ---- backup! ---- + ;; Serialize connection snapshot to output-path. + ;; Format: + ;; [8 bytes magic] [1 byte: 0=raw, 1=gzip] [FASL payload] + ;; FASL payload is a vector: #(basis-tx next-eid schema-plist datoms-list) + ;; where datoms-list is a list of (e a v tx added?) 5-tuples. + + (def (backup! conn output-path) + ;; Try to load zlib but proceed without it on failure + (try-load-zlib!) + (let* ([current-db (db conn)] + [indices (db-value-indices current-db)] + [schema (db-value-schema current-db)] + [basis-tx (db-value-basis-tx current-db)] + ;; Read next-eid from connection (it's a list cell: (next-eid)) + ;; We reconstruct it by reading all datoms and taking max eid + 1 + [eavt (index-set-eavt indices)] + [all-datoms (dbi-datoms eavt)] + ;; Serialize datoms as plain lists for FASL + [datom-list (map datom->list all-datoms)] + [schema-pl (schema->plist schema)] + ;; Compute next-eid from connection internals via db-stats + [stats (db-stats conn)] + [payload (vector basis-tx + ;; Store eavt-count as a marker; restore computes next-eid + datom-list + schema-pl)]) + ;; FASL-serialize payload to bytevector + (let-values ([(port get-bv) (open-bytevector-output-port)]) + (fasl-write payload port) + (let* ([raw-bv (get-bv)] + [use-gzip (and zlib-gzip #t)] + [data-bv (if use-gzip (zlib-gzip raw-bv) raw-bv)]) + ;; Write binary data: magic + compression flag + payload + (let ([out (open-file-output-port output-path + (file-options no-fail) + (buffer-mode block))]) + (put-bytevector out +backup-magic+) + (put-u8 out (if use-gzip 1 0)) + (put-bytevector out data-bv) + (close-port out)))))) + + ;; ---- restore! ---- + ;; Read a backup file and return a new in-memory connection with all + ;; data replayed. Does NOT call transact! — datoms are inserted directly + ;; into the indices to avoid schema validation overhead and to preserve + ;; original transaction IDs. + + (def (restore! backup-path) + (try-load-zlib!) + ;; Read the file + (let* ([in (open-file-input-port backup-path + (file-options) + (buffer-mode block))] + [magic (get-bytevector-n in 8)] + [flag (get-u8 in)] + [rest (get-bytevector-all in)]) + (close-port in) + ;; Validate magic + (unless (equal? magic +backup-magic+) + (error 'restore! "Not a valid jerboa-db backup file" backup-path)) + ;; Decompress if needed + (let* ([raw-bv (if (= flag 1) + (if zlib-gunzip + (zlib-gunzip rest) + (error 'restore! "Backup is gzip-compressed but zlib is unavailable")) + rest)] + ;; Deserialize FASL + [port (open-bytevector-input-port raw-bv)] + [payload (fasl-read port)]) + (close-port port) + (let* ([basis-tx (vector-ref payload 0)] + [datom-list (vector-ref payload 1)] + [schema-pl (vector-ref payload 2)] + ;; Rebuild schema + [schema (plist->schema schema-pl)] + ;; Create fresh in-memory index set + [indices (make-mem-index-set)] + ;; Replay all datoms directly into indices + [eavt (index-set-eavt indices)] + [aevt (index-set-aevt indices)] + [avet (index-set-avet indices)] + [vaet (index-set-vaet indices)]) + ;; Insert each datom into appropriate indices + (for-each + (lambda (entry) + (let* ([e (list-ref entry 0)] + [a (list-ref entry 1)] + [v (list-ref entry 2)] + [tx (list-ref entry 3)] + [added (list-ref entry 4)] + [d (make-datom e a v tx added)]) + ;; Always insert into EAVT and AEVT + (dbi-add! eavt d) + (dbi-add! aevt d) + ;; Insert into AVET if attribute is indexed + (let ([attr (schema-lookup-by-id schema a)]) + (when (and attr (indexed-attr? attr)) + (dbi-add! avet d)) + ;; Insert into VAET if ref type + (when (and attr (ref-type? attr)) + (dbi-add! vaet d))))) + datom-list) + ;; Compute next-eid = max entity id + 1 + (let ([max-eid (fold-left + (lambda (acc entry) (max acc (list-ref entry 0))) + +first-user-attr-id+ + datom-list)]) + ;; Build the initial db-value + (let* ([initial-db (make-db-value basis-tx indices schema #f #f #f)] + [conn (make-connection + initial-db + (list (+ max-eid 1)) + '() + (new-db-cache 10000) + ":memory:" + #f)]) + conn)))))) + +) ;; end library deleted file mode 100644 --- a/lib/jerboa-db/cache.sls +++ /dev/null @@ -1,103 +0,0 @@ -#!chezscheme -;;; (jerboa-db cache) — LRU datom/entity cache -;;; -;;; Wraps an LRU cache for hot datoms and entity maps. -;;; Cache invalidation is trivial because data is immutable — -;;; new transactions only add entries, never modify existing ones. - -(library (jerboa-db cache) - (export - new-db-cache db-cache? - cache-get cache-put! cache-clear! cache-stats - cache-get-entity cache-put-entity!) - - (import (chezscheme)) - - ;; Simple LRU cache using a hashtable + doubly-linked list (mutable pairs). - ;; We inline this to avoid depending on (std misc lru-cache) at library level. - - (define-record-type db-cache - (fields (mutable capacity) - (mutable datom-ht) ;; eq-hashtable: key -> value - (mutable datom-order) ;; list of keys in access order (MRU first) - (mutable entity-ht) - (mutable entity-order) - (mutable hits) - (mutable misses))) - - (define (new-db-cache capacity) - (make-db-cache capacity - (make-hashtable equal-hash equal?) '() - (make-hashtable equal-hash equal?) '() - 0 0)) - - ;; ---- Generic cache ops over a ht + order pair ---- - - (define (lru-get cache ht order-getter order-setter! key default) - (let ([v (hashtable-ref ht key 'NOT-FOUND)]) - (if (eq? v 'NOT-FOUND) - (begin - (db-cache-misses-set! cache (+ (db-cache-misses cache) 1)) - default) - (begin - (db-cache-hits-set! cache (+ (db-cache-hits cache) 1)) - ;; Move to front - (order-setter! cache (cons key (remq key (order-getter cache)))) - v)))) - - (define (lru-put! cache ht order-getter order-setter! key value) - (let ([cap (db-cache-capacity cache)]) - (hashtable-set! ht key value) - (let ([new-order (cons key (remq key (order-getter cache)))]) - ;; Evict if over capacity - (when (> (length new-order) cap) - (let ([victim (list-ref new-order (- (length new-order) 1))]) - (hashtable-delete! ht victim) - (set! new-order (reverse (cdr (reverse new-order)))))) - (order-setter! cache new-order)))) - - ;; ---- Datom cache ---- - - (define (cache-get cache key default) - (lru-get cache (db-cache-datom-ht cache) - db-cache-datom-order db-cache-datom-order-set! - key default)) - - (define (cache-put! cache key value) - (lru-put! cache (db-cache-datom-ht cache) - db-cache-datom-order db-cache-datom-order-set! - key value)) - - ;; ---- Entity cache ---- - - (define (cache-get-entity cache eid default) - (lru-get cache (db-cache-entity-ht cache) - db-cache-entity-order db-cache-entity-order-set! - eid default)) - - (define (cache-put-entity! cache eid entity)