Coverage report: /home/ellis/comp/core/lib/rdb/cfg.lisp

KindCoveredAll%
expression095 0.0
branch04 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; cfg.lisp --- RDB Configuration
2
 
3
 ;; Base Configuration Protocol for RDB Databases and Stores
4
 
5
 ;;; Commentary:
6
 
7
 ;; The RDB-CONFIG object may be used to specify initialization values for
8
 ;; RDB-DATABASE/RDB/RDB-STORE.
9
 
10
 ;; You may call BUILD on an RDB-CONFIG to return the uninitialize RDB db or
11
 ;; store.
12
 
13
 ;;; Code:
14
 (in-package :rdb)
15
 
16
 (defconfig rdb-config (ast id db-config)
17
   ((path :initform (std::tmpize-pathname "/tmp/rdb") :initarg :path :type (or pathname string))
18
    (logger :initform (default-logger-config) :initarg :logger :type (or null log::logger-config))
19
    (schema :initform (make-instance 'rdb-schema) :initarg :schema :type rdb-schema)))
20
 
21
 (defmethod print-object ((self rdb-config) stream)
22
   (print-unreadable-object (self stream :type t)
23
     (format stream "~S ~A" :id (format-sxhash (id:id self)))))
24
 
25
 (defun find-rdb-symbol (s)
26
   (find-symbol* (symbol-name s) :rdb nil))
27
 
28
 (defmethod load-ast ((self rdb-config))
29
   (with-slots (ast) self
30
     (if (formp ast)
31
         ;; ast is valid, modify object, set ast nil
32
         (progn
33
           (sb-int:doplist (k v) ast
34
             (when-let ((s (find-rdb-symbol k))) ;; needs to be correct package
35
               (unless (null v)
36
                 (setf v
37
                       (case k
38
                         (:logger (make-config :logger :ast v))
39
                         (t v)))
40
                 (setf (slot-value self s) v))))
41
           (setf (ast:ast self) nil)
42
           self)
43
         ;; invalid ast, signal error
44
         (error 'syntax-error))))
45
   
46
 (defmethod build-ast ((self rdb-config) &key (nullp nil) (exclude '(ast id logger)))
47
   (setf (ast self)
48
         (unwrap-object self
49
                        :slots t
50
                        :methods nil
51
                        :nullp nullp
52
                        :exclude exclude)))
53
 
54
 (defmethod build ((self rdb-config) &key)
55
   (make-db (slot-value self 'backend) 
56
            :opts (slot-value self 'options) 
57
            :logger (when-let ((l (slot-value self 'logger))) (build l))
58
            :name (slot-value self 'path)))
59
 
60
 (defmethod make-config ((self (eql :rdb)) &rest args)
61
   (apply 'make-instance 'rdb-config args))
62
 
63
 (defun init-rdbrc (&optional (file (merge-homedir-pathnames ".rdbrc")))
64
   (let ((cfg (make-instance 'rdb-config)))
65
     (build-ast cfg)
66
     (with-open-file (out file
67
                          :direction :output
68
                          :if-does-not-exist :create)
69
       (write-ast cfg out :fmt :canonical))))