mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[html-chart] compact, use (ice-9 match)
Use (ice-9 match) for easier matching for the variable 'path'. Explanation; consider the snippet (cond ((null? path) ...A...) ((and (pair? (car path)) (number (caar path))) ...B...) (else ...C...)) This snippet is a shorthand for nested if-then-else clauses, testing 'path' successfully to determine whether to evaluate A, B or C. Some code will also use components of 'path' eg B uses (caar path). Using Alex Shinn's match.scm library allows more concise matching and assignment at the same time. The syntax is (match EXPR (CLAUSE BODY ...)) (define (try path) (match path (() (display "null")) ((((? number? idx)) . tail) (display "B") (display idx) (newline) (display tail)) ((head . tail) (display "C") (display head) (newline) (display tail)))) A: the first match is easy -- if path is '() then evaluate the first body. (try '()) --> "null" C: the third match is easy -- if path is a pair, then assign 'head' to pair's car, 'tail' to the pair's cdr, and evaluate the body which has access to head and tail. Note the head is a string, and the tail is a list containing a single string. (try '("this" "that")) --> Cthis (that) B: the second match is more difficult -- let's consider the broken-down clause: a pair, (HEAD . tail); where HEAD is a single-element list (ELT), and ELT is a match conditional satisfying number? and is also assigns the variable idx (? number? idx). Example: (try '((2) "two")) --> B2 (two) This means the match is successful when 'path' is a pair, the pair's car is a single-element list, and the list's sole element is a number. The latter is bound to the variable 'idx' which is accessible in the body. The variable 'tail' contains the path's cdr which contains a single string. Note: later in same commit we also use the identifier _ to denote elements which *must* be matched, but are *not* bound to any variable. e.g. the clause (((? out-of-bound?)) . _) means that path is a pair, whose car is a single-element list, and the element satisfies the predicate out-of-bound?. We don't need to use the (cdr path) therefore we use _ as a placeholder.
This commit is contained in:
parent
172e371d8a
commit
1f83cfaf64
@ -32,6 +32,8 @@
|
||||
;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(use-modules (ice-9 match))
|
||||
|
||||
;; nested-alist-set! parameters are
|
||||
;; lst - a nested alist e.g. (list (cons 'key1 'val1)
|
||||
;; (cons 'key2 (list (cons 'key2-sub1 'val2a))))
|
||||
@ -44,70 +46,45 @@
|
||||
;; see test-html-chart.scm for usage examples
|
||||
(define (nested-alist-set! lst path newval)
|
||||
(define (path->nested-alist path newval)
|
||||
(let innerloop ((path (reverse path))
|
||||
(result newval))
|
||||
(cond
|
||||
((null? path)
|
||||
result)
|
||||
((and (pair? (car path)) (number? (caar path)))
|
||||
(innerloop (cdr path)
|
||||
(let ((v (make-vector (1+ (caar path)))))
|
||||
(vector-set! v (caar path) result)
|
||||
v)))
|
||||
(else
|
||||
(innerloop (cdr path)
|
||||
(list (cons (car path) result)))))))
|
||||
(let loop ((path (reverse path)) (result newval))
|
||||
(match path
|
||||
(() result)
|
||||
((((? number? idx)) . tail)
|
||||
(let ((v (make-vector (1+ idx))))
|
||||
(vector-set! v idx result)
|
||||
(loop tail v)))
|
||||
((head . tail) (loop tail (list (cons head result)))))))
|
||||
|
||||
(let loop ((nested-lst lst) (path path))
|
||||
(cond
|
||||
((or (null? nested-lst) (null? path))
|
||||
(throw "invalid state"))
|
||||
((and (pair? (car path)) (number? (caar path)))
|
||||
(cond
|
||||
((>= (caar path) (vector-length nested-lst))
|
||||
(throw (format #f "high vector index ~s must be set earlier"
|
||||
(caar path))))
|
||||
((list? (vector-ref nested-lst (caar path)))
|
||||
(loop (vector-ref nested-lst (caar path))
|
||||
(cdr path)))
|
||||
(else
|
||||
(vector-set! nested-lst
|
||||
(caar path)
|
||||
(path->nested-alist (cdr path) newval)))))
|
||||
(else
|
||||
(let ((kvp (assq (car path) nested-lst)))
|
||||
(cond
|
||||
((not kvp) ; new branch. append to end of parent branch
|
||||
(list-cdr-set! nested-lst
|
||||
(1- (length nested-lst))
|
||||
(path->nested-alist path newval)))
|
||||
((null? (cdr path)) ; existing branch, last path. replace pair's cdr
|
||||
(set-cdr! kvp newval))
|
||||
(else ; existing branch. traverse into next layer.
|
||||
(loop (cdr kvp) (cdr path)))))))))
|
||||
(define (out-of-bound? n) (and (number? n) (>= n (vector-length nested-lst))))
|
||||
(define (existing? n) (and (number? n) (pair? (vector-ref nested-lst n))))
|
||||
(if (null? nested-lst) (throw 'invalid-state))
|
||||
(match path
|
||||
(() (throw 'invalid-state))
|
||||
((((? out-of-bound? idx)) . _) (throw 'index-too-high idx))
|
||||
((((? existing? idx)) . tail) (loop (vector-ref nested-lst idx) tail))
|
||||
((((? number? idx)) . tail) (vector-set! nested-lst idx
|
||||
(path->nested-alist tail newval)))
|
||||
((head . tail)
|
||||
(let ((pair (assq head nested-lst)))
|
||||
(cond
|
||||
((not pair) (list-cdr-set! nested-lst (1- (length nested-lst))
|
||||
(path->nested-alist path newval)))
|
||||
((null? tail) (set-cdr! pair newval))
|
||||
(else (loop (cdr pair) tail))))))))
|
||||
|
||||
(define (nested-alist-get lst path)
|
||||
(let loop ((nested-lst lst) (path path))
|
||||
(cond
|
||||
((null? path)
|
||||
nested-lst)
|
||||
((null? nested-lst)
|
||||
(throw "invalid state. most likely the initial list is empty."))
|
||||
((and (pair? (car path)) (number? (caar path)))
|
||||
(cond
|
||||
((>= (caar path) (vector-length nested-lst))
|
||||
(throw (format #f "invalid path vector index ~s too high"
|
||||
(caar path))))
|
||||
(else
|
||||
(loop (vector-ref nested-lst (caar path))
|
||||
(cdr path)))))
|
||||
(else
|
||||
(let ((kvp (assq (car path) nested-lst)))
|
||||
(cond
|
||||
((not kvp)
|
||||
(throw (format #f "invalid path: ~s" path)))
|
||||
(else
|
||||
(loop (cdr kvp) (cdr path)))))))))
|
||||
(define (out-of-bound? n) (and (number? n) (>= n (vector-length nested-lst))))
|
||||
(match path
|
||||
(() nested-lst)
|
||||
((((? out-of-bound? idx)) . _) (throw 'index-too-high idx))
|
||||
((((? number? idx)) . tail) (loop (vector-ref nested-lst idx) tail))
|
||||
((head . tail)
|
||||
(let ((pair (assq head nested-lst)))
|
||||
(if pair
|
||||
(loop (cdr pair) tail)
|
||||
(throw 'invalid-path path)))))))
|
||||
|
||||
;; helper for setting data - guile-json expects vectors to be
|
||||
;; transformed into JSON arrays; convert list to vector. if not list,
|
||||
@ -285,18 +262,14 @@
|
||||
(cons 'label label)
|
||||
(cons 'backgroundColor (list-to-vec color))
|
||||
(cons 'borderColor (list-to-vec color)))))
|
||||
(if (null? rest)
|
||||
(gnc:html-chart-set!
|
||||
chart '(data datasets)
|
||||
(list->vector
|
||||
(append (vector->list
|
||||
(or (gnc:html-chart-get chart '(data datasets))
|
||||
#()))
|
||||
(list newseries))))
|
||||
(loop (cddr rest)
|
||||
(assq-set! newseries
|
||||
(car rest)
|
||||
(list-to-vec (cadr rest)))))))
|
||||
(match rest
|
||||
(() (gnc:html-chart-set!
|
||||
chart '(data datasets)
|
||||
(list->vector
|
||||
(append (vector->list
|
||||
(or (gnc:html-chart-get chart '(data datasets)) #()))
|
||||
(list newseries)))))
|
||||
((key val . rest) (loop rest (assq-set! newseries key (list-to-vec val)))))))
|
||||
|
||||
(define-public (gnc:html-chart-clear-data-series! chart)
|
||||
(gnc:html-chart-set! chart '(data datasets) #()))
|
||||
|
Loading…
Reference in New Issue
Block a user