Split out string utils.
This commit is contained in:
parent
746e4450a6
commit
4ac7fdbc6d
5 changed files with 98 additions and 45 deletions
15
src/Makefile
15
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)
|
||||
|
|
|
|||
|
|
@ -42,7 +42,8 @@
|
|||
month
|
||||
period
|
||||
utils
|
||||
configuration)
|
||||
configuration
|
||||
util-string)
|
||||
|
||||
;; Pass 2: known keys
|
||||
(define mandatory-keys '(nick name mail phone))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
83
src/util-string.scm
Normal file
83
src/util-string.scm
Normal file
|
|
@ -0,0 +1,83 @@
|
|||
;;
|
||||
;; util-string.scm
|
||||
;;
|
||||
;; Various string utilities.
|
||||
;;
|
||||
;; 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-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" . ""))
|
||||
))
|
||||
|
||||
)
|
||||
|
||||
|
|
@ -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" . ""))
|
||||
))
|
||||
|
||||
)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue