summaryrefslogtreecommitdiffstats
path: root/apps/aux/web.scm
diff options
context:
space:
mode:
authorAndreas Widen <andreas@harmonicflow.org>2023-11-25 17:21:37 +0100
committerAndreas Widen <andreas@harmonicflow.org>2023-11-25 17:21:37 +0100
commit1b2b7c3eb939724696894f31ff27db97b0cac84c (patch)
treeefb7b7746a628efb7bb99b2e44c9c2fbfd75b656 /apps/aux/web.scm
downloadhf-web-1b2b7c3eb939724696894f31ff27db97b0cac84c.tar.xz
hf-web-1b2b7c3eb939724696894f31ff27db97b0cac84c.zip
Initial commit.
Signed-off-by: Andreas Widen <andreas@harmonicflow.org>
Diffstat (limited to 'apps/aux/web.scm')
-rw-r--r--apps/aux/web.scm61
1 files changed, 61 insertions, 0 deletions
diff --git a/apps/aux/web.scm b/apps/aux/web.scm
new file mode 100644
index 0000000..fec6b4c
--- /dev/null
+++ b/apps/aux/web.scm
@@ -0,0 +1,61 @@
+;;; Harmonic Flow web site
+
+(define-module (apps aux web)
+ #:use-module (srfi srfi-1)
+ #:export (slugify
+ url-path-join))
+
+
+;;;
+;;; Variables.
+;;;
+
+(define char-set:slug
+ (char-set-union char-set:letter+digit (char-set #\-)))
+
+
+
+;;;
+;;; Procedures.
+;;;
+
+(define (slugify text)
+ "Return TEXT as a slug.
+
+ Reserved characters for Internationalized Resource Identifiers
+ (IRIs) and common reserved characters for file names are removed
+ using the SLUG_FORBIDDEN constant as reference.
+
+ TEXT (string)
+ Some text. For example: Biology, Human anatomy.
+
+ RETURN VALUE (string)
+ A slug-like string. For example: biology, human-anatomy."
+ (string-join
+ (map (lambda (s) (string-filter char-set:slug s))
+ (string-split (string-downcase text) char-set:whitespace))
+ "-"))
+
+
+(define (url-path-join . parts)
+ "Return a URL path composed of the given PARTS.
+
+ PARTS (strings)
+ A succession of strings that represent parts of a URL path.
+
+ To indicate an absolute path, use an empty string as the first
+ part. For example:
+
+ (url-path-join '' 'docs' 'manual')
+ => '/docs/manual'
+
+ To end the path with a slash, use an empty string as the last
+ part. For example:
+
+ (url-path-join '' 'docs' 'manual' '')
+ => '/docs/manual/'
+
+ RETURN VALUE (string)
+ A string representing a URL path."
+ (cond ((equal? parts '("")) "/") ; Root directory
+ (else (string-join parts "/"))))