Extend string-join' in a similar way to add-between'.

(This is actually the extension that made me do the other too.)
This commit is contained in:
Eli Barzilay 2012-06-23 04:44:13 -04:00
parent 728687d9dc
commit f0d856ab7a
3 changed files with 48 additions and 13 deletions

View File

@ -8,7 +8,7 @@
string-replace)
(define string-append*
(case-lambda [(strs) (apply string-append strs)] ; optimize common case
(case-lambda [(strs) (apply string-append strs)] ; optimize common cases
[(s1 strs) (apply string-append s1 strs)]
[(s1 s2 strs) (apply string-append s1 s2 strs)]
[(s1 s2 s3 strs) (apply string-append s1 s2 s3 strs)]
@ -17,19 +17,25 @@
(require (only-in racket/list add-between))
(define (string-join strs [sep " "])
(cond [(not (and (list? strs) (andmap string? strs)))
(raise-argument-error 'string-join "(listof string?)" strs)]
[(not (string? sep))
(raise-argument-error 'string-join "string?" sep)]
[(null? strs) ""]
[(null? (cdr strs)) (car strs)]
[else (apply string-append (add-between strs sep))]))
(define none (gensym))
(define (string-join strs [sep " "]
#:first [first none] #:last [last none]
#:before-last [before-last none])
(unless (and (list? strs) (andmap string? strs))
(raise-argument-error 'string-join "(listof string?)" strs))
(unless (string? sep)
(raise-argument-error 'string-join "string?" sep))
(let* ([r (cond [(or (null? strs) (null? (cdr strs))) strs]
[(eq? before-last none) (add-between strs sep)]
[else (add-between strs sep #:before-last before-last)])]
[r (if (eq? last none) r (append r (list last)))]
[r (if (eq? first none) r (cons first r))])
(apply string-append r)))
;; Utility for the functions below: get a string or a regexp and return a list
;; of the regexp (strings are converted using `regexp-quote'), the and versions
;; that matches at the beginning/end.
(define none (gensym))
(define get-rxs
(let ([t (make-weak-hasheq)] [t+ (make-weak-hasheq)])
(let ([spaces '(#px"\\s+" #px"^\\s+" #px"\\s+$")])

View File

@ -390,15 +390,25 @@ one between @racket[list] and @racket[list*].
]}
@defproc[(string-join [strs (listof string?)] [sep string? " "]) string?]{
@defproc[(string-join [strs (listof string?)] [sep string? " "]
[#:before-last before-last string? sep]
[#:first first string? ....]
[#:last last string? ....])
string?]{
Appends the strings in @racket[strs], inserting @racket[sep] between
each pair of strings in @racket[strs].
each pair of strings in @racket[strs]. @racket[before-last],
@racket[first], and @racket[last] are analogous to the inputs of
@racket[add-between]: they specify an alternate separator between the
last two strings, a prefix string, and a suffix string respectively.
@mz-examples[#:eval string-eval
(string-join '("one" "two" "three" "four"))
(string-join '("one" "two" "three" "four") ", ")
(string-join '("one" "two" "three" "four") " potato ")
(string-join #:first "Todo: "
'("x" "y" "z") ", " #:before-last " and "
#:last ".")
]}

View File

@ -385,7 +385,26 @@
(test "x" string-join '("x"))
(test "x y" string-join '("x" "y"))
(test "x y z" string-join '("x" "y" "z") " ")
(test "x,y,z" string-join '("x" "y" "z") ","))
(test "x,y,z" string-join '("x" "y" "z") ",")
(test "x, y and z" string-join '("x" "y" "z") ", " #:before-last " and ")
(for ([strs+res
(in-list '((("x" "y" "z") "x, y and z")
(("x" "y") "x and y")
(("x") "x")
(("") "")
(() "")))])
(test (cadr strs+res)
string-join (car strs+res)
", " #:before-last " and ")
(test (string-append "Todo: " (cadr strs+res))
string-join (car strs+res)
#:first "Todo: " ", " #:before-last " and ")
(test (string-append (cadr strs+res) ".")
string-join (car strs+res)
", " #:before-last " and " #:last ".")
(test (string-append "Todo: " (cadr strs+res) ".")
string-join (car strs+res)
#:first "Todo: " ", " #:before-last " and " #:last ".")))
;; ---------- string-trim & string-normalize-spaces ----------
(let ()