From b561984dcc1a1baefb0073011066ee22dcb59e4a Mon Sep 17 00:00:00 2001
From: Karchnu <karchnu@karchnu.fr>
Date: Wed, 12 Oct 2022 00:57:41 +0200
Subject: [PATCH] Partitions: draft. Different paths for indexes and
 partitions.

---
 src/dodb.cl | 75 +++++++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 62 insertions(+), 13 deletions(-)

diff --git a/src/dodb.cl b/src/dodb.cl
index 1d62632..a6e38d1 100755
--- a/src/dodb.cl
+++ b/src/dodb.cl
@@ -1,7 +1,7 @@
 #!/usr/local/bin/clisp
 
-(load "~/.quicklisp/setup.lisp")
-(ql:quickload "osicat")
+;(load "~/.quicklisp/setup.lisp")
+;(ql:quickload "osicat")
 
 (load "./util.cl")
 (defpackage :dodb
@@ -14,6 +14,16 @@
     ))
 (in-package dodb)
 
+;(defun ln (path &key target hard)
+;  (format t "SYMLINK: ~A -> ~A~&" path target))
+;  ; (osicat:make-link symlink-path
+;  ;   :target (concatenate 'string "../../data/" file-name)
+;  ;   :hard nil))
+
+;(defmacro alias (to fn)
+;  `(setf (fdefinition ',to) #',fn))
+;(alias ln osicat:make-link)
+
 ; TODO: equivalent in Crystal
 ; cars = DODB::DataBase(Car).new "./storage"
 ; cars_by_name = cars.new_index "name", &.name
@@ -37,28 +47,39 @@
   (ensure-directories-exist (concatenate 'string path "/data/"))
   (make-db :struct-name struct-name :path path))
 
-; example: db-path/by_name/
+; example: db-path/indexes/by_name/
 (defun db/new-index (database attribute-name)
   ; Create a directory for the indexes.
   (ensure-directories-exist
-    (concatenate 'string (db-path database) "/by_" attribute-name "/"))
+    (concatenate 'string (db-path database) "/indexes/by_" attribute-name "/"))
   ; Add this new index to the list.
   (push attribute-name (db-indexes database)))
 
+; example: db-path/partitions/by_color/
+(defun db/new-partition (database attribute-name)
+  ; Create a directory for the partitions.
+  (ensure-directories-exist
+    (concatenate 'string (db-path database) "/partitions/by_" attribute-name "/"))
+  ; Add this new index to the list.
+  (push attribute-name (db-partitions database)))
+
 (defun to-upper-case (some-string)
   (format nil "~@:(~a~)" some-string))
 
+(defun get-object-attribute (database attribute-name object)
+  (funcall ; example: call function "VEHICLE-COLOR"
+    (find-symbol (to-upper-case
+      (concatenate 'string (db-struct-name database) "-" attribute-name)))
+    object))
+
 ; Returns "Corvet".
 (defun db/index/get-filename (database index-name object)
-  (funcall ; example: call function "VEHICLE-NAME"
-    (find-symbol (to-upper-case
-      (concatenate 'string (db-struct-name database) "-" index-name)))
-    object))
+  (get-object-attribute database index-name object))
 
 (defun db/index/get-symlink-path (database index-name object)
   (concatenate 'string
     (db-path database)
-    "/by_" index-name "/"
+    "/indexes/by_" index-name "/"
     (db/index/get-filename database index-name object)))
 
 (defun db/index/new (database index-name object file-name)
@@ -66,8 +87,32 @@
       (db/index/get-symlink-path database index-name object)))
 
     ; Works even when the database directory is moved.
-    (osicat:make-link symlink-path
-      :target (concatenate 'string "../data/" file-name)
+    (ln symlink-path
+      :target (concatenate 'string "../../data/" file-name)
+      :hard nil)
+  ))
+
+; Returns "Red".
+(defun db/partition/get-filename (database partition-name object)
+  (get-object-attribute database partition-name object))
+
+(defun db/partition/get-symlink-path (database partition-name object file-name)
+  (concatenate 'string
+    (db-path database)
+    "/partitions/by_" partition-name "/"
+    (db/partition/get-filename database partition-name object) "/"
+    file-name
+    ))
+
+(defun db/partition/new (database partition-name object file-name)
+  (let ((symlink-path
+      (db/partition/get-symlink-path database partition-name object file-name)))
+
+    (ensure-directories-exist symlink-path)
+
+    ; Works even when the database directory is moved.
+    (ln symlink-path
+      :target (concatenate 'string "../../../data/" file-name)
       :hard nil)
   ))
 
@@ -86,11 +131,13 @@
       object
       (db/add/new-data-filepath database file-name))
 
-    ; TODO: handle indexes
+    ; handle indexes
     (loop for index in (db-indexes database)
        do (db/index/new database index object file-name))
 
     ; TODO: handle partitions
+    (loop for partition in (db-partitions database)
+       do (db/partition/new database partition object file-name))
     )
   )
 
@@ -99,8 +146,10 @@
 
 ; TODO
 (setf cars (db/new "vehicle" "./storage/cars/"))
-; (format t "~&~S~&" cars)
+
 (db/new-index cars "name")
+(db/new-partition cars "color")
+
 (db/add cars (make-vehicle :name "Corvet" :color "Red"))
 (format t "~&~S~&" cars)