;; ;; 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" . "")) )) )