Start splitting out parser utils.
This commit is contained in:
parent
7a260595d2
commit
46ffd605ea
6 changed files with 83 additions and 29 deletions
12
src/Makefile
12
src/Makefile
|
@ -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)
|
||||
|
|
|
@ -35,7 +35,7 @@
|
|||
(chicken base)
|
||||
(chicken string)
|
||||
bank-account
|
||||
csv-simple
|
||||
util-csv
|
||||
progress)
|
||||
|
||||
;; Conversion of Fio date to ISO
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
66
src/util-parser.scm
Normal 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")
|
||||
))
|
||||
|
||||
)
|
Loading…
Add table
Add a link
Reference in a new issue