From f0d856ab7ac906784cc43522341530496c3100d6 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@barzilay.org>
Date: Sat, 23 Jun 2012 04:44:13 -0400
Subject: [PATCH] Extend `string-join' in a similar way to `add-between'.

(This is actually the extension that made me do the other too.)
---
 collects/racket/string.rkt                   | 26 ++++++++++++--------
 collects/scribblings/reference/strings.scrbl | 14 +++++++++--
 collects/tests/racket/string.rktl            | 21 +++++++++++++++-
 3 files changed, 48 insertions(+), 13 deletions(-)

diff --git a/collects/racket/string.rkt b/collects/racket/string.rkt
index cb95e7206b..198476f52a 100644
--- a/collects/racket/string.rkt
+++ b/collects/racket/string.rkt
@@ -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+$")])
diff --git a/collects/scribblings/reference/strings.scrbl b/collects/scribblings/reference/strings.scrbl
index 6aece8aef7..0b06ad339a 100644
--- a/collects/scribblings/reference/strings.scrbl
+++ b/collects/scribblings/reference/strings.scrbl
@@ -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 ".")
 ]}
 
 
diff --git a/collects/tests/racket/string.rktl b/collects/tests/racket/string.rktl
index 55a15b4bbe..2ee1c183ce 100644
--- a/collects/tests/racket/string.rktl
+++ b/collects/tests/racket/string.rktl
@@ -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 ()