diff options
| author | David Thompson <dthompson2@worcester.edu> | 2022-07-05 20:19:13 -0400 |
|---|---|---|
| committer | David Thompson <dthompson2@worcester.edu> | 2022-07-07 22:00:06 -0400 |
| commit | 7e8ceb197e3024b20469a08d529985e989e8eba3 (patch) | |
| tree | f60c07cd73656a527d67ac1612974f56f35d62cb | |
| parent | 40859b97c593404675325f71d9dd9812bc412d5f (diff) | |
site: Add site-url procedure.
| -rw-r--r-- | haunt/site.scm | 13 |
1 files changed, 12 insertions, 1 deletions
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 <davet@gnu.org> +;;; Copyright © 2015, 2022 David Thompson <davet@gnu.org> ;;; ;;; 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)) |