diff --git a/src/Makefile b/src/Makefile index accd482..3abe1db 100644 --- a/src/Makefile +++ b/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) diff --git a/src/bank-fio.scm b/src/bank-fio.scm index d4cc06a..2f751fe 100644 --- a/src/bank-fio.scm +++ b/src/bank-fio.scm @@ -35,7 +35,7 @@ (chicken base) (chicken string) bank-account - csv-simple + util-csv progress) ;; Conversion of Fio date to ISO diff --git a/src/bbstool.scm b/src/bbstool.scm index b9b82f1..05a384e 100644 --- a/src/bbstool.scm +++ b/src/bbstool.scm @@ -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) diff --git a/src/member-parser.scm b/src/member-parser.scm index 35d7a69..19372f1 100644 --- a/src/member-parser.scm +++ b/src/member-parser.scm @@ -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 diff --git a/src/util-csv.scm b/src/util-csv.scm index 211b102..d76c0f1 100644 --- a/src/util-csv.scm +++ b/src/util-csv.scm @@ -26,7 +26,7 @@ (declare (unit util-csv)) (module - csv-simple + util-csv ( csv-parse csv-split-header diff --git a/src/util-parser.scm b/src/util-parser.scm new file mode 100644 index 0000000..a78424d --- /dev/null +++ b/src/util-parser.scm @@ -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 +;; +;; 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") + )) + + )