New splitting of member file lines, detailed error reporting.

member-file.scm

@@ -34,16 +34,38 @@
 	 (chicken base)
 	 (chicken string)
 	 (chicken io)
+	 (chicken irregex)
+	 (chicken format)
 	 dictionary
 	 month
 	 period
-	 testing)
+	 testing
+	 listing)
 
  ;; Specification of known keys for various types of parsing
  (define known-keys '(nick mail phone name born joined))
  (define start/stop-keys '(student suspend))
  (define multi-keys '(card desfire credit))
 
+ ;; Configuration of error reporting
+ (define *member-file-context* (make-parameter 3))
+
+ ;; Derived keys
+ (define start/stop-keys-keys
+   (map
+    string->symbol
+    (flatten
+     (map
+      (lambda (key)
+	(let ((skey (symbol->string key)))
+	  (list (string-intersperse (list skey "start") "")
+		(string-intersperse (list skey "stop") ""))))
+      start/stop-keys))))
+
+ ;; All valid keys in one place for early validation
+ (define all-valid-keys
+   (append known-keys start/stop-keys-keys multi-keys))
+
  ;; Member File Parser: remove comments from line and return the result
  (define (line-remove-comments l)
    (let ((si (substring-index "#" l)))
@@ -53,14 +75,47 @@
 	     (car (string-chop l si)))
 	 l)))
 
+ (define (report-line-error file-name lines highlights message)
+   (print "Error in " file-name ": " message)
+   (newline)
+   (print-source-listing lines highlights (*member-file-context*) "\x1b[31;1m" "\x1b[0m" "" "" "...")
+   (exit 1))
+
  ;; Parses given key-value line. Key is up to first space, value is the
  ;; rest of the line. If the line doesn't contain anything, returns #f.
- (define (parse-member-line l)
+ (define (split-member-line l . rest)
-   (let ((sp (string-split (line-remove-comments l) " ")))
+   (let* ((file-name (if (not (null? rest)) (car rest) #f))
-     (and sp
+	  (rest1 (if (not (null? rest)) (cdr rest) '()))
-	  (not (null? sp))
+	  (lines (if (not (null? rest1)) (car rest1) #f))
-	  (list (string->symbol (car sp))
+	  (rest2 (if (not (null? rest1)) (cdr rest1) '()))
-		(string-intersperse (cdr sp))))))
+	  (line-number (if (not (null? rest2)) (car rest2) #f))
+	  (lc0 (irregex-replace "^[ \\t]*" l ""))
+	  (lc (irregex-replace "[ \\t]*$" lc0 "")))
+     (if (= (string-length lc) 0)
+	 #f
+	 (let ((dm (irregex-search (string->irregex "[ \\t]") lc)))
+	   (if dm
+	       (let* ((kei (irregex-match-start-index dm))
+		      (skey (substring lc 0 kei))
+		      (key (string->symbol skey))
+		      (v0 (substring lc kei))
+		      (val (irregex-replace "^[ \\t]*" v0 "")))
+		 (if (member key all-valid-keys)
+		     (list key val)
+		     (if file-name
+			 (report-line-error file-name lines (list line-number)
+					    (sprintf "Invalid key ~A" key))
+			 (error 'split-member-line (sprintf "Invalid key ~A" key)))))
+	       (if (member (string->symbol lc) all-valid-keys)
+		   (if file-name
+		       (report-line-error file-name lines (list line-number)
+					  (sprintf "No value for key ~A" lc))
+		       (error 'split-member-line (sprintf "No value for key ~A" lc)))
+		   (if file-name
+		       (report-line-error file-name lines (list line-number)
+					  (sprintf "No value for invalid key ~A" lc))
+		       (error 'split-member-line
+			      (sprintf "No value for invalid key ~A" lc)))))))))
 
  ;; If given symbol represents start/stop symbol of either kind,
  ;; returns a list of the symbol representing the type and start/stop
@@ -119,13 +174,13 @@
 
  ;; Processes all lines and returns a dictionary representing given
  ;; member. 
- (define (parse-member-lines ls)
+ (define (parse-member-lines lines file-name)
-   (let loop ((ls ls)
+   (let loop ((ls lines)
 	      (r (make-default-member-info))
 	      (line-number 1))
      (if (null? ls)
 	 (convert-member-keys:markers->periods r 'suspend 'student)
-	 (let ((p (parse-member-line (car ls))))
+	 (let ((p (split-member-line (car ls) file-name lines line-number)))
 	   (loop (cdr ls)
 		 (if p
 		     (apply process-member-line r p)
@@ -136,7 +191,7 @@
  (define (load-member-file ffn)
    (let* ((f (open-input-file ffn))
 	  (ls (read-lines f))
-	  (md (parse-member-lines ls)))
+	  (md (parse-member-lines ls ffn)))
      (display ".")
      md))
 
@@ -148,6 +203,11 @@
     (test-equal? line-remove-comments (line-remove-comments "") "")
     (test-equal? line-remove-comments (line-remove-comments "test # comment") "test ")
     (test-equal? line-remove-comments (line-remove-comments "test") "test")
+    (test-equal? split-member-line (split-member-line "nick value") '(nick "value"))
+    (test-equal? split-member-line (split-member-line "  nick value") '(nick "value"))
+    (test-equal? split-member-line (split-member-line "  nick value   ") '(nick "value"))
+    (test-equal? split-member-line (split-member-line "  nick value1  value2 ") '(nick "value1  value2"))
+    (test-exn split-member-line (split-member-line "key value"))
     ))
 
  )