From fb7f6bf67e73920277c4d123d60e634a8e8426c1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sat, 25 Mar 2023 17:12:11 +0100 Subject: [PATCH] Implement 2nd pass. --- MEMBERS.md | 14 +++++++++++ member-parser.scm | 63 ++++++++++++++++++++++++++++++++++++----------- 2 files changed, 62 insertions(+), 15 deletions(-) diff --git a/MEMBERS.md b/MEMBERS.md index cc1ca39..d33c4eb 100644 --- a/MEMBERS.md +++ b/MEMBERS.md @@ -46,6 +46,20 @@ value for the key. The result of parsing is a list of parsed records containing key, value and line number for further processing. +Member File Processing - Pass 2 +------------------------------- + +Processed source is scanned for known keys. + +Multiple instances of single key are considered an error. + +Unknown keys are considered a warning. + +Valid multikeys are converted to single key with list of values and +line numbers as the value for such key. + +The result is a valid dictionary of keys and multikeys. + Member File Grammar ------------------- diff --git a/member-parser.scm b/member-parser.scm index 6237dd9..4257b51 100644 --- a/member-parser.scm +++ b/member-parser.scm @@ -28,7 +28,7 @@ (module member-parser ( - parse-member-file + load-member-file member-parser-tests! ) @@ -37,9 +37,14 @@ (chicken io) (chicken irregex) member2-record - testing) + testing + dictionary) - ;; Removes any comments and removes any leading and trailing + ;; TODO: move to separate schema module + (define member-schema-known-keys '(nick mail phone name born joined destroyed)) + (define member-schema-known-multikeys '(card desfire credit studentstart studentstop suspendstart suspendstop)) + + ;; Pass 0: Removes any comments and removes any leading and trailing ;; whitespace. (define (preprocess-member-line line) (irregex-replace (irregex "[ \\t]*$" 'u) @@ -48,10 +53,10 @@ "") "")) - ;; Expects line with comments and surrounding whitespace removed, - ;; returns either #f if nothing was parsed, symbol if only one token - ;; was there and pair of symbol and string if both key and the value - ;; were present. + ;; Pass 1: Expects line with comments and surrounding whitespace + ;; removed, returns either #f if nothing was parsed, symbol if only + ;; one token was there and pair of symbol and string if both key and + ;; the value were present. (define (parse-member-line line) (if (= (string-length line) 0) #f @@ -65,7 +70,7 @@ (cons key val)) (string->symbol line))))) - ;; Adds parsed lines to member record. + ;; 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)) @@ -88,15 +93,43 @@ result) (add1 line-number)))))) - ;; Loads member file source. Performs passes 0 and 1 on each line - ;; returning parsed source. Parsed source is a list of lists - ;; containing '(key value line-number) information. Leading and - ;; trailing whitespace is trimmed for both keys and values. - (define (parse-member-file mr) + ;; Pass 2: Converts parsed key/value/line records into a proper + ;; dictionary. Known keys are stored as pairs of value and line + ;; number, known multikeys as lists of pairs of value and line + ;; number. + (define (process-member-file mr) + (let loop ((parsed (dict-ref mr 'parsed)) + (mr mr) + (processed (make-dict))) + (if (null? parsed) + (member-record-set mr #:processed processed) + (let* ((line (car parsed)) + (key (car line)) + (value (cadr line)) + (number (caddr line))) + (if (member key member-schema-known-keys) + (if (dict-has-key? processed key) + (loop (cdr parsed) + (member-record-add-highlight mr number "Duplicate key" 2 'error) + processed) + (loop (cdr parsed) + mr + (dict-set processed key (cons value number)))) + (if (member key member-schema-known-multikeys) + (loop (cdr parsed) + mr + (dict-set processed key (cons (cons value number) + (dict-ref processed key '())))) + (loop (cdr parsed) + (member-record-add-highlight mr number "Unknown key" 2 'warning) + processed))))))) + + ;; Loads member file source. Performs passes 0, 1 and 2. + (define (load-member-file mr) (let* ((mrif (member-record-input-file mr)) (source (read-lines mrif)) (mrp (parse-member-lines mr source))) - mrp)) + (process-member-file mrp))) ;; Performs self-tests of the member-parser module. (define (member-parser-tests!) @@ -138,4 +171,4 @@ (import member-parser) (member-parser-tests!) -(print (parse-member-file (make-member-record "joe" "members/joe" '()))) +(print (load-member-file (make-member-record "joe" "members/joe" '())))