post: Add post-slug-v2 procedure.

2 files changed, 25 insertions, 0 deletions

diff --git a/doc/haunt.texi b/doc/haunt.texi
index a612f35..cfeff16 100644
--- a/doc/haunt.texi
+++ b/doc/haunt.texi
@@ -560,6 +560,19 @@ Transform the title of @var{post} into a URL slug suitable for the
 file name of a web page.
 @end deffn
 
+The original @code{post-slug} procedure above has some less than ideal
+behavior.  One issue is that version numbers like ``1.2.3'' get
+transformed to ``123'' rather than something more sensible like
+``1-2-3''.  Unfortunately, changing this behavior would mean breaking
+the URLs for existing Haunt sites.  Instead, users may opt-in to using
+@code{post-slug-v2} by passing it as the @code{#:make-slug} argument
+to @code{make-site}.  @xref{Sites} for more information.
+
+@deffn {Procedure} post-slug-v2 post
+Transform the title of @var{post} into a URL slug.  This second
+revision does a better job than the original.
+@end deffn
+
 @defvr {Variable} %default-date
 The default date of a post when no other date is specified in the
 metadata association list.
diff --git a/haunt/post.scm b/haunt/post.scm
index d15efd2..fb8eaea 100644
--- a/haunt/post.scm
+++ b/haunt/post.scm
@@ -38,6 +38,7 @@
             post-ref
             post-ref-all
             post-slug
+            post-slug-v2
             %default-date
             post-date
             post-author
@@ -80,6 +81,17 @@
                                       char-set:whitespace))
                    "-")))
 
+(define char-set:slug-v2 char-set:letter+digit)
+(define char-set:!slug-v2 (char-set-complement char-set:slug-v2))
+
+(define (post-slug-v2 post)
+  "Transform the title of POST into a URL slug."
+  (or (post-ref post 'slug)
+      (string-join (remove string-null?
+                           (string-split (string-downcase (post-title post))
+                                         char-set:!slug-v2))
+                   "-")))
+
 (define %default-date
   (make-date 0 0 0 0 1 1 1970 0)) ; UNIX epoch