141 lines
4.3 KiB
Scheme
141 lines
4.3 KiB
Scheme
;;
|
|
;; member-parser.scm
|
|
;;
|
|
;; Member file parsing.
|
|
;;
|
|
;; ISC License
|
|
;;
|
|
;; Copyright 2023 Brmlab, z.s.
|
|
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
|
|
;;
|
|
;; Permission to use, copy, modify, and/or distribute this software
|
|
;; for any purpose with or without fee is hereby granted, provided
|
|
;; that the above copyright notice and this permission notice appear
|
|
;; in all copies.
|
|
;;
|
|
;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
|
|
;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
|
|
;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
|
|
;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
|
|
;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
|
|
;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
|
|
;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
|
|
;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
|
;;
|
|
|
|
(declare (unit member-parser))
|
|
|
|
(module
|
|
member-parser
|
|
(
|
|
parse-member-file
|
|
member-parser-tests!
|
|
)
|
|
|
|
(import scheme
|
|
(chicken base)
|
|
(chicken io)
|
|
(chicken irregex)
|
|
member2-record
|
|
testing)
|
|
|
|
;; Removes any comments and removes any leading and trailing
|
|
;; whitespace.
|
|
(define (preprocess-member-line line)
|
|
(irregex-replace (irregex "[ \\t]*$" 'u)
|
|
(irregex-replace (irregex "^[ \\t]*" 'u)
|
|
(irregex-replace (irregex "#.*$" 'u) line "")
|
|
"")
|
|
""))
|
|
|
|
;; 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
|
|
(let ((dm (irregex-search (irregex "[ \\t]" 'u) line)))
|
|
(if dm
|
|
(let* ((sep-idx (irregex-match-start-index dm))
|
|
(key-str (substring line 0 sep-idx))
|
|
(key (string->symbol key-str))
|
|
(sep+val (substring line sep-idx))
|
|
(val (irregex-replace (irregex "^[ \\t]*" 'u) sep+val "")))
|
|
(cons key val))
|
|
(string->symbol line)))))
|
|
|
|
;; Adds parsed lines to member record.
|
|
(define (parse-member-lines mr source)
|
|
(let loop ((lines source)
|
|
(mr (member-record-set mr #:source source))
|
|
(result '())
|
|
(line-number 1))
|
|
(if (null? lines)
|
|
(member-record-set mr #:parsed (reverse result))
|
|
(let ((parsed-line (parse-member-line
|
|
(preprocess-member-line
|
|
(car lines)))))
|
|
(loop (cdr lines)
|
|
(if (symbol? parsed-line)
|
|
(member-record-add-highlight mr line-number "Got only key" 1 'error)
|
|
mr)
|
|
(if (pair? parsed-line)
|
|
(cons (list (car parsed-line)
|
|
(cdr parsed-line)
|
|
line-number)
|
|
result)
|
|
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)
|
|
(let* ((mrif (member-record-input-file mr))
|
|
(source (read-lines mrif))
|
|
(mrp (parse-member-lines mr source)))
|
|
mrp))
|
|
|
|
;; Performs self-tests of the member-parser module.
|
|
(define (member-parser-tests!)
|
|
(run-tests
|
|
member-parser
|
|
(test-equal? preprocess-member-line
|
|
(preprocess-member-line "# all comment")
|
|
"")
|
|
(test-equal? preprocess-member-line
|
|
(preprocess-member-line " # all comment after spaces")
|
|
"")
|
|
(test-equal? preprocess-member-line
|
|
(preprocess-member-line " test # spaces and comment after spaces")
|
|
"test")
|
|
(test-equal? preprocess-member-line
|
|
(preprocess-member-line "key value # spaces and comment after spaces")
|
|
"key value")
|
|
(test-false parse-member-line
|
|
(parse-member-line ""))
|
|
(test-eq? parse-member-line
|
|
(parse-member-line "key")
|
|
'key)
|
|
(test-equal? parse-member-line
|
|
(parse-member-line "key value")
|
|
'(key . "value"))
|
|
(test-equal? parse-member-line
|
|
(parse-member-line "key value")
|
|
'(key . "value"))
|
|
(test-equal? parse-member-line
|
|
(parse-member-line "key value and some")
|
|
'(key . "value and some"))
|
|
(test-equal? parse-member-line
|
|
(parse-member-line "key value lot of spaces")
|
|
'(key . "value lot of spaces"))
|
|
))
|
|
|
|
)
|
|
|
|
(import member-parser)
|
|
|
|
(member-parser-tests!)
|
|
(print (parse-member-file (make-member-record "joe" "members/joe" '())))
|