Port (bs string) to r6rs, add Pythonic split function

1 files changed, 68 insertions, 62 deletions

diff --git a/bs/string.scm b/bs/string.scm
index 789d19b..6d6e941 100644
--- a/bs/string.scm
+++ b/bs/string.scm
@@ -1,73 +1,79 @@
-(define-module (bs string)
-  #:export (replace replace-char to-string str capitalize split
-                    strip lstrip rstrip))
+#!r6rs
+(library (bs string (0))
+  (export
+   replace replace-char to-string str capitalize split
+   strip lstrip rstrip prefix? suffix?)
+  (import
+    (rnrs base)
+    (only  (rnrs control) case-lambda)
+    (only (rnrs io simple) display)
+    (only (srfi srfi-13)
+          string-trim string-trim-both string-trim-right
+          string-prefix? string-suffix? string-upcase string-concatenate
+          string-drop string-take string-contains substring/shared string-null? string-fold)
+    (only (srfi srfi-14) string->char-set)
+    (only (srfi srfi-28) format)
+    ;; TODO: remove or port ice-9 dependency
+    (only (ice-9 ports) with-output-to-string))
 
-;; this should take a string instead of a char
-(define (split s c)
-  (if s
-      (string-split s c)
-      #f))
+  ;; Is `pre` a prefix of `s`?
+  (define (prefix? s sub)
+    (string-prefix? sub s))
 
-(define (replace-char s match repl)
-  (let ((f (lambda (a b)
-             (let ((next-char (if (eq? a match) repl a)))
-               (string-concatenate (list b (string next-char)))))))
-    (string-fold f "" s)))
+  ;; Is `suf` a suffix of `s`?
+  (define (suffix? s suf)
+    (string-suffix? suf s))
 
-(define (replace s match repl)
-  (string-replace-substring s match repl))
+  ;; Split `s` at `sep`
+  (define (split s sep)
+    (string-tokenize s (char-set-complement (apply char-set (string->list sep)))))
 
-(define (to-string x)
-  (format #f "~a" x))
+  ;; Replace `match` in `s` with `char`
+  (define (replace-char s match char)
+    (let ((f (lambda (a b)
+               (let ((next-char (if (eq? a match) char a)))
+                 (string-concatenate (list b (string next-char)))))))
+      (string-fold f "" s)))
 
-(define str
-  (case-lambda
-    (() "")
-    ((x) (to-string x))
-    ((x . rest) (string-concatenate (map str (cons x rest))))))
+  ;; Replace `match` in `s` with `repl`
+  (define (replace s match repl)
+    ;; based on string-replace-substring By A. Wingo in
+    ;; https://lists.gnu.org/archive/html/guile-devel/2014-03/msg00058.html
+    ;; also in string-replace-substring guix:guix/utils.scm.
+    (let ((matchlen (string-length match)))
+      (with-output-to-string
+        (lambda ()
+          (let lp ((start 0))
+            (cond
+             ((string-contains s match start)
+              => (lambda (end)
+                   (display (substring/shared s start end))
+                   (display repl)
+                   (lp (+ end matchlen))))
+             (else
+              (display (substring/shared s start)))))))))
 
-(define (capitalize s)
-  (let ((s (to-string s)))
-    (if (< (string-length s) 2)
-        (string-upcase s)
-        (str (string-upcase (substring s 0 1))
-             (substring s 1 )))))
+  (define (to-string x)
+    (format #f "~a" x))
 
-(define (strip s char)
-  (string-trim-both s char))
+  (define str
+    (case-lambda
+      (() "")
+      ((x) (to-string x))
+      ((x . rest) (string-concatenate (map str (cons x rest))))))
 
-(define (lstrip s char)
-  (string-trim s char))
+  (define (capitalize s)
+    (let ((s (to-string s)))
+      (if (< (string-length s) 2)
+          (string-upcase s)
+          (str (string-upcase (substring s 0 1))
+               (substring s 1 )))))
 
-(define (rstrip s char)
-  (string-trim-right s char ))
+  (define (strip s char)
+    (string-trim-both s char))
 
-
-;;; {String Fun: string-replace-substring}
-;;;
+  (define (lstrip s char)
+    (string-trim s char))
 
-;; string-replace-substring By A. Wingo in
-;; https://lists.gnu.org/archive/html/guile-devel/2014-03/msg00058.html
-;; also in string-replace-substring guix:guix/utils.scm.
-
-(define (string-replace-substring str substring replacement)
-  "Return a new string where every instance of @var{substring} in string
-   @var{str} has been replaced by @var{replacement}. For example:
-
-   @lisp
-   (string-replace-substring \"a ring of strings\" \"ring\" \"rut\")
-   @result{} \"a rut of struts\"
-   @end lisp
-   "
-  (let ((sublen (string-length substring)))
-    (with-output-to-string
-      (lambda ()
-        (let lp ((start 0))
-          (cond
-           ((string-contains str substring start)
-            => (lambda (end)
-                 (display (substring/shared str start end))
-                 (display replacement)
-                 (lp (+ end sublen))))
-           (else
-            (display (substring/shared str start)))))))))
+  (define (rstrip s char)
+    (string-trim-right s char )))