diff --git a/src/Makefile b/src/Makefile index 375a8a7..f3960b7 100644 --- a/src/Makefile +++ b/src/Makefile @@ -43,7 +43,8 @@ BBSTOOL-DEPS=bbstool.scm testing.import.scm listing.import.scm \ bank-fio.import.scm members-payments.import.scm \ web-static.import.scm environment.import.scm \ mailman.import.scm util-set-list.import.scm \ - util-time.import.scm util-tag.import.scm util-io.import.scm + util-time.import.scm util-tag.import.scm util-io.import.scm \ + util-string.import.scm BBSTOOL-OBJS=bbstool.o testing.o listing.o month.o period.o ansi.o \ dictionary.o command-line.o members-base.o utils.o primes.o \ @@ -51,7 +52,7 @@ BBSTOOL-OBJS=bbstool.o testing.o listing.o month.o period.o ansi.o \ members-print.o member-fees.o members-dir.o util-csv.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-time.o util-tag.o util-io.o util-string.o .PHONY: imports imports: $(BBSTOOL-DEPS) @@ -156,7 +157,7 @@ progress.o: progress.import.scm progress.import.scm: $(PROGRESS-SOURCES) TABLE-SOURCES=table.scm ansi.import.scm testing.import.scm \ - utils.import.scm + utils.import.scm util-string.import.scm table.o: table.import.scm table.import.scm: $(TABLE-SOURCES) @@ -169,7 +170,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 utils.import.scm configuration.import.scm + period.import.scm utils.import.scm configuration.import.scm \ + util-string.import.scm member-parser.o: member-parser.import.scm member-parser.import.scm: $(MEMBER-PARSER-SOURCES) @@ -261,3 +263,8 @@ UTIL-IO-SOURCES=util-io.scm util-io.o: util-io.import.scm util-io.import.scm: $(UTIL-IO-SOURCES) + +UTIL-STRING-SOURCES=util-string.scm + +util-string.o: util-string.import.scm +util-string.import.scm: $(UTIL-STRING-SOURCES) diff --git a/src/member-parser.scm b/src/member-parser.scm index d845c6d..a2f089e 100644 --- a/src/member-parser.scm +++ b/src/member-parser.scm @@ -42,7 +42,8 @@ month period utils - configuration) + configuration + util-string) ;; Pass 2: known keys (define mandatory-keys '(nick name mail phone)) diff --git a/src/table.scm b/src/table.scm index 3a1e96d..f0604f1 100644 --- a/src/table.scm +++ b/src/table.scm @@ -41,7 +41,8 @@ (chicken irregex) ansi testing - utils) + utils + util-string) ;; Default table border style to use if not explicitly specified. (define *table-border-style* (make-parameter 'unicode)) diff --git a/src/util-string.scm b/src/util-string.scm new file mode 100644 index 0000000..5363dfc --- /dev/null +++ b/src/util-string.scm @@ -0,0 +1,83 @@ +;; +;; util-string.scm +;; +;; Various string utilities. +;; +;; 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-string)) + +(module + util-string + ( + string-repeat + string-first+rest + ) + + (import scheme + (chicken base) + (chicken string) + (chicken irregex) + testing) + + ;; Repeats given string. + (define (string-repeat str rep) + (let loop ((rep rep) + (res '())) + (if (> rep 0) + (loop (sub1 rep) + (cons str res)) + (string-intersperse res "")))) + + ;; Extracts first token and the rest as separate string + (define (string-first+rest str) + (let ((dm (irregex-search (irregex "[ \\t]" 'u) str))) + (if dm + (let* ((sep-idx (irregex-match-start-index dm)) + (key-str (substring str 0 sep-idx)) + (sep+val (substring str sep-idx)) + (val (irregex-replace (irregex "^[ \\t]*" 'u) sep+val ""))) + (cons key-str val)) + (cons str "")))) + + ;; Performs utils module self-tests. + (define (utils-tests!) + (run-tests + utils + (test-equal? string-repeat + (string-repeat "-" 4) + "----") + (test-equal? string-repeat + (string-repeat "š" 4) + "šššš") + (test-equal? string-first+rest + (string-first+rest "asdf rest") + '("asdf" . "rest")) + (test-equal? string-first+rest + (string-first+rest "asdf rest test rest") + '("asdf" . "rest test rest")) + (test-equal? string-first+rest + (string-first+rest "asdf") + '("asdf" . "")) + )) + + ) + diff --git a/src/utils.scm b/src/utils.scm index 3a32744..07074b8 100644 --- a/src/utils.scm +++ b/src/utils.scm @@ -29,16 +29,12 @@ utils ( filter - string-repeat - string-first+rest get-process-output-lines utils-tests! ) (import scheme (chicken base) - (chicken string) - (chicken irregex) (chicken io) (chicken process) testing) @@ -55,26 +51,6 @@ (loop (cdr lst) res))))) - ;; Repeats given string. - (define (string-repeat str rep) - (let loop ((rep rep) - (res '())) - (if (> rep 0) - (loop (sub1 rep) - (cons str res)) - (string-intersperse res "")))) - - ;; Extracts first token and the rest as separate string - (define (string-first+rest str) - (let ((dm (irregex-search (irregex "[ \\t]" 'u) str))) - (if dm - (let* ((sep-idx (irregex-match-start-index dm)) - (key-str (substring str 0 sep-idx)) - (sep+val (substring str sep-idx)) - (val (irregex-replace (irregex "^[ \\t]*" 'u) sep+val ""))) - (cons key-str val)) - (cons str "")))) - ;; Very simple shell command wrapper that returns lines produced by ;; given command. Dangerous - performs no argument escaping! (define (get-process-output-lines cmd) @@ -90,21 +66,6 @@ utils (test-equal? filter (filter odd? '(1 2 3 4)) '(1 3)) (test-equal? filter (filter odd? '(2 4)) '()) - (test-equal? string-repeat - (string-repeat "-" 4) - "----") - (test-equal? string-repeat - (string-repeat "š" 4) - "šššš") - (test-equal? string-first+rest - (string-first+rest "asdf rest") - '("asdf" . "rest")) - (test-equal? string-first+rest - (string-first+rest "asdf rest test rest") - '("asdf" . "rest test rest")) - (test-equal? string-first+rest - (string-first+rest "asdf") - '("asdf" . "")) )) )