Dictionary reduce, prepare members-base usage.
This commit is contained in:
parent
e26b78b254
commit
77204b80e4
3 changed files with 56 additions and 5 deletions
|
@ -50,6 +50,10 @@
|
||||||
(members-base-tests!)
|
(members-base-tests!)
|
||||||
(newline)
|
(newline)
|
||||||
|
|
||||||
|
;; Command-line options and configurable parameters
|
||||||
|
(define *members-directory* (make-parameter "members"))
|
||||||
|
|
||||||
|
;; Arguments parsing
|
||||||
(command-line
|
(command-line
|
||||||
print-help
|
print-help
|
||||||
(-h () "This help"
|
(-h () "This help"
|
||||||
|
@ -58,9 +62,13 @@
|
||||||
(print-help)
|
(print-help)
|
||||||
(newline)
|
(newline)
|
||||||
(exit 0))
|
(exit 0))
|
||||||
|
(-MB (dir) "Members base directory" (*members-directory* dir))
|
||||||
(-mfkw () "Member-File invalid Key Warning" (*member-file-check-syntax* 'warning))
|
(-mfkw () "Member-File invalid Key Warning" (*member-file-check-syntax* 'warning))
|
||||||
(-mfkq () "Member-File invalid Key Quiet" (*member-file-check-syntax* 'quiet))
|
(-mfkq () "Member-File invalid Key Quiet" (*member-file-check-syntax* 'quiet))
|
||||||
(-mfec (n) "Member-File parser Error Context (lines)" (*member-file-context* (string->number n))))
|
(-mfec (n) "Member-File parser Error Context (lines)" (*member-file-context* (string->number n))))
|
||||||
|
|
||||||
(load-members "members" #t)
|
;; Load the members database (required for everything anyway)
|
||||||
|
(define MB (load-members "members" #t))
|
||||||
|
|
||||||
|
;; ...
|
||||||
|
(void)
|
||||||
|
|
|
@ -34,6 +34,7 @@
|
||||||
dict-keys
|
dict-keys
|
||||||
dict-map
|
dict-map
|
||||||
dict-filter
|
dict-filter
|
||||||
|
dict-reduce
|
||||||
dictionary-tests!
|
dictionary-tests!
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -117,6 +118,16 @@
|
||||||
(cons (car d) r)
|
(cons (car d) r)
|
||||||
r)))))
|
r)))))
|
||||||
|
|
||||||
|
;; Reduce over dictinary, the reducing procedure gets accumulator,
|
||||||
|
;; key and value as its three arguments.
|
||||||
|
(define (dict-reduce init proc d)
|
||||||
|
(let loop ((d d)
|
||||||
|
(acc init))
|
||||||
|
(if (null? d)
|
||||||
|
acc
|
||||||
|
(loop (cdr d)
|
||||||
|
(proc acc (caar d) (cdar d))))))
|
||||||
|
|
||||||
;; Performs self-tests of the dictionary module.
|
;; Performs self-tests of the dictionary module.
|
||||||
(define (dictionary-tests!)
|
(define (dictionary-tests!)
|
||||||
(run-tests
|
(run-tests
|
||||||
|
@ -144,6 +155,9 @@
|
||||||
'((a . 1)
|
'((a . 1)
|
||||||
(b . 2)))
|
(b . 2)))
|
||||||
'((a . 1)))
|
'((a . 1)))
|
||||||
|
(test-eq? dict-reduce
|
||||||
|
(dict-reduce 0 (lambda (a k v) (+ a v)) '((a . 1) (b . 2)))
|
||||||
|
3)
|
||||||
))
|
))
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
|
@ -117,6 +117,15 @@
|
||||||
#t
|
#t
|
||||||
(loop (cdr lst))))))
|
(loop (cdr lst))))))
|
||||||
|
|
||||||
|
;; Returns the first 4-digit symbol from the list.
|
||||||
|
(define (get-4digit-symbol-from-list lst)
|
||||||
|
(let loop ((lst lst))
|
||||||
|
(if (null? lst)
|
||||||
|
#f
|
||||||
|
(if (is-4digit-symbol? (car lst))
|
||||||
|
(car lst)
|
||||||
|
(loop (cdr lst))))))
|
||||||
|
|
||||||
;; Returns dictionary containing only records with either 4-digit
|
;; Returns dictionary containing only records with either 4-digit
|
||||||
;; name or one of its aliases being 4-digit.
|
;; name or one of its aliases being 4-digit.
|
||||||
(define (files-dictionary-filter-4digit-symbols d)
|
(define (files-dictionary-filter-4digit-symbols d)
|
||||||
|
@ -138,7 +147,8 @@
|
||||||
(make-pathname mdir fname)))))
|
(make-pathname mdir fname)))))
|
||||||
|
|
||||||
;; Loads members database, if the second argument is true, shows
|
;; Loads members database, if the second argument is true, shows
|
||||||
;; progress.
|
;; progress. Members database is a dictionary with id being the key
|
||||||
|
;; (number) and member record being the value.
|
||||||
(define (load-members dn . opts)
|
(define (load-members dn . opts)
|
||||||
(let ((progress? (and (not (null? opts))
|
(let ((progress? (and (not (null? opts))
|
||||||
(car opts))))
|
(car opts))))
|
||||||
|
@ -147,17 +157,33 @@
|
||||||
(let* ((fss (files-dictionary-filter-4digit-symbols
|
(let* ((fss (files-dictionary-filter-4digit-symbols
|
||||||
(files+symlinks->files-dictionary
|
(files+symlinks->files-dictionary
|
||||||
(get-files+symlinks dn))))
|
(get-files+symlinks dn))))
|
||||||
(mb (dict-map
|
(mb0 (dict-map
|
||||||
(lambda (symfn symlinks)
|
(lambda (symfn symlinks)
|
||||||
(when progress?
|
(when progress?
|
||||||
(display "."))
|
(display "."))
|
||||||
(members-base-load-member dn
|
(members-base-load-member dn
|
||||||
(symbol->string symfn)
|
(symbol->string symfn)
|
||||||
symlinks))
|
symlinks))
|
||||||
fss)))
|
fss))
|
||||||
|
(mb (dict-reduce (make-dict)
|
||||||
|
(lambda (acc key val)
|
||||||
|
#f)
|
||||||
|
mb0)))
|
||||||
(when progress?
|
(when progress?
|
||||||
(print " ok."))
|
(print " ok."))
|
||||||
mb)))
|
mb0)))
|
||||||
|
|
||||||
|
(define (find-member-by-id mb id)
|
||||||
|
#f)
|
||||||
|
|
||||||
|
(define (find-member-by-nick mb nick)
|
||||||
|
#f)
|
||||||
|
|
||||||
|
(define (list-members-ids mb)
|
||||||
|
#f)
|
||||||
|
|
||||||
|
(define (list-members-nicks mb)
|
||||||
|
#f)
|
||||||
|
|
||||||
;; Performs self-tests of this module.
|
;; Performs self-tests of this module.
|
||||||
(define (members-base-tests!)
|
(define (members-base-tests!)
|
||||||
|
@ -181,6 +207,9 @@
|
||||||
(test-false is-4digit-symbol? (is-4digit-symbol? '|ABC|))
|
(test-false is-4digit-symbol? (is-4digit-symbol? '|ABC|))
|
||||||
(test-true list-contains-4digit-symbol? (list-contains-4digit-symbol? '(|0000| abc |666|)))
|
(test-true list-contains-4digit-symbol? (list-contains-4digit-symbol? '(|0000| abc |666|)))
|
||||||
(test-false list-contains-4digit-symbol? (list-contains-4digit-symbol? '(|00000| abc |666|)))
|
(test-false list-contains-4digit-symbol? (list-contains-4digit-symbol? '(|00000| abc |666|)))
|
||||||
|
(test-eq? get-4digit-symbol-from-list
|
||||||
|
(get-4digit-symbol-from-list '(|000| abc |6666| qwer))
|
||||||
|
'|6666|)
|
||||||
))
|
))
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue