Created
July 31, 2017 11:56
-
-
Save phoe/851373f771224311f905996b454ad9a4 to your computer and use it in GitHub Desktop.
BKNR multistore sketch
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;; unfinished - I'll think of finishing this some other time mayhaps | |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;;;; BKNR.MULTISTORE | |
;;;; © Michał "phoe" Herda 2017 | |
;;;; bknr.multistore.lisp | |
(defpackage #:bknr.multistore | |
(:shadowing-import-from #:closer-mop | |
#:standard-generic-function #:defmethod #:defgeneric | |
#:standard-method #:standard-class) | |
(:use #:cl | |
#:closer-mop | |
#:bknr.datastore | |
#:split-sequence)) | |
(in-package #:bknr.multistore) | |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;;;; STORES - UTILITY | |
(defvar *store* 'attempted-to-create-object-without-store-context) | |
(defvar *store-root* #p"/tmp/gateway/") | |
(defgeneric store-location (object)) | |
(defmacro with-store (store &body body) | |
`(let ((*store* ,store)) | |
,@body)) | |
(defmacro with-store-and-transaction ((store &optional label) &body body) | |
`(with-store ,store | |
(with-transaction (,label) | |
,@body))) | |
(defmacro make-stores (object &body stores) | |
(flet ((make-store-definition (symbol) | |
(let* ((name (string symbol))) | |
`(,(intern (concatenate 'string name "-STORE")) | |
,(string-downcase (concatenate 'string name "/"))))) | |
(store-list (definition) | |
(destructuring-bind (accessor folder) definition | |
`((,accessor ,object) | |
(make-object-store (merge-pathnames ,folder (store-location ,object))))))) | |
(let ((definitions (mapcar #'make-store-definition stores))) | |
`(setf ,@(mapcan #'store-list definitions))))) | |
(defun make-object-store (directory) | |
(ensure-directories-exist directory) | |
(make-instance 'mp-store | |
:make-default nil | |
:directory directory | |
:subsystems (list (make-instance 'store-object-subsystem)))) | |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;;;; STORAGE-CLASS | |
(defclass storage-class (standard-class) | |
()) | |
(defmethod initialize-instance :before ((class storage-class) &key)) | |
(defmethod reinitialize-instance :before ((class storage-class) &key)) | |
(defmethod validate-superclass ((class storage-class) (super standard-class)) | |
t) | |
(defun %storage-class-slot-definition (symbol) | |
(let* ((slot-name symbol) | |
(reader symbol) | |
(initarg nil) | |
(elements (split-sequence #\- (string-downcase (string symbol)))) | |
(directory (%ensure-slash (first elements))) | |
(initform `(make-object-store ,directory))) | |
(assert (= 2 (length elements))) | |
(assert (string= "store" (second elements))) | |
`(:name ,slot-name | |
:readers (,reader) | |
:writers ((setf ,reader)) | |
:initarg ,initarg | |
:initform ,initform | |
:initfunction #'(lambda () ,initform)))) | |
(defun %ensure-slash (string) | |
(if (eql #\/ (elt string (1- (length string)))) | |
string | |
(concatenate 'string string "/"))) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment