shape:record: always fill head with nil when shorter list is given
This commit is contained in:
parent
8488eeb26c
commit
e92bc4d8a7
3 changed files with 10 additions and 4 deletions
|
@ -11,9 +11,12 @@
|
||||||
(defclass record ()
|
(defclass record ()
|
||||||
((head-fields :reader head-fields :initarg :head-fields
|
((head-fields :reader head-fields :initarg :head-fields
|
||||||
:initform '(:taskid :username) :allocation :class)
|
:initform '(:taskid :username) :allocation :class)
|
||||||
(head :accessor head :initarg :head)
|
(head :reader head :initarg :head)
|
||||||
(data :accessor data :initarg :data :initform nil)))
|
(data :accessor data :initarg :data :initform nil)))
|
||||||
|
|
||||||
|
(defmethod initialize-instance :after ((rec record) &key head &allow-other-keys)
|
||||||
|
(setf (slot-value rec 'head) (util:rfill (head-fields rec) head)))
|
||||||
|
|
||||||
(defun head-plist (rec)
|
(defun head-plist (rec)
|
||||||
(let (pl (hv (head rec)))
|
(let (pl (hv (head rec)))
|
||||||
(dolist (hf (head-fields rec))
|
(dolist (hf (head-fields rec))
|
||||||
|
|
|
@ -128,7 +128,7 @@
|
||||||
;;;; auxiliary functions for queries, ...
|
;;;; auxiliary functions for queries, ...
|
||||||
|
|
||||||
(defun track-equal (old new)
|
(defun track-equal (old new)
|
||||||
(unless (equal (util:rtrim (shape:head old)) (util:rtrim (shape:head new)))
|
(unless (equal (shape:head old) (shape:head new))
|
||||||
(return-from track-equal nil))
|
(return-from track-equal nil))
|
||||||
(if (timestamp new)
|
(if (timestamp new)
|
||||||
(unless (equal (timestamp new) (timestamp old))
|
(unless (equal (timestamp new) (timestamp old))
|
||||||
|
@ -168,7 +168,7 @@
|
||||||
(when row
|
(when row
|
||||||
(let ((hv (mapcar #'(lambda (x) (util:to-keyword (getf row x)))
|
(let ((hv (mapcar #'(lambda (x) (util:to-keyword (getf row x)))
|
||||||
(shape:head-fields tr))))
|
(shape:head-fields tr))))
|
||||||
(setf (shape:head tr) hv)
|
(setf (slot-value tr 'shape:head) hv)
|
||||||
(setf (trackid tr) (getf row :trackid))
|
(setf (trackid tr) (getf row :trackid))
|
||||||
(setf (timestamp tr) (getf row :timestamp))
|
(setf (timestamp tr) (getf row :timestamp))
|
||||||
(setf (shape:data tr)
|
(setf (shape:data tr)
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
(defpackage :scopes/util
|
(defpackage :scopes/util
|
||||||
(:use :common-lisp)
|
(:use :common-lisp)
|
||||||
(:export #:lg #:lgd #:lgi
|
(:export #:lg #:lgd #:lgi
|
||||||
#:rtrim #:loop-plist #:filter-plist #:plist-pairs #:plist-equal
|
#:rfill #:rtrim #:loop-plist #:filter-plist #:plist-pairs #:plist-equal
|
||||||
#:flatten-str #:to-keyword #:keyword-to-string #:to-string
|
#:flatten-str #:to-keyword #:keyword-to-string #:to-string
|
||||||
#:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
|
#:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
|
||||||
#:relative-path #:runtime-path #:system-path))
|
#:relative-path #:runtime-path #:system-path))
|
||||||
|
@ -20,6 +20,9 @@
|
||||||
|
|
||||||
;;;; lists and loops
|
;;;; lists and loops
|
||||||
|
|
||||||
|
(defun rfill (ll ls)
|
||||||
|
(mapcar #'(lambda (x) (pop ls)) ll))
|
||||||
|
|
||||||
(defun rtrim (lst)
|
(defun rtrim (lst)
|
||||||
(nreverse (member-if #'identity (reverse lst))))
|
(nreverse (member-if #'identity (reverse lst))))
|
||||||
|
|
||||||
|
|
Loading…
Add table
Reference in a new issue