diff --git a/src/brmember.scm b/src/brmember.scm index 5d8de8e..998ace3 100644 --- a/src/brmember.scm +++ b/src/brmember.scm @@ -35,13 +35,13 @@ brmember-file-path brmember-input-file - member-record-set - member-record-add-highlight - member-record-sub-ref - member-record-sub-set - member-record-sub-prepend - member-record-sub-has-key? - member-record-sub-ensure + brmember-set + brmember-add-highlight + brmember-sub-ref + brmember-sub-set + brmember-sub-prepend + brmember-sub-has-key? + brmember-sub-ensure member-source member-record-info @@ -143,58 +143,58 @@ (ldict-ref mr 'file-path))) ;; Sets pairs of keys/values for given member record. - (define (member-record-set mr . args) + (define (brmember-set mr . args) (let loop ((args args) (mr mr)) (if (null? args) mr (if (not (keyword? (car args))) - (error 'member-record-set "Needs argument keyword" (car args)) + (error 'brmember-set "Needs argument keyword" (car args)) (if (null? (cdr args)) - (error 'member-record-set "Argument needs value" (car args)) + (error 'brmember-set "Argument needs value" (car args)) (loop (cddr args) (ldict-set mr (string->symbol (keyword->string (car args))) (cadr args)))))))) ;; Adds highlight identified by line number, message, pass number and ;; type (error, warning, info). - (define (member-record-add-highlight mr line-number message pass type) + (define (brmember-add-highlight mr line-number message pass type) (ldict-set mr 'highlights (cons (list line-number message pass type) (ldict-ref mr 'highlights '())))) ;; Returns a key from particular section - (define (member-record-sub-ref mr sec key . defaults) + (define (brmember-sub-ref mr sec key . defaults) (let ((sec-dict (ldict-ref mr sec))) (if (null? defaults) (ldict-ref sec-dict key) (ldict-ref sec-dict key (car defaults))))) ;; Sets a key in particular section - (define (member-record-sub-set mr sec key val) + (define (brmember-sub-set mr sec key val) (let ((sec-dict (ldict-ref mr sec))) (ldict-set mr sec (ldict-set sec-dict key val)))) ;; Prepends value to given subkey - (define (member-record-sub-prepend mr sec key val) - (member-record-sub-set mr sec key + (define (brmember-sub-prepend mr sec key val) + (brmember-sub-set mr sec key (cons val - (member-record-sub-ref mr sec key '())))) + (brmember-sub-ref mr sec key '())))) ;; Returns true if given section contains given key - (define (member-record-sub-has-key? mr sec key) + (define (brmember-sub-has-key? mr sec key) (ldict-contains? (ldict-ref mr sec) key)) ;; Returns new member record with section updated by defaults, the ;; section must already exist. - (define (member-record-sub-ensure mr sec . kvs) + (define (brmember-sub-ensure mr sec . kvs) (let loop ((kvs kvs) (sd (ldict-ref mr sec))) (if (null? kvs) (ldict-set mr sec sd) (if (null? (cdr kvs)) - (error 'member-record-sub-ensure "Needs pairs of keys and values" kvs) + (error 'brmember-sub-ensure "Needs pairs of keys and values" kvs) (let ((key (car kvs)) (val (cadr kvs))) (loop (cddr kvs) @@ -369,14 +369,14 @@ (file-path . "members/1234") (symlinks |member|) (id . 1234))))) - (test-true member-record-set + (test-true brmember-set (ldict-equal? - (member-record-set (make-ldict) #:id 1234) + (brmember-set (make-ldict) #:id 1234) (make-ldict '((id . 1234))))) - (test-true member-record-add-highlight + (test-true brmember-add-highlight (ldict-equal? - (member-record-add-highlight (make-ldict) 123 "Interesting..." 0 'info) + (brmember-add-highlight (make-ldict) 123 "Interesting..." 0 'info) (make-ldict '((highlights . ((123 "Interesting..." 0 info))))))) (test-true member-destroyed? diff --git a/src/member-parser.scm b/src/member-parser.scm index 8e830c9..1cf301d 100644 --- a/src/member-parser.scm +++ b/src/member-parser.scm @@ -84,13 +84,13 @@ (month (string->month (car mspec))) (comment (cdr mspec))) (if month - (member-record-sub-prepend + (brmember-sub-prepend mr output kind (list marker month (cdr value) comment)) - (member-record-add-highlight + (brmember-add-highlight mr (cdr value) "Invalid month specification" 3 'error)))) mr value)) - (member-record-sub-set mr output key value)))) + (brmember-sub-set mr output key value)))) (info ,(lambda (mr output key value) (case key @@ -100,18 +100,18 @@ (periods (cadr res)) (msg (caddr res)) (line-number (cadddr res)) - (mr1 (member-record-sub-set mr output key periods))) + (mr1 (brmember-sub-set mr output key periods))) (if ok? mr1 - (member-record-add-highlight mr1 line-number msg 3 'error)))) + (brmember-add-highlight mr1 line-number msg 3 'error)))) ((card desfire) - (member-record-sub-set mr output key + (brmember-sub-set mr output key (map (lambda (rec) (string-first+rest (car rec))) value))) ((credit) - (member-record-sub-set mr output key + (brmember-sub-set mr output key (map (lambda (rec) (let* ((fr (string-first+rest (car rec))) @@ -120,35 +120,35 @@ (cons amt msg))) value))) ((nick) - (let ((mr0 (member-record-sub-set mr output key (car value)))) + (let ((mr0 (brmember-sub-set mr output key (car value)))) (if (irregex-search (irregex "[ \\t]" 'u) (car value)) - (member-record-add-highlight + (brmember-add-highlight mr0 (cdr value) "Whitespace not allowed in nick" 3 'error) mr0))) (else - (member-record-sub-set mr output key (car value)))))))) + (brmember-sub-set mr output key (car value)))))))) ;; Pass 4: Final checks - add defaults (define (member-schema-finalize mr) (apply - member-record-sub-ensure + brmember-sub-ensure mr 'info (join (map (lambda (mk) (list mk #f)) mandatory-keys)))) ;; Passes 0 and 1: Adds parsed lines to member record. (define (parse-member-lines mr source) (let loop ((lines source) - (mr (member-record-set mr #:source source)) + (mr (brmember-set mr #:source source)) (result '()) (line-number 1)) (if (null? lines) - (member-record-set mr #:parsed (reverse result)) + (brmember-set mr #:parsed (reverse result)) (let ((parsed-line (parser-parse-line (parser-preprocess-line (car lines))))) (loop (cdr lines) (if (symbol? parsed-line) - (member-record-add-highlight mr line-number "Got only key" 1 'error) + (brmember-add-highlight mr line-number "Got only key" 1 'error) mr) (if (pair? parsed-line) (cons (list (car parsed-line) @@ -167,7 +167,7 @@ (mr mr) (processed (make-ldict))) (if (null? parsed) - (member-record-set mr #:processed processed) + (brmember-set mr #:processed processed) (let* ((line (car parsed)) (key (car line)) (value (cadr line)) @@ -175,7 +175,7 @@ (if (member key known-keys) (if (ldict-contains? processed key) (loop (cdr parsed) - (member-record-add-highlight mr number "Duplicate key" 2 'error) + (brmember-add-highlight mr number "Duplicate key" 2 'error) processed) (loop (cdr parsed) mr @@ -188,7 +188,7 @@ (loop (cdr parsed) (if (member key ignored-keys) mr - (member-record-add-highlight mr number "Unknown key" 2 'warning)) + (brmember-add-highlight mr number "Unknown key" 2 'warning)) processed))))))) ;; Pass 3+: Single interpreter pass - input must be