DODB: correct typing for all functions.

draft
kimory 2022-10-25 19:49:36 +02:00
parent c36cad41ab
commit 73e1f0123c
1 changed files with 44 additions and 10 deletions

View File

@ -47,7 +47,7 @@
(declare (type string value)) (declare (type string value))
(substitute-if #\_ #'is-forbidden-character-p value)) (substitute-if #\_ #'is-forbidden-character-p value))
; (declaim (ftype (function (string symbol null) string) value->safe-string)) (declaim (ftype (function (atom) string) value->safe-string))
(defun value->safe-string (value) (defun value->safe-string (value)
(protect-file-system (typecase value (protect-file-system (typecase value
(string value) (string value)
@ -65,6 +65,7 @@
; db/new ensures directory '<path>/data/' exist, ; db/new ensures directory '<path>/data/' exist,
; then loads values from existing files, if any, and puts them into db-data. ; then loads values from existing files, if any, and puts them into db-data.
(declaim (ftype (function (string) db) db/new))
(defun db/new (path) (defun db/new (path)
(declare (type string path)) (declare (type string path))
(let ((data (make-hash-table)) (let ((data (make-hash-table))
@ -99,6 +100,7 @@
(concatenate 'string dbpath "/partitions/by_" name "/" object-attribute "/")) (concatenate 'string dbpath "/partitions/by_" name "/" object-attribute "/"))
; Example: "./storage/cars/" "name" #'vehicle-name object -> "./storage/cars/indexes/by_name/Corvet". ; Example: "./storage/cars/" "name" #'vehicle-name object -> "./storage/cars/indexes/by_name/Corvet".
(declaim (ftype (function (string string function atom) string) db/index/get-symlink-path))
(defun db/index/get-symlink-path (dbpath index-name fsymbol object) (defun db/index/get-symlink-path (dbpath index-name fsymbol object)
(declare (type string dbpath index-name)) (declare (type string dbpath index-name))
(declare (type function fsymbol)) (declare (type function fsymbol))
@ -112,6 +114,7 @@
; -> (osicat:make-link "./storage/cars/indexes/by_name/Corvet" ; -> (osicat:make-link "./storage/cars/indexes/by_name/Corvet"
; :target "../../data/0000000015" ; :target "../../data/0000000015"
; :hard nil) ; :hard nil)
(declaim (ftype (function (string string function atom string) null) db/index/new))
(defun db/index/new (dbpath index-name fsymbol object file-name) (defun db/index/new (dbpath index-name fsymbol object file-name)
(declare (type string dbpath index-name file-name)) (declare (type string dbpath index-name file-name))
(declare (type function fsymbol)) (declare (type function fsymbol))
@ -121,15 +124,19 @@
; works even when the database directory is moved ; works even when the database directory is moved
(osicat:make-link symlink-path (osicat:make-link symlink-path
:target (concatenate 'string "../../data/" file-name) :target (concatenate 'string "../../data/" file-name)
:hard nil))) :hard nil))
(values nil))
(declaim (ftype (function (string string function atom) null) db/index/del))
(defun db/index/del (dbpath index-name fsymbol object) (defun db/index/del (dbpath index-name fsymbol object)
(declare (type string dbpath index-name)) (declare (type string dbpath index-name))
(declare (type function fsymbol)) (declare (type function fsymbol))
(delete-file (db/index/get-symlink-path dbpath index-name fsymbol object))) (delete-file (db/index/get-symlink-path dbpath index-name fsymbol object))
(values nil))
; Example: "./storage/cars/" "color" #'vehicle-color object "0000000015". ; Example: "./storage/cars/" "color" #'vehicle-color object "0000000015".
; -> "./storage/cars/partitions/by_color/Red/0000000015". ; -> "./storage/cars/partitions/by_color/Red/0000000015".
(declaim (ftype (function (string string function atom string) string) db/partition/get-symlink-path))
(defun db/partition/get-symlink-path (dbpath partition-name fsymbol object file-name) (defun db/partition/get-symlink-path (dbpath partition-name fsymbol object file-name)
(declare (type string dbpath partition-name file-name)) (declare (type string dbpath partition-name file-name))
(declare (type function fsymbol)) (declare (type function fsymbol))
@ -143,6 +150,7 @@
; -> (osicat:make-link "./storage/cars/partitions/by_color/Red/0000000015" ; -> (osicat:make-link "./storage/cars/partitions/by_color/Red/0000000015"
; :target "../../../data/0000000015" ; :target "../../../data/0000000015"
; :hard nil) ; :hard nil)
(declaim (ftype (function (string string function atom string) null) db/partition/new))
(defun db/partition/new (dbpath partition-name fsymbol object file-name) (defun db/partition/new (dbpath partition-name fsymbol object file-name)
(declare (type string dbpath partition-name file-name)) (declare (type string dbpath partition-name file-name))
(declare (type function fsymbol)) (declare (type function fsymbol))
@ -154,14 +162,19 @@
; works even when the database directory is moved ; works even when the database directory is moved
(osicat:make-link symlink-path (osicat:make-link symlink-path
:target (concatenate 'string "../../../data/" file-name) :target (concatenate 'string "../../../data/" file-name)
:hard nil))) :hard nil))
(values nil))
(declaim (ftype (function (string string function atom string) null) db/partition/del))
(defun db/partition/del (dbpath partition-name fsymbol object file-basename) (defun db/partition/del (dbpath partition-name fsymbol object file-basename)
(declare (type string dbpath partition-name file-basename)) (declare (type string dbpath partition-name file-basename))
(declare (type function fsymbol)) (declare (type function fsymbol))
(delete-file (db/partition/get-symlink-path dbpath partition-name fsymbol object file-basename))) (delete-file (db/partition/get-symlink-path dbpath partition-name fsymbol object file-basename))
(values nil))
(declaim (ftype (function (db string function) null) db/new-index))
(defun db/new-index (database index-name fsymbol) (defun db/new-index (database index-name fsymbol)
(declare (type db database))
(declare (type string index-name)) (declare (type string index-name))
(declare (type function fsymbol)) (declare (type function fsymbol))
(let ((dbpath (db-path database)) (let ((dbpath (db-path database))
@ -178,8 +191,10 @@
(handler-case (db/index/new dbpath index-name fsymbol object (number->filename number)) (handler-case (db/index/new dbpath index-name fsymbol object (number->filename number))
(OSICAT-POSIX:EEXIST () (OSICAT-POSIX:EEXIST ()
(format t "dodb:db/new-index: symlink already exists, ignoring.~&")))) (format t "dodb:db/new-index: symlink already exists, ignoring.~&"))))
(db-data database)))) (db-data database)))
(values nil))
(declaim (ftype (function (string string function atom string atom) null) db/partition/update))
(defun db/partition/update (dbpath partition-name fsymbol object file-name old-object) (defun db/partition/update (dbpath partition-name fsymbol object file-name old-object)
(declare (type string dbpath partition-name file-name)) (declare (type string dbpath partition-name file-name))
(declare (type function fsymbol)) (declare (type function fsymbol))
@ -192,7 +207,9 @@
; create new partition ; create new partition
(db/partition/new dbpath partition-name fsymbol object file-name))))) (db/partition/new dbpath partition-name fsymbol object file-name)))))
(declaim (ftype (function (db string function) null) db/new-partition))
(defun db/new-partition (database partition-name fsymbol) (defun db/new-partition (database partition-name fsymbol)
(declare (type db database))
(declare (type string partition-name)) (declare (type string partition-name))
(declare (type function fsymbol)) (declare (type function fsymbol))
(let ((dbpath (db-path database)) (let ((dbpath (db-path database))
@ -209,7 +226,8 @@
(handler-case (db/partition/new dbpath partition-name fsymbol object (number->filename number)) (handler-case (db/partition/new dbpath partition-name fsymbol object (number->filename number))
(OSICAT-POSIX:EEXIST () (OSICAT-POSIX:EEXIST ()
(format t "dodb:db/new-partition: symlink already exists, ignoring.~&")))) (format t "dodb:db/new-partition: symlink already exists, ignoring.~&"))))
(db-data database)))) (db-data database)))
(values nil))
; Example: "./storage/cars/data/000000000000018". ; Example: "./storage/cars/data/000000000000018".
(declaim (ftype (function (string string) string) get-filepath)) (declaim (ftype (function (string string) string) get-filepath))
@ -217,7 +235,9 @@
(declare (type string dbpath file-name)) (declare (type string dbpath file-name))
(concatenate 'string dbpath "/data/" file-name)) (concatenate 'string dbpath "/data/" file-name))
(declaim (ftype (function (db atom) integer) db/add))
(defun db/add (database object) (defun db/add (database object)
(declare (type db database))
(incf (db-current-index database)) (incf (db-current-index database))
(let* ((file-basename (number->filename (db-current-index database))) (let* ((file-basename (number->filename (db-current-index database)))
(dbpath (db-path database)) (dbpath (db-path database))
@ -245,7 +265,9 @@
(setf (gethash (db-current-index database) (db-data database)) object) (setf (gethash (db-current-index database) (db-data database)) object)
(db-current-index database)) (db-current-index database))
(declaim (ftype (function (db integer) null) db/del))
(defun db/del (database object-index) (defun db/del (database object-index)
(declare (type db database))
(declare (type integer object-index)) (declare (type integer object-index))
(let ((file-basename (number->filename object-index)) (let ((file-basename (number->filename object-index))
(dbpath (db-path database)) (dbpath (db-path database))
@ -264,10 +286,13 @@
(db-partitions database)) (db-partitions database))
; remove in-memory data ; remove in-memory data
(remhash object-index (db-data database)))) (remhash object-index (db-data database)))
(values nil))
; Search for the data from the FS. ; Search for the data from the FS.
(declaim (ftype (function (db string atom) integer) db/get-by-index))
(defun db/get-by-index (database index-name attribute-value) (defun db/get-by-index (database index-name attribute-value)
(declare (type db database))
(declare (type string index-name)) (declare (type string index-name))
(let ((value (value->safe-string attribute-value))) (let ((value (value->safe-string attribute-value)))
(filename->integer (filename->integer
@ -276,13 +301,16 @@
(db/index/get-directory-path (db-path database) index-name) "/" value))))) (db/index/get-directory-path (db-path database) index-name) "/" value)))))
; Search for the data from the FS. ; Search for the data from the FS.
(declaim (ftype (function (db string atom) cons) db/get-by-partition))
(defun db/get-by-partition (database name attribute-value) (defun db/get-by-partition (database name attribute-value)
(declare (type db database))
(declare (type string name)) (declare (type string name))
(let ((value (value->safe-string attribute-value)) (let ((value (value->safe-string attribute-value))
(dbpath (db-path database))) (dbpath (db-path database)))
(loop for filename in (osicat:list-directory (db/partition/get-directory-path dbpath name value)) (loop for filename in (osicat:list-directory (db/partition/get-directory-path dbpath name value))
collect (filename->integer filename)))) collect (filename->integer filename))))
(declaim (ftype (function (string string function atom string atom) null) db/index/update))
(defun db/index/update (dbpath index-name fsymbol object file-name old-object) (defun db/index/update (dbpath index-name fsymbol object file-name old-object)
(declare (type string dbpath index-name file-name)) (declare (type string dbpath index-name file-name))
(declare (type function fsymbol)) (declare (type function fsymbol))
@ -301,7 +329,9 @@
; TODO: check database integrity (redundancy) ; TODO: check database integrity (redundancy)
; TODO: locking ; TODO: locking
(declaim (ftype (function (db integer) null) db/update))
(defun db/update (database object-index) (defun db/update (database object-index)
(declare (type db database))
(declare (type integer object-index)) (declare (type integer object-index))
(let* ((object (gethash object-index (db-data database))) (let* ((object (gethash object-index (db-data database)))
(dbpath (db-path database)) (dbpath (db-path database))
@ -327,8 +357,12 @@
; handle partitions ; handle partitions
(maphash #'(lambda (partition-name fsymbol) (maphash #'(lambda (partition-name fsymbol)
(db/partition/update dbpath partition-name fsymbol object file-basename old-object)) (db/partition/update dbpath partition-name fsymbol object file-basename old-object))
(db-partitions database)))) (db-partitions database)))
(values nil))
(declaim (ftype (function (db) null) db/drop-everything))
(defun db/drop-everything (database) (defun db/drop-everything (database)
(declare (type db database))
(osicat:delete-directory-and-files (db-path database)) (osicat:delete-directory-and-files (db-path database))
(clrhash (db-data database))) (clrhash (db-data database))
(values nil))