From ce5ec7a463008ee53181153377f0d4596b0a5550 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Fri, 2 Sep 2022 10:55:10 +0200 Subject: [PATCH] Checkpoint before testing under Debian --- mevenson/simulation/glacier.asd | 8 +++-- mevenson/simulation/glacier.lisp | 18 ++++++++--- mevenson/simulation/json-path.lisp | 51 ++++++++++++++++++++++++++++++ mevenson/simulation/package.lisp | 4 +++ 4 files changed, 75 insertions(+), 6 deletions(-) create mode 100644 mevenson/simulation/json-path.lisp create mode 100644 mevenson/simulation/package.lisp diff --git a/mevenson/simulation/glacier.asd b/mevenson/simulation/glacier.asd index 31fbb6e..d52b1b7 100644 --- a/mevenson/simulation/glacier.asd +++ b/mevenson/simulation/glacier.asd @@ -1,7 +1,11 @@ (defsystem glacier :version "0.0.1" - :depends-on (jsown) + :depends-on (alexandria + jsown + split-sequence) :components ((:module source :pathname "./" - :components ((:file "glacier"))))) + :components ((:file "package") + (:file "json-path") + (:file "glacier"))))) diff --git a/mevenson/simulation/glacier.lisp b/mevenson/simulation/glacier.lisp index de8d872..7beb9a4 100644 --- a/mevenson/simulation/glacier.lisp +++ b/mevenson/simulation/glacier.lisp @@ -1,7 +1,3 @@ -(defpackage glacier - (:use :cl) - (:export #:grind)) - (in-package glacier) (defun json-parameters () @@ -26,6 +22,20 @@ $.distribution.no 1/2)) +(defun jsown-template () + '(:OBJ + ("consensus_settings" :OBJ + ("glacier" :OBJ ("evidence_alpha" . 4/5) ("evidence_alpha_2" . 1/2) + ("look_ahead" . 20) + ("query" :OBJ ("query_size" . 7) ("initial_query_size" . 7) + ("query_multiplier" . 2) ("max_multiplier" . 4)))) + ("distribution" :OBJ ("yes" . 1/2) ("no" . 1/2) ("none" . 0)) + ("byzantine_settings" :OBJ ("total_size" . 1000) + ("distribution" :OBJ ("honest" . 1) ("infantile" . 0) ("random" . 0) + ("omniscient" . 0))) + ("wards" (:OBJ ("time_to_finality" :OBJ ("ttf_threshold" . 2)))) + ("network_modifiers" (:OBJ ("random_drop" :OBJ ("drop_rate" . 0)))))) + (defun grind () (let* ((template (probe-file "~/work/consensus-prototypes/etc/glacier.json")) diff --git a/mevenson/simulation/json-path.lisp b/mevenson/simulation/json-path.lisp new file mode 100644 index 0000000..b6aaa94 --- /dev/null +++ b/mevenson/simulation/json-path.lisp @@ -0,0 +1,51 @@ +;;;; TODO package separate as JSON Path utilities +(in-package glacier) + +(defun parse-json-path (symbol) + "Transform a symbol into names of json nodes to navigate" + (rest (split-sequence:split-sequence #\. (string-downcase + (symbol-name symbol))))) + + +;; the result returned here is not setf-able +(defun get-path (jsown path) + ;; path may either by a string or a list of strings + (cond ((stringp path) + (jsown:filter jsown path)) + ((and (consp path) + (= 1 (length path))) + (jsown:filter jsown (first path))) + (t + (get-path + (jsown:filter jsown (first path)) + (rest path))))) + +#| It would be nice to use JSOWN:FILTER like this… + +(defun set-path (jsown path value) + (setf + (jsown:filter jsown (parse-json-path path)) + value) +jsown) + +but that doesn't easily work due to JSOWN:FILTER being a macro, so one +can't use CL:REDUCE +|# + + +(defun set-path (jsown path value) + (cond ((stringp path) + (setf + (jsown:filter jsown path) + value)) + ((and (consp path) + (= 1 (length path))) + (setf + (jsown:filter jsown (first path)) + value)) + (t + (set-path + (jsown:filter jsown (first path)) + (rest path) + value)))) + diff --git a/mevenson/simulation/package.lisp b/mevenson/simulation/package.lisp new file mode 100644 index 0000000..e357f48 --- /dev/null +++ b/mevenson/simulation/package.lisp @@ -0,0 +1,4 @@ +(defpackage glacier + (:use :cl) + (:export #:grind)) +