cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

tracking: minor improvements; make building of track data configurable

Browse source
This commit is contained in:
Helmut Merz 2024-07-29 08:43:47 +02:00
parent 69c3013332
commit d363a3dde3
3 changed files with 13 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
shape/shape.lisp
View file

@ -2,6 +2,7 @@
(defpackage :scopes/shape
(:use :common-lisp)
(:local-nicknames (:util :scopes/util))
(:export #:record #:head-fields #:head #:data
#:head-plist))
@ -14,9 +15,8 @@
(data :accessor data :initarg :data :initform nil)))
(defun head-plist (track)
(let (pl h (hv (head track)))
(let (pl (hv (head track)))
(dolist (hf (head-fields track))
(setf h (pop hv))
(setf (getf pl hf)
(if h (string-downcase h) "")))
(setf pl (cons hf (cons (util:keyword-to-string (pop hv)) pl))))
(log:info "pl: ~s" pl)
pl))

8
storage/tracking.lisp
View file

@ -18,6 +18,8 @@
(in-package :scopes/storage/tracking)
(defvar *build-track-data* #'alx:hash-table-plist)
(defclass track (shape:record)
((trackid :accessor trackid :initform nil)
(time-stamp :accessor time-stamp :initform nil)
@ -45,8 +47,8 @@
(defun plist (track)
(let ((vl (shape:head-plist track)))
(with-slots ((trid trackid) (ts time-stamp) (data shape:data)) track
(if trid (setf (getf vl :trackid) trid))
(if ts (setf (getf vl :timestamp) (timestamp-to-sql track ts)))
(when trid (setf (getf vl :trackid) trid))
(when ts (setf (getf vl :timestamp) (timestamp-to-sql track ts)))
(when data
(unless (hash-table-p data)
(setf data (alx:plist-hash-table data)))
@ -84,7 +86,7 @@
(setf (trackid tr) (getf row :trackid))
(setf (time-stamp tr) (getf row :timestamp))
(setf (shape:data tr)
(alx:hash-table-plist
(funcall *build-track-data*
(jzon:parse (getf row :data) :key-fn #'util:to-keyword)))
tr))

5
util.lisp
View file

@ -2,7 +2,7 @@
(defpackage :scopes/util
(:use :common-lisp)
(:export #:flatten-str #:to-keyword #:to-string
(:export #:flatten-str #:to-keyword #:keyword-to-string #:to-string
#:loop-plist
#:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
#:relative-path #:runtime-path #:system-path))
@ -16,6 +16,9 @@
(mapcar (lambda (x) (str:trim x))
(str:lines s))))
(defun keyword-to-string (k)
(if k (string-downcase k) ""))
(defun to-string (k &key (sep " ") lower-case)
(let ((pattern (if lower-case "~(~a~)" "~a")))
(if (atom k)