Start splitting out parser utils.

This commit is contained in:
Dominik Pantůček 2023-04-09 10:09:41 +02:00
parent 7a260595d2
commit 46ffd605ea
6 changed files with 83 additions and 29 deletions

View file

@ -45,7 +45,7 @@ BBSTOOL-DEPS=bbstool.scm testing.import.scm listing.import.scm \
mailman.import.scm util-set-list.import.scm \
util-time.import.scm util-tag.import.scm util-io.import.scm \
util-string.import.scm util-io.import.scm \
util-list.import.scm
util-list.import.scm util-parser.import.scm
BBSTOOL-OBJS=bbstool.o testing.o listing.o month.o period.o ansi.o \
dictionary.o command-line.o members-base.o primes.o \
@ -54,7 +54,7 @@ BBSTOOL-OBJS=bbstool.o testing.o listing.o month.o period.o ansi.o \
bank-account.o bank-fio.o members-payments.o member-parser.o \
web-static.o environment.o mailman.o util-set-list.o \
util-time.o util-tag.o util-io.o util-string.o util-io.o \
util-list.o
util-list.o util-parser.o
.PHONY: imports
imports: $(BBSTOOL-DEPS)
@ -174,7 +174,8 @@ cards.import.scm: $(CARDS-SOURCES)
MEMBER-PARSER-SOURCES=member-parser.scm member-record.import.scm \
testing.import.scm dictionary.import.scm month.import.scm \
period.import.scm configuration.import.scm \
util-string.import.scm util-list.import.scm
util-string.import.scm util-list.import.scm \
util-parser.import.scm
member-parser.o: member-parser.import.scm
member-parser.import.scm: $(MEMBER-PARSER-SOURCES)
@ -284,3 +285,8 @@ UTIL-LIST-SOURCES=util-list.scm testing.import.scm
util-list.o: util-list.import.scm
util-list.import.scm: $(UTIL-LIST-SOURCES)
UTIL-PARSER-SOURCES=util-parser.scm testing.import.scm
util-parser.o: util-parser.import.scm
util-parser.import.scm: $(UTIL-PARSER-SOURCES)

View file

@ -35,7 +35,7 @@
(chicken base)
(chicken string)
bank-account
csv-simple
util-csv
progress)
;; Conversion of Fio date to ISO

View file

@ -50,7 +50,8 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
environment
bank-account
mailman
util-set-list)
util-set-list
util-parser)
;; Print banner
(print "bbstool 0.9.3 (c) 2023 Brmlab, z.s.")
@ -171,6 +172,7 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
(table-tests!)
(csv-simple-tests!)
(lset-tests!)
(parser-tests!)
(newline))
;; Load the members database (required for everything anyway)

View file

@ -43,7 +43,8 @@
period
util-list
configuration
util-string)
util-string
util-parser)
;; Pass 2: known keys
(define mandatory-keys '(nick name mail phone))
@ -135,15 +136,6 @@
mr 'info
(join (map (lambda (mk) (list mk #f)) mandatory-keys))))
;; Pass 0: 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 "")
"")
""))
;; 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
@ -170,7 +162,7 @@
(if (null? lines)
(member-record-set mr #:parsed (reverse result))
(let ((parsed-line (parse-member-line
(preprocess-member-line
(parser-preprocess-line
(car lines)))))
(loop (cdr lines)
(if (symbol? parsed-line)
@ -259,18 +251,6 @@
(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

View file

@ -26,7 +26,7 @@
(declare (unit util-csv))
(module
csv-simple
util-csv
(
csv-parse
csv-split-header

66
src/util-parser.scm Normal file
View file

@ -0,0 +1,66 @@
;;
;; util-parser.scm
;;
;; Simple, incomplete and incorrect but fast CSV loader.
;;
;; 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 util-parser))
(module
util-parser
(
parser-preprocess-line
parser-tests!
)
(import scheme
(chicken irregex)
testing)
;; Pass 0: Removes any comments and removes any leading and trailing
;; whitespace.
(define (parser-preprocess-line line)
(irregex-replace (irregex "[ \\t]*$" 'u)
(irregex-replace (irregex "^[ \\t]*" 'u)
(irregex-replace (irregex "#.*$" 'u) line "")
"")
""))
;; Self-tests
(define (parser-tests!)
(run-tests
parser
(test-equal? parser-preprocess-line
(parser-preprocess-line "# all comment")
"")
(test-equal? parser-preprocess-line
(parser-preprocess-line " # all comment after spaces")
"")
(test-equal? parser-preprocess-line
(parser-preprocess-line " test # spaces and comment after spaces")
"test")
(test-equal? parser-preprocess-line
(parser-preprocess-line "key value # spaces and comment after spaces")
"key value")
))
)