From 7e8ceb197e3024b20469a08d529985e989e8eba3 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Tue, 5 Jul 2022 20:19:13 -0400 Subject: site: Add site-url procedure. --- haunt/site.scm | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/haunt/site.scm b/haunt/site.scm index 1dd41a0..54df53f 100644 --- a/haunt/site.scm +++ b/haunt/site.scm @@ -1,5 +1,5 @@ ;;; Haunt --- Static site generator for GNU Guile -;;; Copyright © 2015 David Thompson +;;; Copyright © 2015, 2022 David Thompson ;;; ;;; This file is part of Haunt. ;;; @@ -34,6 +34,7 @@ #:use-module (haunt page) #:use-module (haunt post) #:use-module (haunt asset) + #:use-module (web uri) #:export (site site? site-title @@ -47,6 +48,7 @@ site-readers site-builders site-post-slug + site-url build-site make-file-filter @@ -100,6 +102,15 @@ BUILDERS: A list of procedures for building pages from posts" "Return a slug string for POST using the slug generator for SITE." ((site-make-slug site) post)) +(define (site-url site file-name) + "Return a URL string for FILE-NAME on SITE." + (uri->string + (build-uri (site-scheme site) + #:host (site-domain site) + #:path (if (string-prefix? "/" file-name) + file-name + (string-append "/" file-name))))) + (define (build-site site) "Build SITE in the appropriate build directory." (let ((posts (if (file-exists? (site-posts-directory site)) -- cgit v1.2.3